aboutsummaryrefslogtreecommitdiffhomepage
path: root/theories
diff options
context:
space:
mode:
authorGravatar herbelin <herbelin@85f007b7-540e-0410-9357-904b9bb8a0f7>2003-11-29 17:28:49 +0000
committerGravatar herbelin <herbelin@85f007b7-540e-0410-9357-904b9bb8a0f7>2003-11-29 17:28:49 +0000
commit9a6e3fe764dc2543dfa94de20fe5eec42d6be705 (patch)
tree77c0021911e3696a8c98e35a51840800db4be2a9 /theories
parent9058fb97426307536f56c3e7447be2f70798e081 (diff)
Remplacement des fichiers .v ancienne syntaxe de theories, contrib et states par les fichiers nouvelle syntaxe
git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@5027 85f007b7-540e-0410-9357-904b9bb8a0f7
Diffstat (limited to 'theories')
-rwxr-xr-xtheories/Arith/Arith.v2
-rwxr-xr-xtheories/Arith/Between.v204
-rw-r--r--theories/Arith/Bool_nat.v36
-rwxr-xr-xtheories/Arith/Compare.v43
-rwxr-xr-xtheories/Arith/Compare_dec.v104
-rw-r--r--theories/Arith/Div2.v185
-rwxr-xr-xtheories/Arith/EqNat.v91
-rw-r--r--theories/Arith/Euclid.v93
-rw-r--r--theories/Arith/Even.v433
-rw-r--r--theories/Arith/Factorial.v53
-rwxr-xr-xtheories/Arith/Gt.v123
-rwxr-xr-xtheories/Arith/Le.v106
-rwxr-xr-xtheories/Arith/Lt.v145
-rwxr-xr-xtheories/Arith/Max.v70
-rwxr-xr-xtheories/Arith/Min.v71
-rwxr-xr-xtheories/Arith/Minus.v121
-rwxr-xr-xtheories/Arith/Mult.v223
-rwxr-xr-xtheories/Arith/Peano_dec.v26
-rwxr-xr-xtheories/Arith/Plus.v187
-rwxr-xr-xtheories/Arith/Wf_nat.v222
-rwxr-xr-xtheories/Bool/Bool.v549
-rw-r--r--theories/Bool/BoolEq.v61
-rw-r--r--theories/Bool/Bvector.v189
-rwxr-xr-xtheories/Bool/DecBool.v22
-rwxr-xr-xtheories/Bool/IfProp.v53
-rw-r--r--theories/Bool/Sumbool.v51
-rwxr-xr-xtheories/Bool/Zerob.v34
-rwxr-xr-xtheories/Init/Datatypes.v115
-rwxr-xr-xtheories/Init/Logic.v242
-rwxr-xr-xtheories/Init/Logic_Type.v287
-rw-r--r--theories/Init/Notations.v109
-rwxr-xr-xtheories/Init/Peano.v208
-rwxr-xr-xtheories/Init/Prelude.v2
-rwxr-xr-xtheories/Init/Specif.v192
-rwxr-xr-xtheories/Init/Wf.v129
-rw-r--r--theories/IntMap/Adalloc.v438
-rw-r--r--theories/IntMap/Addec.v248
-rw-r--r--theories/IntMap/Addr.v637
-rw-r--r--theories/IntMap/Adist.v397
-rw-r--r--theories/IntMap/Allmaps.v2
-rw-r--r--theories/IntMap/Fset.v481
-rw-r--r--theories/IntMap/Lsort.v1007
-rw-r--r--theories/IntMap/Map.v1415
-rw-r--r--theories/IntMap/Mapaxioms.v909
-rw-r--r--theories/IntMap/Mapc.v673
-rw-r--r--theories/IntMap/Mapcanon.v569
-rw-r--r--theories/IntMap/Mapcard.v1316
-rw-r--r--theories/IntMap/Mapfold.v533
-rw-r--r--theories/IntMap/Mapiter.v865
-rw-r--r--theories/IntMap/Maplists.v562
-rw-r--r--theories/IntMap/Mapsubset.v740
-rwxr-xr-xtheories/Lists/List.v741
-rw-r--r--theories/Lists/ListSet.v467
-rwxr-xr-xtheories/Lists/MonoList.v212
-rw-r--r--theories/Lists/PolyList.v642
-rw-r--r--theories/Lists/PolyListSyntax.v10
-rwxr-xr-xtheories/Lists/Streams.v171
-rwxr-xr-xtheories/Lists/TheoryList.v445
-rw-r--r--theories/Logic/Berardi.v137
-rw-r--r--theories/Logic/ChoiceFacts.v175
-rwxr-xr-xtheories/Logic/Classical.v2
-rw-r--r--theories/Logic/ClassicalChoice.v17
-rw-r--r--theories/Logic/ClassicalDescription.v82
-rw-r--r--theories/Logic/ClassicalFacts.v195
-rwxr-xr-xtheories/Logic/Classical_Pred_Set.v64
-rwxr-xr-xtheories/Logic/Classical_Pred_Type.v64
-rwxr-xr-xtheories/Logic/Classical_Prop.v68
-rwxr-xr-xtheories/Logic/Classical_Type.v2
-rw-r--r--theories/Logic/Decidable.v54
-rw-r--r--theories/Logic/Diaconescu.v109
-rwxr-xr-xtheories/Logic/Eqdep.v157
-rw-r--r--theories/Logic/Eqdep_dec.v165
-rw-r--r--theories/Logic/Hurkens.v72
-rw-r--r--theories/Logic/JMeq.v56
-rw-r--r--theories/Logic/ProofIrrelevance.v95
-rw-r--r--theories/Logic/RelationalChoice.v13
-rw-r--r--theories/NArith/BinNat.v213
-rw-r--r--theories/NArith/BinPos.v1135
-rw-r--r--theories/NArith/NArith.v2
-rw-r--r--theories/NArith/Pnat.v599
-rw-r--r--theories/Reals/Alembert.v1207
-rw-r--r--theories/Reals/AltSeries.v696
-rw-r--r--theories/Reals/ArithProp.v256
-rw-r--r--theories/Reals/Binomial.v335
-rw-r--r--theories/Reals/Cauchy_prod.v767
-rw-r--r--theories/Reals/Cos_plus.v2030
-rw-r--r--theories/Reals/Cos_rel.v726
-rw-r--r--theories/Reals/DiscrR.v111
-rw-r--r--theories/Reals/Exp_prop.v1803
-rw-r--r--theories/Reals/MVT.v1064
-rw-r--r--theories/Reals/NewtonInt.v1246
-rw-r--r--theories/Reals/PSeries_reg.v387
-rw-r--r--theories/Reals/PartSum.v919
-rw-r--r--theories/Reals/RIneq.v1886
-rw-r--r--theories/Reals/RList.v1145
-rw-r--r--theories/Reals/R_Ifp.v937
-rw-r--r--theories/Reals/R_sqr.v462
-rw-r--r--theories/Reals/R_sqrt.v524
-rw-r--r--theories/Reals/Ranalysis.v1185
-rw-r--r--theories/Reals/Ranalysis1.v2267
-rw-r--r--theories/Reals/Ranalysis2.v678
-rw-r--r--theories/Reals/Ranalysis3.v1326
-rw-r--r--theories/Reals/Ranalysis4.v561
-rw-r--r--theories/Reals/Raxioms.v112
-rw-r--r--theories/Reals/Rbase.v2
-rw-r--r--theories/Reals/Rbasic_fun.v676
-rw-r--r--theories/Reals/Rcomplete.v333
-rw-r--r--theories/Reals/Rdefinitions.v58
-rw-r--r--theories/Reals/Rderiv.v772
-rw-r--r--theories/Reals/Reals.v2
-rw-r--r--theories/Reals/Rfunctions.v1273
-rw-r--r--theories/Reals/Rgeom.v179
-rw-r--r--theories/Reals/RiemannInt.v4702
-rw-r--r--theories/Reals/RiemannInt_SF.v3772
-rw-r--r--theories/Reals/Rlimit.v876
-rw-r--r--theories/Reals/Rpower.v991
-rw-r--r--theories/Reals/Rprod.v285
-rw-r--r--theories/Reals/Rseries.v412
-rw-r--r--theories/Reals/Rsigma.v197
-rw-r--r--theories/Reals/Rsqrt_def.v1318
-rw-r--r--theories/Reals/Rsyntax.v227
-rw-r--r--theories/Reals/Rtopology.v2721
-rw-r--r--theories/Reals/Rtrigo.v2570
-rw-r--r--theories/Reals/Rtrigo_alt.v666
-rw-r--r--theories/Reals/Rtrigo_calc.v716
-rw-r--r--theories/Reals/Rtrigo_def.v613
-rw-r--r--theories/Reals/Rtrigo_fun.v169
-rw-r--r--theories/Reals/Rtrigo_reg.v1017
-rw-r--r--theories/Reals/SeqProp.v2154
-rw-r--r--theories/Reals/SeqSeries.v660
-rw-r--r--theories/Reals/SplitAbsolu.v21
-rw-r--r--theories/Reals/SplitRmult.v11
-rw-r--r--theories/Reals/Sqrt_reg.v584
-rwxr-xr-xtheories/Relations/Newman.v134
-rwxr-xr-xtheories/Relations/Operators_Properties.v100
-rwxr-xr-xtheories/Relations/Relation_Definitions.v65
-rwxr-xr-xtheories/Relations/Relation_Operators.v168
-rwxr-xr-xtheories/Relations/Relations.v24
-rwxr-xr-xtheories/Relations/Rstar.v83
-rw-r--r--theories/Setoids/Setoid.v74
-rwxr-xr-xtheories/Sets/Classical_sets.v125
-rwxr-xr-xtheories/Sets/Constructive_sets.v145
-rwxr-xr-xtheories/Sets/Cpo.v110
-rwxr-xr-xtheories/Sets/Ensembles.v85
-rwxr-xr-xtheories/Sets/Finite_sets.v61
-rwxr-xr-xtheories/Sets/Finite_sets_facts.v498
-rwxr-xr-xtheories/Sets/Image.v244
-rwxr-xr-xtheories/Sets/Infinite_sets.v330
-rwxr-xr-xtheories/Sets/Integers.v167
-rwxr-xr-xtheories/Sets/Multiset.v181
-rwxr-xr-xtheories/Sets/Partial_Order.v102
-rwxr-xr-xtheories/Sets/Permut.v86
-rwxr-xr-xtheories/Sets/Powerset.v228
-rwxr-xr-xtheories/Sets/Powerset_Classical_facts.v486
-rwxr-xr-xtheories/Sets/Powerset_facts.v286
-rwxr-xr-xtheories/Sets/Relations_1.v42
-rwxr-xr-xtheories/Sets/Relations_1_facts.v97
-rwxr-xr-xtheories/Sets/Relations_2.v34
-rwxr-xr-xtheories/Sets/Relations_2_facts.v152
-rwxr-xr-xtheories/Sets/Relations_3.v41
-rwxr-xr-xtheories/Sets/Relations_3_facts.v216
-rw-r--r--theories/Sets/Uniset.v201
-rw-r--r--theories/Sorting/Heap.v274
-rw-r--r--theories/Sorting/Permutation.v135
-rw-r--r--theories/Sorting/Sorting.v144
-rw-r--r--theories/Wellfounded/Disjoint_Union.v53
-rw-r--r--theories/Wellfounded/Inclusion.v21
-rw-r--r--theories/Wellfounded/Inverse_Image.v55
-rw-r--r--theories/Wellfounded/Lexicographic_Exponentiation.v616
-rw-r--r--theories/Wellfounded/Lexicographic_Product.v223
-rw-r--r--theories/Wellfounded/Transitive_Closure.v38
-rw-r--r--theories/Wellfounded/Union.v87
-rw-r--r--theories/Wellfounded/Well_Ordering.v66
-rw-r--r--theories/Wellfounded/Wellfounded.v1
-rw-r--r--theories/ZArith/BinInt.v1191
-rw-r--r--theories/ZArith/Wf_Z.v260
-rw-r--r--theories/ZArith/ZArith.v2
-rw-r--r--theories/ZArith/ZArith_base.v13
-rw-r--r--theories/ZArith/ZArith_dec.v341
-rw-r--r--theories/ZArith/Zabs.v144
-rw-r--r--theories/ZArith/Zbinary.v421
-rw-r--r--theories/ZArith/Zbool.v196
-rw-r--r--theories/ZArith/Zcompare.v727
-rw-r--r--theories/ZArith/Zcomplements.v268
-rw-r--r--theories/ZArith/Zdiv.v579
-rw-r--r--theories/ZArith/Zeven.v260
-rw-r--r--theories/ZArith/Zhints.v93
-rw-r--r--theories/ZArith/Zlogarithm.v309
-rw-r--r--theories/ZArith/Zmin.v102
-rw-r--r--theories/ZArith/Zmisc.v205
-rw-r--r--theories/ZArith/Znat.v156
-rw-r--r--theories/ZArith/Znumtheory.v846
-rw-r--r--theories/ZArith/Zorder.v1006
-rw-r--r--theories/ZArith/Zpower.v496
-rw-r--r--theories/ZArith/Zsqrt.v233
-rw-r--r--theories/ZArith/Zsyntax.v278
-rw-r--r--theories/ZArith/Zwf.v76
-rw-r--r--theories/ZArith/auxiliary.v251
-rw-r--r--theories/ZArith/fast_integer.v191
-rw-r--r--theories/ZArith/zarith_aux.v151
200 files changed, 47542 insertions, 39875 deletions
diff --git a/theories/Arith/Arith.v b/theories/Arith/Arith.v
index 832ea7a42..dbbb3403e 100755
--- a/theories/Arith/Arith.v
+++ b/theories/Arith/Arith.v
@@ -18,4 +18,4 @@ Require Export Between.
Require Export Minus.
Require Export Peano_dec.
Require Export Compare_dec.
-Require Export Factorial.
+Require Export Factorial. \ No newline at end of file
diff --git a/theories/Arith/Between.v b/theories/Arith/Between.v
index 14b245335..665f96c68 100755
--- a/theories/Arith/Between.v
+++ b/theories/Arith/Between.v
@@ -8,178 +8,182 @@
(*i $Id$ i*)
-Require Le.
-Require Lt.
+Require Import Le.
+Require Import Lt.
-V7only [Import nat_scope.].
Open Local Scope nat_scope.
-Implicit Variables Type k,l,p,q,r:nat.
+Implicit Types k l p q r : nat.
Section Between.
-Variables P,Q : nat -> Prop.
+Variables P Q : nat -> Prop.
-Inductive between [k:nat] : nat -> Prop
- := bet_emp : (between k k)
- | bet_S : (l:nat)(between k l)->(P l)->(between k (S l)).
+Inductive between k : nat -> Prop :=
+ | bet_emp : between k k
+ | bet_S : forall l, between k l -> P l -> between k (S l).
-Hint constr_between : arith v62 := Constructors between.
+Hint Constructors between: arith v62.
-Lemma bet_eq : (k,l:nat)(l=k)->(between k l).
+Lemma bet_eq : forall k l, l = k -> between k l.
Proof.
-NewInduction 1; Auto with arith.
+induction 1; auto with arith.
Qed.
-Hints Resolve bet_eq : arith v62.
+Hint Resolve bet_eq: arith v62.
-Lemma between_le : (k,l:nat)(between k l)->(le k l).
+Lemma between_le : forall k l, between k l -> k <= l.
Proof.
-NewInduction 1; Auto with arith.
+induction 1; auto with arith.
Qed.
-Hints Immediate between_le : arith v62.
+Hint Immediate between_le: arith v62.
-Lemma between_Sk_l : (k,l:nat)(between k l)->(le (S k) l)->(between (S k) l).
+Lemma between_Sk_l : forall k l, between k l -> S k <= l -> between (S k) l.
Proof.
-NewInduction 1.
-Intros; Absurd (le (S k) k); Auto with arith.
-NewDestruct H; Auto with arith.
+induction 1.
+intros; absurd (S k <= k); auto with arith.
+destruct H; auto with arith.
Qed.
-Hints Resolve between_Sk_l : arith v62.
+Hint Resolve between_Sk_l: arith v62.
-Lemma between_restr :
- (k,l,m:nat)(le k l)->(le l m)->(between k m)->(between l m).
+Lemma between_restr :
+ forall k l (m:nat), k <= l -> l <= m -> between k m -> between l m.
Proof.
-NewInduction 1; Auto with arith.
+induction 1; auto with arith.
Qed.
-Inductive exists [k:nat] : nat -> Prop
- := exists_S : (l:nat)(exists k l)->(exists k (S l))
- | exists_le: (l:nat)(le k l)->(Q l)->(exists k (S l)).
+Inductive exists_between k : nat -> Prop :=
+ | exists_S : forall l, exists_between k l -> exists_between k (S l)
+ | exists_le : forall l, k <= l -> Q l -> exists_between k (S l).
-Hint constr_exists : arith v62 := Constructors exists.
+Hint Constructors exists_between: arith v62.
-Lemma exists_le_S : (k,l:nat)(exists k l)->(le (S k) l).
+Lemma exists_le_S : forall k l, exists_between k l -> S k <= l.
Proof.
-NewInduction 1; Auto with arith.
+induction 1; auto with arith.
Qed.
-Lemma exists_lt : (k,l:nat)(exists k l)->(lt k l).
+Lemma exists_lt : forall k l, exists_between k l -> k < l.
Proof exists_le_S.
-Hints Immediate exists_le_S exists_lt : arith v62.
+Hint Immediate exists_le_S exists_lt: arith v62.
-Lemma exists_S_le : (k,l:nat)(exists k (S l))->(le k l).
+Lemma exists_S_le : forall k l, exists_between k (S l) -> k <= l.
Proof.
-Intros; Apply le_S_n; Auto with arith.
+intros; apply le_S_n; auto with arith.
Qed.
-Hints Immediate exists_S_le : arith v62.
+Hint Immediate exists_S_le: arith v62.
-Definition in_int := [p,q,r:nat](le p r)/\(lt r q).
+Definition in_int p q r := p <= r /\ r < q.
-Lemma in_int_intro : (p,q,r:nat)(le p r)->(lt r q)->(in_int p q r).
+Lemma in_int_intro : forall p q r, p <= r -> r < q -> in_int p q r.
Proof.
-Red; Auto with arith.
+red in |- *; auto with arith.
Qed.
-Hints Resolve in_int_intro : arith v62.
+Hint Resolve in_int_intro: arith v62.
-Lemma in_int_lt : (p,q,r:nat)(in_int p q r)->(lt p q).
+Lemma in_int_lt : forall p q r, in_int p q r -> p < q.
Proof.
-NewInduction 1; Intros.
-Apply le_lt_trans with r; Auto with arith.
+induction 1; intros.
+apply le_lt_trans with r; auto with arith.
Qed.
-Lemma in_int_p_Sq :
- (p,q,r:nat)(in_int p (S q) r)->((in_int p q r) \/ <nat>r=q).
+Lemma in_int_p_Sq :
+ forall p q r, in_int p (S q) r -> in_int p q r \/ r = q :>nat.
Proof.
-NewInduction 1; Intros.
-Elim (le_lt_or_eq r q); Auto with arith.
+induction 1; intros.
+elim (le_lt_or_eq r q); auto with arith.
Qed.
-Lemma in_int_S : (p,q,r:nat)(in_int p q r)->(in_int p (S q) r).
+Lemma in_int_S : forall p q r, in_int p q r -> in_int p (S q) r.
Proof.
-NewInduction 1;Auto with arith.
+induction 1; auto with arith.
Qed.
-Hints Resolve in_int_S : arith v62.
+Hint Resolve in_int_S: arith v62.
-Lemma in_int_Sp_q : (p,q,r:nat)(in_int (S p) q r)->(in_int p q r).
+Lemma in_int_Sp_q : forall p q r, in_int (S p) q r -> in_int p q r.
Proof.
-NewInduction 1; Auto with arith.
+induction 1; auto with arith.
Qed.
-Hints Immediate in_int_Sp_q : arith v62.
+Hint Immediate in_int_Sp_q: arith v62.
-Lemma between_in_int : (k,l:nat)(between k l)->(r:nat)(in_int k l r)->(P r).
+Lemma between_in_int :
+ forall k l, between k l -> forall r, in_int k l r -> P r.
Proof.
-NewInduction 1; Intros.
-Absurd (lt k k); Auto with arith.
-Apply in_int_lt with r; Auto with arith.
-Elim (in_int_p_Sq k l r); Intros; Auto with arith.
-Rewrite H2; Trivial with arith.
+induction 1; intros.
+absurd (k < k); auto with arith.
+apply in_int_lt with r; auto with arith.
+elim (in_int_p_Sq k l r); intros; auto with arith.
+rewrite H2; trivial with arith.
Qed.
-Lemma in_int_between :
- (k,l:nat)(le k l)->((r:nat)(in_int k l r)->(P r))->(between k l).
+Lemma in_int_between :
+ forall k l, k <= l -> (forall r, in_int k l r -> P r) -> between k l.
Proof.
-NewInduction 1; Auto with arith.
+induction 1; auto with arith.
Qed.
-Lemma exists_in_int :
- (k,l:nat)(exists k l)->(EX m:nat | (in_int k l m) & (Q m)).
+Lemma exists_in_int :
+ forall k l, exists_between k l -> exists2 m : nat | in_int k l m & Q m.
Proof.
-NewInduction 1.
-Case IHexists; Intros p inp Qp; Exists p; Auto with arith.
-Exists l; Auto with arith.
+induction 1.
+case IHexists_between; intros p inp Qp; exists p; auto with arith.
+exists l; auto with arith.
Qed.
-Lemma in_int_exists : (k,l,r:nat)(in_int k l r)->(Q r)->(exists k l).
+Lemma in_int_exists : forall k l r, in_int k l r -> Q r -> exists_between k l.
Proof.
-NewDestruct 1; Intros.
-Elim H0; Auto with arith.
+destruct 1; intros.
+elim H0; auto with arith.
Qed.
-Lemma between_or_exists :
- (k,l:nat)(le k l)->((n:nat)(in_int k l n)->((P n)\/(Q n)))
- ->((between k l)\/(exists k l)).
+Lemma between_or_exists :
+ forall k l,
+ k <= l ->
+ (forall n:nat, in_int k l n -> P n \/ Q n) ->
+ between k l \/ exists_between k l.
Proof.
-NewInduction 1; Intros; Auto with arith.
-Elim IHle; Intro; Auto with arith.
-Elim (H0 m); Auto with arith.
+induction 1; intros; auto with arith.
+elim IHle; intro; auto with arith.
+elim (H0 m); auto with arith.
Qed.
-Lemma between_not_exists : (k,l:nat)(between k l)->
- ((n:nat)(in_int k l n) -> (P n) -> ~(Q n))
- -> ~(exists k l).
+Lemma between_not_exists :
+ forall k l,
+ between k l ->
+ (forall n:nat, in_int k l n -> P n -> ~ Q n) -> ~ exists_between k l.
Proof.
-NewInduction 1; Red; Intros.
-Absurd (lt k k); Auto with arith.
-Absurd (Q l); Auto with arith.
-Elim (exists_in_int k (S l)); Auto with arith; Intros l' inl' Ql'.
-Replace l with l'; Auto with arith.
-Elim inl'; Intros.
-Elim (le_lt_or_eq l' l); Auto with arith; Intros.
-Absurd (exists k l); Auto with arith.
-Apply in_int_exists with l'; Auto with arith.
+induction 1; red in |- *; intros.
+absurd (k < k); auto with arith.
+absurd (Q l); auto with arith.
+elim (exists_in_int k (S l)); auto with arith; intros l' inl' Ql'.
+replace l with l'; auto with arith.
+elim inl'; intros.
+elim (le_lt_or_eq l' l); auto with arith; intros.
+absurd (exists_between k l); auto with arith.
+apply in_int_exists with l'; auto with arith.
Qed.
-Inductive P_nth [init:nat] : nat->nat->Prop
- := nth_O : (P_nth init init O)
- | nth_S : (k,l:nat)(n:nat)(P_nth init k n)->(between (S k) l)
- ->(Q l)->(P_nth init l (S n)).
+Inductive P_nth (init:nat) : nat -> nat -> Prop :=
+ | nth_O : P_nth init init 0
+ | nth_S :
+ forall k l (n:nat),
+ P_nth init k n -> between (S k) l -> Q l -> P_nth init l (S n).
-Lemma nth_le : (init,l,n:nat)(P_nth init l n)->(le init l).
+Lemma nth_le : forall (init:nat) l (n:nat), P_nth init l n -> init <= l.
Proof.
-NewInduction 1; Intros; Auto with arith.
-Apply le_trans with (S k); Auto with arith.
+induction 1; intros; auto with arith.
+apply le_trans with (S k); auto with arith.
Qed.
-Definition eventually := [n:nat](EX k:nat | (le k n) & (Q k)).
+Definition eventually (n:nat) := exists2 k : nat | k <= n & Q k.
-Lemma event_O : (eventually O)->(Q O).
+Lemma event_O : eventually 0 -> Q 0.
Proof.
-NewInduction 1; Intros.
-Replace O with x; Auto with arith.
+induction 1; intros.
+replace 0 with x; auto with arith.
Qed.
End Between.
-Hints Resolve nth_O bet_S bet_emp bet_eq between_Sk_l exists_S exists_le
- in_int_S in_int_intro : arith v62.
-Hints Immediate in_int_Sp_q exists_le_S exists_S_le : arith v62.
+Hint Resolve nth_O bet_S bet_emp bet_eq between_Sk_l exists_S exists_le
+ in_int_S in_int_intro: arith v62.
+Hint Immediate in_int_Sp_q exists_le_S exists_S_le: arith v62. \ No newline at end of file
diff --git a/theories/Arith/Bool_nat.v b/theories/Arith/Bool_nat.v
index f9f6eeb19..8b1b3a8c2 100644
--- a/theories/Arith/Bool_nat.v
+++ b/theories/Arith/Bool_nat.v
@@ -10,34 +10,30 @@
Require Export Compare_dec.
Require Export Peano_dec.
-Require Sumbool.
+Require Import Sumbool.
-V7only [Import nat_scope.].
Open Local Scope nat_scope.
-Implicit Variables Type m,n,x,y:nat.
+Implicit Types m n x y : nat.
(** The decidability of equality and order relations over
type [nat] give some boolean functions with the adequate specification. *)
-Definition notzerop := [n:nat] (sumbool_not ? ? (zerop n)).
-Definition lt_ge_dec : (x,y:nat){(lt x y)}+{(ge x y)} :=
- [n,m:nat] (sumbool_not ? ? (le_lt_dec m n)).
+Definition notzerop n := sumbool_not _ _ (zerop n).
+Definition lt_ge_dec : forall x y, {x < y} + {x >= y} :=
+ fun n m => sumbool_not _ _ (le_lt_dec m n).
-Definition nat_lt_ge_bool :=
- [x,y:nat](bool_of_sumbool (lt_ge_dec x y)).
-Definition nat_ge_lt_bool :=
- [x,y:nat](bool_of_sumbool (sumbool_not ? ? (lt_ge_dec x y))).
+Definition nat_lt_ge_bool x y := bool_of_sumbool (lt_ge_dec x y).
+Definition nat_ge_lt_bool x y :=
+ bool_of_sumbool (sumbool_not _ _ (lt_ge_dec x y)).
-Definition nat_le_gt_bool :=
- [x,y:nat](bool_of_sumbool (le_gt_dec x y)).
-Definition nat_gt_le_bool :=
- [x,y:nat](bool_of_sumbool (sumbool_not ? ? (le_gt_dec x y))).
+Definition nat_le_gt_bool x y := bool_of_sumbool (le_gt_dec x y).
+Definition nat_gt_le_bool x y :=
+ bool_of_sumbool (sumbool_not _ _ (le_gt_dec x y)).
-Definition nat_eq_bool :=
- [x,y:nat](bool_of_sumbool (eq_nat_dec x y)).
-Definition nat_noteq_bool :=
- [x,y:nat](bool_of_sumbool (sumbool_not ? ? (eq_nat_dec x y))).
+Definition nat_eq_bool x y := bool_of_sumbool (eq_nat_dec x y).
+Definition nat_noteq_bool x y :=
+ bool_of_sumbool (sumbool_not _ _ (eq_nat_dec x y)).
-Definition zerop_bool := [x:nat](bool_of_sumbool (zerop x)).
-Definition notzerop_bool := [x:nat](bool_of_sumbool (notzerop x)).
+Definition zerop_bool x := bool_of_sumbool (zerop x).
+Definition notzerop_bool x := bool_of_sumbool (notzerop x). \ No newline at end of file
diff --git a/theories/Arith/Compare.v b/theories/Arith/Compare.v
index 88055f11e..b5afebd94 100755
--- a/theories/Arith/Compare.v
+++ b/theories/Arith/Compare.v
@@ -9,7 +9,6 @@
(*i $Id$ i*)
(** Equality is decidable on [nat] *)
-V7only [Import nat_scope.].
Open Local Scope nat_scope.
(*
@@ -19,42 +18,42 @@ Hints Immediate not_eq_sym : arith.
*)
Notation not_eq_sym := sym_not_eq.
-Implicit Variables Type m,n,p,q:nat.
+Implicit Types m n p q : nat.
-Require Arith.
-Require Peano_dec.
-Require Compare_dec.
+Require Import Arith.
+Require Import Peano_dec.
+Require Import Compare_dec.
Definition le_or_le_S := le_le_S_dec.
-Definition compare := gt_eq_gt_dec.
+Definition Pcompare := gt_eq_gt_dec.
-Lemma le_dec : (n,m:nat) {le n m} + {le m n}.
+Lemma le_dec : forall n m, {n <= m} + {m <= n}.
Proof le_ge_dec.
-Definition lt_or_eq := [n,m:nat]{(gt m n)}+{n=m}.
+Definition lt_or_eq n m := {m > n} + {n = m}.
-Lemma le_decide : (n,m:nat)(le n m)->(lt_or_eq n m).
+Lemma le_decide : forall n m, n <= m -> lt_or_eq n m.
Proof le_lt_eq_dec.
-Lemma le_le_S_eq : (p,q:nat)(le p q)->((le (S p) q)\/(p=q)).
+Lemma le_le_S_eq : forall n m, n <= m -> S n <= m \/ n = m.
Proof le_lt_or_eq.
(* By special request of G. Kahn - Used in Group Theory *)
-Lemma discrete_nat : (m, n: nat) (lt m n) ->
- (S m) = n \/ (EX r: nat | n = (S (S (plus m r)))).
+Lemma discrete_nat :
+ forall n m, n < m -> S n = m \/ ( exists r : nat | m = S (S (n + r))).
Proof.
-Intros m n H.
-LApply (lt_le_S m n); Auto with arith.
-Intro H'; LApply (le_lt_or_eq (S m) n); Auto with arith.
-NewInduction 1; Auto with arith.
-Right; Exists (minus n (S (S m))); Simpl.
-Rewrite (plus_sym m (minus n (S (S m)))).
-Rewrite (plus_n_Sm (minus n (S (S m))) m).
-Rewrite (plus_n_Sm (minus n (S (S m))) (S m)).
-Rewrite (plus_sym (minus n (S (S m))) (S (S m))); Auto with arith.
+intros m n H.
+lapply (lt_le_S m n); auto with arith.
+intro H'; lapply (le_lt_or_eq (S m) n); auto with arith.
+induction 1; auto with arith.
+right; exists (n - S (S m)); simpl in |- *.
+rewrite (plus_comm m (n - S (S m))).
+rewrite (plus_n_Sm (n - S (S m)) m).
+rewrite (plus_n_Sm (n - S (S m)) (S m)).
+rewrite (plus_comm (n - S (S m)) (S (S m))); auto with arith.
Qed.
Require Export Wf_nat.
-Require Export Min.
+Require Export Min. \ No newline at end of file
diff --git a/theories/Arith/Compare_dec.v b/theories/Arith/Compare_dec.v
index a7cb9bd92..d88d6f29b 100755
--- a/theories/Arith/Compare_dec.v
+++ b/theories/Arith/Compare_dec.v
@@ -8,102 +8,100 @@
(*i $Id$ i*)
-Require Le.
-Require Lt.
-Require Gt.
-Require Decidable.
+Require Import Le.
+Require Import Lt.
+Require Import Gt.
+Require Import Decidable.
-V7only [Import nat_scope.].
Open Local Scope nat_scope.
-Implicit Variables Type m,n,x,y:nat.
+Implicit Types m n x y : nat.
-Definition zerop : (n:nat){n=O}+{lt O n}.
-NewDestruct n; Auto with arith.
+Definition zerop : forall n, {n = 0} + {0 < n}.
+destruct n; auto with arith.
Defined.
-Definition lt_eq_lt_dec : (n,m:nat){(lt n m)}+{n=m}+{(lt m n)}.
+Definition lt_eq_lt_dec : forall n m, {n < m} + {n = m} + {m < n}.
Proof.
-NewInduction n; Destruct m; Auto with arith.
-Intros m0; Elim (IHn m0); Auto with arith.
-NewInduction 1; Auto with arith.
+induction n; simple destruct m; auto with arith.
+intros m0; elim (IHn m0); auto with arith.
+induction 1; auto with arith.
Defined.
-Lemma gt_eq_gt_dec : (n,m:nat)({(gt m n)}+{n=m})+{(gt n m)}.
+Lemma gt_eq_gt_dec : forall n m, {m > n} + {n = m} + {n > m}.
Proof lt_eq_lt_dec.
-Lemma le_lt_dec : (n,m:nat) {le n m} + {lt m n}.
+Lemma le_lt_dec : forall n m, {n <= m} + {m < n}.
Proof.
-NewInduction n.
-Auto with arith.
-NewInduction m.
-Auto with arith.
-Elim (IHn m); Auto with arith.
+induction n.
+auto with arith.
+induction m.
+auto with arith.
+elim (IHn m); auto with arith.
Defined.
-Definition le_le_S_dec : (n,m:nat) {le n m} + {le (S m) n}.
+Definition le_le_S_dec : forall n m, {n <= m} + {S m <= n}.
Proof.
-Exact le_lt_dec.
+exact le_lt_dec.
Defined.
-Definition le_ge_dec : (n,m:nat) {le n m} + {ge n m}.
+Definition le_ge_dec : forall n m, {n <= m} + {n >= m}.
Proof.
-Intros; Elim (le_lt_dec n m); Auto with arith.
+intros; elim (le_lt_dec n m); auto with arith.
Defined.
-Definition le_gt_dec : (n,m:nat){(le n m)}+{(gt n m)}.
+Definition le_gt_dec : forall n m, {n <= m} + {n > m}.
Proof.
-Exact le_lt_dec.
+exact le_lt_dec.
Defined.
-Definition le_lt_eq_dec : (n,m:nat)(le n m)->({(lt n m)}+{n=m}).
+Definition le_lt_eq_dec : forall n m, n <= m -> {n < m} + {n = m}.
Proof.
-Intros; Elim (lt_eq_lt_dec n m); Auto with arith.
-Intros; Absurd (lt m n); Auto with arith.
+intros; elim (lt_eq_lt_dec n m); auto with arith.
+intros; absurd (m < n); auto with arith.
Defined.
(** Proofs of decidability *)
-Theorem dec_le:(x,y:nat)(decidable (le x y)).
-Intros x y; Unfold decidable ; Elim (le_gt_dec x y); [
- Auto with arith
-| Intro; Right; Apply gt_not_le; Assumption].
+Theorem dec_le : forall n m, decidable (n <= m).
+intros x y; unfold decidable in |- *; elim (le_gt_dec x y);
+ [ auto with arith | intro; right; apply gt_not_le; assumption ].
Qed.
-Theorem dec_lt:(x,y:nat)(decidable (lt x y)).
-Intros x y; Unfold lt; Apply dec_le.
+Theorem dec_lt : forall n m, decidable (n < m).
+intros x y; unfold lt in |- *; apply dec_le.
Qed.
-Theorem dec_gt:(x,y:nat)(decidable (gt x y)).
-Intros x y; Unfold gt; Apply dec_lt.
+Theorem dec_gt : forall n m, decidable (n > m).
+intros x y; unfold gt in |- *; apply dec_lt.
Qed.
-Theorem dec_ge:(x,y:nat)(decidable (ge x y)).
-Intros x y; Unfold ge; Apply dec_le.
+Theorem dec_ge : forall n m, decidable (n >= m).
+intros x y; unfold ge in |- *; apply dec_le.
Qed.
-Theorem not_eq : (x,y:nat) ~ x=y -> (lt x y) \/ (lt y x).
-Intros x y H; Elim (lt_eq_lt_dec x y); [
- Intros H1; Elim H1; [ Auto with arith | Intros H2; Absurd x=y; Assumption]
-| Auto with arith].
+Theorem not_eq : forall n m, n <> m -> n < m \/ m < n.
+intros x y H; elim (lt_eq_lt_dec x y);
+ [ intros H1; elim H1;
+ [ auto with arith | intros H2; absurd (x = y); assumption ]
+ | auto with arith ].
Qed.
-Theorem not_le : (x,y:nat) ~(le x y) -> (gt x y).
-Intros x y H; Elim (le_gt_dec x y);
- [ Intros H1; Absurd (le x y); Assumption | Trivial with arith ].
+Theorem not_le : forall n m, ~ n <= m -> n > m.
+intros x y H; elim (le_gt_dec x y);
+ [ intros H1; absurd (x <= y); assumption | trivial with arith ].
Qed.
-Theorem not_gt : (x,y:nat) ~(gt x y) -> (le x y).
-Intros x y H; Elim (le_gt_dec x y);
- [ Trivial with arith | Intros H1; Absurd (gt x y); Assumption].
+Theorem not_gt : forall n m, ~ n > m -> n <= m.
+intros x y H; elim (le_gt_dec x y);
+ [ trivial with arith | intros H1; absurd (x > y); assumption ].
Qed.
-Theorem not_ge : (x,y:nat) ~(ge x y) -> (lt x y).
-Intros x y H; Exact (not_le y x H).
+Theorem not_ge : forall n m, ~ n >= m -> n < m.
+intros x y H; exact (not_le y x H).
Qed.
-Theorem not_lt : (x,y:nat) ~(lt x y) -> (ge x y).
-Intros x y H; Exact (not_gt y x H).
+Theorem not_lt : forall n m, ~ n < m -> n >= m.
+intros x y H; exact (not_gt y x H).
Qed.
-
diff --git a/theories/Arith/Div2.v b/theories/Arith/Div2.v
index 9ab8fc820..911b0b386 100644
--- a/theories/Arith/Div2.v
+++ b/theories/Arith/Div2.v
@@ -8,153 +8,155 @@
(*i $Id$ i*)
-Require Lt.
-Require Plus.
-Require Compare_dec.
-Require Even.
+Require Import Lt.
+Require Import Plus.
+Require Import Compare_dec.
+Require Import Even.
-V7only [Import nat_scope.].
Open Local Scope nat_scope.
-Implicit Variables Type n:nat.
+Implicit Type n : nat.
(** Here we define [n/2] and prove some of its properties *)
-Fixpoint div2 [n:nat] : nat :=
- Cases n of
- O => O
- | (S O) => O
- | (S (S n')) => (S (div2 n'))
+Fixpoint div2 n : nat :=
+ match n with
+ | O => 0
+ | S O => 0
+ | S (S n') => S (div2 n')
end.
(** Since [div2] is recursively defined on [0], [1] and [(S (S n))], it is
useful to prove the corresponding induction principle *)
-Lemma ind_0_1_SS : (P:nat->Prop)
- (P O) -> (P (S O)) -> ((n:nat)(P n)->(P (S (S n)))) -> (n:nat)(P n).
+Lemma ind_0_1_SS :
+ forall P:nat -> Prop,
+ P 0 -> P 1 -> (forall n, P n -> P (S (S n))) -> forall n, P n.
Proof.
-Intros.
-Cut (n:nat)(P n)/\(P (S n)).
-Intros. Elim (H2 n). Auto with arith.
+intros.
+cut (forall n, P n /\ P (S n)).
+intros. elim (H2 n). auto with arith.
-NewInduction n0. Auto with arith.
-Intros. Elim IHn0; Auto with arith.
+induction n0. auto with arith.
+intros. elim IHn0; auto with arith.
Qed.
(** [0 <n => n/2 < n] *)
-Lemma lt_div2 : (n:nat) (lt O n) -> (lt (div2 n) n).
+Lemma lt_div2 : forall n, 0 < n -> div2 n < n.
Proof.
-Intro n. Pattern n. Apply ind_0_1_SS.
-Intro. Inversion H.
-Auto with arith.
-Intros. Simpl.
-Case (zerop n0).
-Intro. Rewrite e. Auto with arith.
-Auto with arith.
+intro n. pattern n in |- *. apply ind_0_1_SS.
+intro. inversion H.
+auto with arith.
+intros. simpl in |- *.
+case (zerop n0).
+intro. rewrite e. auto with arith.
+auto with arith.
Qed.
-Hints Resolve lt_div2 : arith.
+Hint Resolve lt_div2: arith.
(** Properties related to the parity *)
-Lemma even_odd_div2 : (n:nat)
- ((even n)<->(div2 n)=(div2 (S n))) /\ ((odd n)<->(S (div2 n))=(div2 (S n))).
+Lemma even_odd_div2 :
+ forall n,
+ (even n <-> div2 n = div2 (S n)) /\ (odd n <-> S (div2 n) = div2 (S n)).
Proof.
-Intro n. Pattern n. Apply ind_0_1_SS.
+intro n. pattern n in |- *. apply ind_0_1_SS.
(* n = 0 *)
-Split. Split; Auto with arith.
-Split. Intro H. Inversion H.
-Intro H. Absurd (S (div2 O))=(div2 (S O)); Auto with arith.
+split. split; auto with arith.
+split. intro H. inversion H.
+intro H. absurd (S (div2 0) = div2 1); auto with arith.
(* n = 1 *)
-Split. Split. Intro. Inversion H. Inversion H1.
-Intro H. Absurd (div2 (S O))=(div2 (S (S O))).
-Simpl. Discriminate. Assumption.
-Split; Auto with arith.
+split. split. intro. inversion H. inversion H1.
+intro H. absurd (div2 1 = div2 2).
+simpl in |- *. discriminate. assumption.
+split; auto with arith.
(* n = (S (S n')) *)
-Intros. Decompose [and] H. Unfold iff in H0 H1.
-Decompose [and] H0. Decompose [and] H1. Clear H H0 H1.
-Split; Split; Auto with arith.
-Intro H. Inversion H. Inversion H1.
-Change (S (div2 n0))=(S (div2 (S n0))). Auto with arith.
-Intro H. Inversion H. Inversion H1.
-Change (S (S (div2 n0)))=(S (div2 (S n0))). Auto with arith.
+intros. decompose [and] H. unfold iff in H0, H1.
+decompose [and] H0. decompose [and] H1. clear H H0 H1.
+split; split; auto with arith.
+intro H. inversion H. inversion H1.
+change (S (div2 n0) = S (div2 (S n0))) in |- *. auto with arith.
+intro H. inversion H. inversion H1.
+change (S (S (div2 n0)) = S (div2 (S n0))) in |- *. auto with arith.
Qed.
(** Specializations *)
-Lemma even_div2 : (n:nat) (even n) -> (div2 n)=(div2 (S n)).
-Proof [n:nat](proj1 ? ? (proj1 ? ? (even_odd_div2 n))).
+Lemma even_div2 : forall n, even n -> div2 n = div2 (S n).
+Proof fun n => proj1 (proj1 (even_odd_div2 n)).
-Lemma div2_even : (n:nat) (div2 n)=(div2 (S n)) -> (even n).
-Proof [n:nat](proj2 ? ? (proj1 ? ? (even_odd_div2 n))).
+Lemma div2_even : forall n, div2 n = div2 (S n) -> even n.
+Proof fun n => proj2 (proj1 (even_odd_div2 n)).
-Lemma odd_div2 : (n:nat) (odd n) -> (S (div2 n))=(div2 (S n)).
-Proof [n:nat](proj1 ? ? (proj2 ? ? (even_odd_div2 n))).
+Lemma odd_div2 : forall n, odd n -> S (div2 n) = div2 (S n).
+Proof fun n => proj1 (proj2 (even_odd_div2 n)).
-Lemma div2_odd : (n:nat) (S (div2 n))=(div2 (S n)) -> (odd n).
-Proof [n:nat](proj2 ? ? (proj2 ? ? (even_odd_div2 n))).
+Lemma div2_odd : forall n, S (div2 n) = div2 (S n) -> odd n.
+Proof fun n => proj2 (proj2 (even_odd_div2 n)).
-Hints Resolve even_div2 div2_even odd_div2 div2_odd : arith.
+Hint Resolve even_div2 div2_even odd_div2 div2_odd: arith.
(** Properties related to the double ([2n]) *)
-Definition double := [n:nat](plus n n).
+Definition double n := n + n.
-Hints Unfold double : arith.
+Hint Unfold double: arith.
-Lemma double_S : (n:nat) (double (S n))=(S (S (double n))).
+Lemma double_S : forall n, double (S n) = S (S (double n)).
Proof.
-Intro. Unfold double. Simpl. Auto with arith.
+intro. unfold double in |- *. simpl in |- *. auto with arith.
Qed.
-Lemma double_plus : (m,n:nat) (double (plus m n))=(plus (double m) (double n)).
+Lemma double_plus : forall n (m:nat), double (n + m) = double n + double m.
Proof.
-Intros m n. Unfold double.
-Do 2 Rewrite -> plus_assoc_r. Rewrite -> (plus_permute n).
-Reflexivity.
+intros m n. unfold double in |- *.
+do 2 rewrite plus_assoc_reverse. rewrite (plus_permute n).
+reflexivity.
Qed.
-Hints Resolve double_S : arith.
+Hint Resolve double_S: arith.
-Lemma even_odd_double : (n:nat)
- ((even n)<->n=(double (div2 n))) /\ ((odd n)<->n=(S (double (div2 n)))).
+Lemma even_odd_double :
+ forall n,
+ (even n <-> n = double (div2 n)) /\ (odd n <-> n = S (double (div2 n))).
Proof.
-Intro n. Pattern n. Apply ind_0_1_SS.
+intro n. pattern n in |- *. apply ind_0_1_SS.
(* n = 0 *)
-Split; Split; Auto with arith.
-Intro H. Inversion H.
+split; split; auto with arith.
+intro H. inversion H.
(* n = 1 *)
-Split; Split; Auto with arith.
-Intro H. Inversion H. Inversion H1.
+split; split; auto with arith.
+intro H. inversion H. inversion H1.
(* n = (S (S n')) *)
-Intros. Decompose [and] H. Unfold iff in H0 H1.
-Decompose [and] H0. Decompose [and] H1. Clear H H0 H1.
-Split; Split.
-Intro H. Inversion H. Inversion H1.
-Simpl. Rewrite (double_S (div2 n0)). Auto with arith.
-Simpl. Rewrite (double_S (div2 n0)). Intro H. Injection H. Auto with arith.
-Intro H. Inversion H. Inversion H1.
-Simpl. Rewrite (double_S (div2 n0)). Auto with arith.
-Simpl. Rewrite (double_S (div2 n0)). Intro H. Injection H. Auto with arith.
+intros. decompose [and] H. unfold iff in H0, H1.
+decompose [and] H0. decompose [and] H1. clear H H0 H1.
+split; split.
+intro H. inversion H. inversion H1.
+simpl in |- *. rewrite (double_S (div2 n0)). auto with arith.
+simpl in |- *. rewrite (double_S (div2 n0)). intro H. injection H. auto with arith.
+intro H. inversion H. inversion H1.
+simpl in |- *. rewrite (double_S (div2 n0)). auto with arith.
+simpl in |- *. rewrite (double_S (div2 n0)). intro H. injection H. auto with arith.
Qed.
(** Specializations *)
-Lemma even_double : (n:nat) (even n) -> n=(double (div2 n)).
-Proof [n:nat](proj1 ? ? (proj1 ? ? (even_odd_double n))).
+Lemma even_double : forall n, even n -> n = double (div2 n).
+Proof fun n => proj1 (proj1 (even_odd_double n)).
-Lemma double_even : (n:nat) n=(double (div2 n)) -> (even n).
-Proof [n:nat](proj2 ? ? (proj1 ? ? (even_odd_double n))).
+Lemma double_even : forall n, n = double (div2 n) -> even n.
+Proof fun n => proj2 (proj1 (even_odd_double n)).
-Lemma odd_double : (n:nat) (odd n) -> n=(S (double (div2 n))).
-Proof [n:nat](proj1 ? ? (proj2 ? ? (even_odd_double n))).
+Lemma odd_double : forall n, odd n -> n = S (double (div2 n)).
+Proof fun n => proj1 (proj2 (even_odd_double n)).
-Lemma double_odd : (n:nat) n=(S (double (div2 n))) -> (odd n).
-Proof [n:nat](proj2 ? ? (proj2 ? ? (even_odd_double n))).
+Lemma double_odd : forall n, n = S (double (div2 n)) -> odd n.
+Proof fun n => proj2 (proj2 (even_odd_double n)).
-Hints Resolve even_double double_even odd_double double_odd : arith.
+Hint Resolve even_double double_even odd_double double_odd: arith.
(** Application:
- if [n] is even then there is a [p] such that [n = 2p]
@@ -162,13 +164,12 @@ Hints Resolve even_double double_even odd_double double_odd : arith.
(Immediate: it is [n/2]) *)
-Lemma even_2n : (n:nat) (even n) -> { p:nat | n=(double p) }.
+Lemma even_2n : forall n, even n -> {p : nat | n = double p}.
Proof.
-Intros n H. Exists (div2 n). Auto with arith.
+intros n H. exists (div2 n). auto with arith.
Qed.
-Lemma odd_S2n : (n:nat) (odd n) -> { p:nat | n=(S (double p)) }.
+Lemma odd_S2n : forall n, odd n -> {p : nat | n = S (double p)}.
Proof.
-Intros n H. Exists (div2 n). Auto with arith.
+intros n H. exists (div2 n). auto with arith.
Qed.
-
diff --git a/theories/Arith/EqNat.v b/theories/Arith/EqNat.v
index a0ba5127d..f1246ceaf 100755
--- a/theories/Arith/EqNat.v
+++ b/theories/Arith/EqNat.v
@@ -10,69 +10,68 @@
(** Equality on natural numbers *)
-V7only [Import nat_scope.].
Open Local Scope nat_scope.
-Implicit Variables Type m,n,x,y:nat.
+Implicit Types m n x y : nat.
-Fixpoint eq_nat [n:nat] : nat -> Prop :=
- [m:nat]Cases n m of
- O O => True
- | O (S _) => False
- | (S _) O => False
- | (S n1) (S m1) => (eq_nat n1 m1)
- end.
+Fixpoint eq_nat n m {struct n} : Prop :=
+ match n, m with
+ | O, O => True
+ | O, S _ => False
+ | S _, O => False
+ | S n1, S m1 => eq_nat n1 m1
+ end.
-Theorem eq_nat_refl : (n:nat)(eq_nat n n).
-NewInduction n; Simpl; Auto.
+Theorem eq_nat_refl : forall n, eq_nat n n.
+induction n; simpl in |- *; auto.
Qed.
-Hints Resolve eq_nat_refl : arith v62.
+Hint Resolve eq_nat_refl: arith v62.
-Theorem eq_eq_nat : (n,m:nat)(n=m)->(eq_nat n m).
-NewInduction 1; Trivial with arith.
+Theorem eq_eq_nat : forall n m, n = m -> eq_nat n m.
+induction 1; trivial with arith.
Qed.
-Hints Immediate eq_eq_nat : arith v62.
+Hint Immediate eq_eq_nat: arith v62.
-Theorem eq_nat_eq : (n,m:nat)(eq_nat n m)->(n=m).
-NewInduction n; NewInduction m; Simpl; Contradiction Orelse Auto with arith.
+Theorem eq_nat_eq : forall n m, eq_nat n m -> n = m.
+induction n; induction m; simpl in |- *; contradiction || auto with arith.
Qed.
-Hints Immediate eq_nat_eq : arith v62.
+Hint Immediate eq_nat_eq: arith v62.
-Theorem eq_nat_elim : (n:nat)(P:nat->Prop)(P n)->(m:nat)(eq_nat n m)->(P m).
-Intros; Replace m with n; Auto with arith.
+Theorem eq_nat_elim :
+ forall n (P:nat -> Prop), P n -> forall m, eq_nat n m -> P m.
+intros; replace m with n; auto with arith.
Qed.
-Theorem eq_nat_decide : (n,m:nat){(eq_nat n m)}+{~(eq_nat n m)}.
-NewInduction n.
-NewDestruct m.
-Auto with arith.
-Intros; Right; Red; Trivial with arith.
-NewDestruct m.
-Right; Red; Auto with arith.
-Intros.
-Simpl.
-Apply IHn.
+Theorem eq_nat_decide : forall n m, {eq_nat n m} + {~ eq_nat n m}.
+induction n.
+destruct m as [| n].
+auto with arith.
+intros; right; red in |- *; trivial with arith.
+destruct m as [| n0].
+right; red in |- *; auto with arith.
+intros.
+simpl in |- *.
+apply IHn.
Defined.
-Fixpoint beq_nat [n:nat] : nat -> bool :=
- [m:nat]Cases n m of
- O O => true
- | O (S _) => false
- | (S _) O => false
- | (S n1) (S m1) => (beq_nat n1 m1)
- end.
+Fixpoint beq_nat n m {struct n} : bool :=
+ match n, m with
+ | O, O => true
+ | O, S _ => false
+ | S _, O => false
+ | S n1, S m1 => beq_nat n1 m1
+ end.
-Lemma beq_nat_refl : (x:nat)true=(beq_nat x x).
+Lemma beq_nat_refl : forall n, true = beq_nat n n.
Proof.
- Intro x; NewInduction x; Simpl; Auto.
+ intro x; induction x; simpl in |- *; auto.
Qed.
-Definition beq_nat_eq : (x,y:nat)true=(beq_nat x y)->x=y.
+Definition beq_nat_eq : forall x y, true = beq_nat x y -> x = y.
Proof.
- Double Induction x y; Simpl.
- Reflexivity.
- Intros; Discriminate H0.
- Intros; Discriminate H0.
- Intros; Case (H0 ? H1); Reflexivity.
+ double induction x y; simpl in |- *.
+ reflexivity.
+ intros; discriminate H0.
+ intros; discriminate H0.
+ intros; case (H0 _ H1); reflexivity.
Defined.
-
diff --git a/theories/Arith/Euclid.v b/theories/Arith/Euclid.v
index f64d932e7..02c48f028 100644
--- a/theories/Arith/Euclid.v
+++ b/theories/Arith/Euclid.v
@@ -8,58 +8,61 @@
(*i $Id$ i*)
-Require Mult.
-Require Compare_dec.
-Require Wf_nat.
+Require Import Mult.
+Require Import Compare_dec.
+Require Import Wf_nat.
-V7only [Import nat_scope.].
Open Local Scope nat_scope.
-Implicit Variables Type a,b,n,q,r:nat.
+Implicit Types a b n q r : nat.
-Inductive diveucl [a,b:nat] : Set
- := divex : (q,r:nat)(gt b r)->(a=(plus (mult q b) r))->(diveucl a b).
+Inductive diveucl a b : Set :=
+ divex : forall q r, b > r -> a = q * b + r -> diveucl a b.
-Lemma eucl_dev : (b:nat)(gt b O)->(a:nat)(diveucl a b).
-Intros b H a; Pattern a; Apply gt_wf_rec; Intros n H0.
-Elim (le_gt_dec b n).
-Intro lebn.
-Elim (H0 (minus n b)); Auto with arith.
-Intros q r g e.
-Apply divex with (S q) r; Simpl; Auto with arith.
-Elim plus_assoc_l.
-Elim e; Auto with arith.
-Intros gtbn.
-Apply divex with O n; Simpl; Auto with arith.
+Lemma eucl_dev : forall n, n > 0 -> forall m:nat, diveucl m n.
+intros b H a; pattern a in |- *; apply gt_wf_rec; intros n H0.
+elim (le_gt_dec b n).
+intro lebn.
+elim (H0 (n - b)); auto with arith.
+intros q r g e.
+apply divex with (S q) r; simpl in |- *; auto with arith.
+elim plus_assoc.
+elim e; auto with arith.
+intros gtbn.
+apply divex with 0 n; simpl in |- *; auto with arith.
Qed.
-Lemma quotient : (b:nat)(gt b O)->
- (a:nat){q:nat|(EX r:nat | (a=(plus (mult q b) r))/\(gt b r))}.
-Intros b H a; Pattern a; Apply gt_wf_rec; Intros n H0.
-Elim (le_gt_dec b n).
-Intro lebn.
-Elim (H0 (minus n b)); Auto with arith.
-Intros q Hq; Exists (S q).
-Elim Hq; Intros r Hr.
-Exists r; Simpl; Elim Hr; Intros.
-Elim plus_assoc_l.
-Elim H1; Auto with arith.
-Intros gtbn.
-Exists O; Exists n; Simpl; Auto with arith.
+Lemma quotient :
+ forall n,
+ n > 0 ->
+ forall m:nat, {q : nat | exists r : nat | m = q * n + r /\ n > r}.
+intros b H a; pattern a in |- *; apply gt_wf_rec; intros n H0.
+elim (le_gt_dec b n).
+intro lebn.
+elim (H0 (n - b)); auto with arith.
+intros q Hq; exists (S q).
+elim Hq; intros r Hr.
+exists r; simpl in |- *; elim Hr; intros.
+elim plus_assoc.
+elim H1; auto with arith.
+intros gtbn.
+exists 0; exists n; simpl in |- *; auto with arith.
Qed.
-Lemma modulo : (b:nat)(gt b O)->
- (a:nat){r:nat|(EX q:nat | (a=(plus (mult q b) r))/\(gt b r))}.
-Intros b H a; Pattern a; Apply gt_wf_rec; Intros n H0.
-Elim (le_gt_dec b n).
-Intro lebn.
-Elim (H0 (minus n b)); Auto with arith.
-Intros r Hr; Exists r.
-Elim Hr; Intros q Hq.
-Elim Hq; Intros; Exists (S q); Simpl.
-Elim plus_assoc_l.
-Elim H1; Auto with arith.
-Intros gtbn.
-Exists n; Exists O; Simpl; Auto with arith.
-Qed.
+Lemma modulo :
+ forall n,
+ n > 0 ->
+ forall m:nat, {r : nat | exists q : nat | m = q * n + r /\ n > r}.
+intros b H a; pattern a in |- *; apply gt_wf_rec; intros n H0.
+elim (le_gt_dec b n).
+intro lebn.
+elim (H0 (n - b)); auto with arith.
+intros r Hr; exists r.
+elim Hr; intros q Hq.
+elim Hq; intros; exists (S q); simpl in |- *.
+elim plus_assoc.
+elim H1; auto with arith.
+intros gtbn.
+exists n; exists 0; simpl in |- *; auto with arith.
+Qed. \ No newline at end of file
diff --git a/theories/Arith/Even.v b/theories/Arith/Even.v
index 88ad1851b..0017a464b 100644
--- a/theories/Arith/Even.v
+++ b/theories/Arith/Even.v
@@ -12,299 +12,294 @@
and we prove the decidability and the exclusion of those predicates.
The main results about parity are proved in the module Div2. *)
-V7only [Import nat_scope.].
Open Local Scope nat_scope.
-Implicit Variables Type m,n:nat.
+Implicit Types m n : nat.
-Inductive even : nat->Prop :=
- even_O : (even O)
- | even_S : (n:nat)(odd n)->(even (S n))
-with odd : nat->Prop :=
- odd_S : (n:nat)(even n)->(odd (S n)).
+Inductive even : nat -> Prop :=
+ | even_O : even 0
+ | even_S : forall n, odd n -> even (S n)
+with odd : nat -> Prop :=
+ odd_S : forall n, even n -> odd (S n).
-Hint constr_even : arith := Constructors even.
-Hint constr_odd : arith := Constructors odd.
+Hint Constructors even: arith.
+Hint Constructors odd: arith.
-Lemma even_or_odd : (n:nat) (even n)\/(odd n).
+Lemma even_or_odd : forall n, even n \/ odd n.
Proof.
-NewInduction n.
-Auto with arith.
-Elim IHn; Auto with arith.
+induction n.
+auto with arith.
+elim IHn; auto with arith.
Qed.
-Lemma even_odd_dec : (n:nat) { (even n) }+{ (odd n) }.
+Lemma even_odd_dec : forall n, {even n} + {odd n}.
Proof.
-NewInduction n.
-Auto with arith.
-Elim IHn; Auto with arith.
+induction n.
+auto with arith.
+elim IHn; auto with arith.
Qed.
-Lemma not_even_and_odd : (n:nat) (even n) -> (odd n) -> False.
+Lemma not_even_and_odd : forall n, even n -> odd n -> False.
Proof.
-NewInduction n.
-Intros. Inversion H0.
-Intros. Inversion H. Inversion H0. Auto with arith.
+induction n.
+intros. inversion H0.
+intros. inversion H. inversion H0. auto with arith.
Qed.
-Lemma even_plus_aux:
- (n,m:nat)
- (iff (odd (plus n m)) (odd n) /\ (even m) \/ (even n) /\ (odd m)) /\
- (iff (even (plus n m)) (even n) /\ (even m) \/ (odd n) /\ (odd m)).
+Lemma even_plus_aux :
+ forall n m,
+ (odd (n + m) <-> odd n /\ even m \/ even n /\ odd m) /\
+ (even (n + m) <-> even n /\ even m \/ odd n /\ odd m).
Proof.
-Intros n; Elim n; Simpl; Auto with arith.
-Intros m; Split; Auto.
-Split.
-Intros H; Right; Split; Auto with arith.
-Intros H'; Case H'; Auto with arith.
-Intros H'0; Elim H'0; Intros H'1 H'2; Inversion H'1.
-Intros H; Elim H; Auto.
-Split; Auto with arith.
-Intros H'; Elim H'; Auto with arith.
-Intros H; Elim H; Auto.
-Intros H'0; Elim H'0; Intros H'1 H'2; Inversion H'1.
-Intros n0 H' m; Elim (H' m); Intros H'1 H'2; Elim H'1; Intros E1 E2; Elim H'2;
- Intros E3 E4; Clear H'1 H'2.
-Split; Split.
-Intros H'0; Case E3.
-Inversion H'0; Auto.
-Intros H; Elim H; Intros H0 H1; Clear H; Auto with arith.
-Intros H; Elim H; Intros H0 H1; Clear H; Auto with arith.
-Intros H'0; Case H'0; Intros C0; Case C0; Intros C1 C2.
-Apply odd_S.
-Apply E4; Left; Split; Auto with arith.
-Inversion C1; Auto.
-Apply odd_S.
-Apply E4; Right; Split; Auto with arith.
-Inversion C1; Auto.
-Intros H'0.
-Case E1.
-Inversion H'0; Auto.
-Intros H; Elim H; Intros H0 H1; Clear H; Auto with arith.
-Intros H; Elim H; Intros H0 H1; Clear H; Auto with arith.
-Intros H'0; Case H'0; Intros C0; Case C0; Intros C1 C2.
-Apply even_S.
-Apply E2; Left; Split; Auto with arith.
-Inversion C1; Auto.
-Apply even_S.
-Apply E2; Right; Split; Auto with arith.
-Inversion C1; Auto.
+intros n; elim n; simpl in |- *; auto with arith.
+intros m; split; auto.
+split.
+intros H; right; split; auto with arith.
+intros H'; case H'; auto with arith.
+intros H'0; elim H'0; intros H'1 H'2; inversion H'1.
+intros H; elim H; auto.
+split; auto with arith.
+intros H'; elim H'; auto with arith.
+intros H; elim H; auto.
+intros H'0; elim H'0; intros H'1 H'2; inversion H'1.
+intros n0 H' m; elim (H' m); intros H'1 H'2; elim H'1; intros E1 E2; elim H'2;
+ intros E3 E4; clear H'1 H'2.
+split; split.
+intros H'0; case E3.
+inversion H'0; auto.
+intros H; elim H; intros H0 H1; clear H; auto with arith.
+intros H; elim H; intros H0 H1; clear H; auto with arith.
+intros H'0; case H'0; intros C0; case C0; intros C1 C2.
+apply odd_S.
+apply E4; left; split; auto with arith.
+inversion C1; auto.
+apply odd_S.
+apply E4; right; split; auto with arith.
+inversion C1; auto.
+intros H'0.
+case E1.
+inversion H'0; auto.
+intros H; elim H; intros H0 H1; clear H; auto with arith.
+intros H; elim H; intros H0 H1; clear H; auto with arith.
+intros H'0; case H'0; intros C0; case C0; intros C1 C2.
+apply even_S.
+apply E2; left; split; auto with arith.
+inversion C1; auto.
+apply even_S.
+apply E2; right; split; auto with arith.
+inversion C1; auto.
Qed.
-Lemma even_even_plus : (n,m:nat) (even n) -> (even m) -> (even (plus n m)).
+Lemma even_even_plus : forall n m, even n -> even m -> even (n + m).
Proof.
-Intros n m; Case (even_plus_aux n m).
-Intros H H0; Case H0; Auto.
+intros n m; case (even_plus_aux n m).
+intros H H0; case H0; auto.
Qed.
-Lemma odd_even_plus : (n,m:nat) (odd n) -> (odd m) -> (even (plus n m)).
+Lemma odd_even_plus : forall n m, odd n -> odd m -> even (n + m).
Proof.
-Intros n m; Case (even_plus_aux n m).
-Intros H H0; Case H0; Auto.
+intros n m; case (even_plus_aux n m).
+intros H H0; case H0; auto.
Qed.
-Lemma even_plus_even_inv_r :
- (n,m:nat) (even (plus n m)) -> (even n) -> (even m).
+Lemma even_plus_even_inv_r : forall n m, even (n + m) -> even n -> even m.
Proof.
-Intros n m H; Case (even_plus_aux n m).
-Intros H' H'0; Elim H'0.
-Intros H'1; Case H'1; Auto.
-Intros H0; Elim H0; Auto.
-Intros H0 H1 H2; Case (not_even_and_odd n); Auto.
-Case H0; Auto.
+intros n m H; case (even_plus_aux n m).
+intros H' H'0; elim H'0.
+intros H'1; case H'1; auto.
+intros H0; elim H0; auto.
+intros H0 H1 H2; case (not_even_and_odd n); auto.
+case H0; auto.
Qed.
-Lemma even_plus_even_inv_l :
- (n,m:nat) (even (plus n m)) -> (even m) -> (even n).
+Lemma even_plus_even_inv_l : forall n m, even (n + m) -> even m -> even n.
Proof.
-Intros n m H; Case (even_plus_aux n m).
-Intros H' H'0; Elim H'0.
-Intros H'1; Case H'1; Auto.
-Intros H0; Elim H0; Auto.
-Intros H0 H1 H2; Case (not_even_and_odd m); Auto.
-Case H0; Auto.
+intros n m H; case (even_plus_aux n m).
+intros H' H'0; elim H'0.
+intros H'1; case H'1; auto.
+intros H0; elim H0; auto.
+intros H0 H1 H2; case (not_even_and_odd m); auto.
+case H0; auto.
Qed.
-Lemma even_plus_odd_inv_r : (n,m:nat) (even (plus n m)) -> (odd n) -> (odd m).
+Lemma even_plus_odd_inv_r : forall n m, even (n + m) -> odd n -> odd m.
Proof.
-Intros n m H; Case (even_plus_aux n m).
-Intros H' H'0; Elim H'0.
-Intros H'1; Case H'1; Auto.
-Intros H0 H1 H2; Case (not_even_and_odd n); Auto.
-Case H0; Auto.
-Intros H0; Case H0; Auto.
+intros n m H; case (even_plus_aux n m).
+intros H' H'0; elim H'0.
+intros H'1; case H'1; auto.
+intros H0 H1 H2; case (not_even_and_odd n); auto.
+case H0; auto.
+intros H0; case H0; auto.
Qed.
-Lemma even_plus_odd_inv_l : (n,m:nat) (even (plus n m)) -> (odd m) -> (odd n).
+Lemma even_plus_odd_inv_l : forall n m, even (n + m) -> odd m -> odd n.
Proof.
-Intros n m H; Case (even_plus_aux n m).
-Intros H' H'0; Elim H'0.
-Intros H'1; Case H'1; Auto.
-Intros H0 H1 H2; Case (not_even_and_odd m); Auto.
-Case H0; Auto.
-Intros H0; Case H0; Auto.
+intros n m H; case (even_plus_aux n m).
+intros H' H'0; elim H'0.
+intros H'1; case H'1; auto.
+intros H0 H1 H2; case (not_even_and_odd m); auto.
+case H0; auto.
+intros H0; case H0; auto.
Qed.
-Hints Resolve even_even_plus odd_even_plus :arith.
+Hint Resolve even_even_plus odd_even_plus: arith.
-Lemma odd_plus_l : (n,m:nat) (odd n) -> (even m) -> (odd (plus n m)).
+Lemma odd_plus_l : forall n m, odd n -> even m -> odd (n + m).
Proof.
-Intros n m; Case (even_plus_aux n m).
-Intros H; Case H; Auto.
+intros n m; case (even_plus_aux n m).
+intros H; case H; auto.
Qed.
-Lemma odd_plus_r : (n,m:nat) (even n) -> (odd m) -> (odd (plus n m)).
+Lemma odd_plus_r : forall n m, even n -> odd m -> odd (n + m).
Proof.
-Intros n m; Case (even_plus_aux n m).
-Intros H; Case H; Auto.
+intros n m; case (even_plus_aux n m).
+intros H; case H; auto.
Qed.
-Lemma odd_plus_even_inv_l : (n,m:nat) (odd (plus n m)) -> (odd m) -> (even n).
+Lemma odd_plus_even_inv_l : forall n m, odd (n + m) -> odd m -> even n.
Proof.
-Intros n m H; Case (even_plus_aux n m).
-Intros H' H'0; Elim H'.
-Intros H'1; Case H'1; Auto.
-Intros H0 H1 H2; Case (not_even_and_odd m); Auto.
-Case H0; Auto.
-Intros H0; Case H0; Auto.
+intros n m H; case (even_plus_aux n m).
+intros H' H'0; elim H'.
+intros H'1; case H'1; auto.
+intros H0 H1 H2; case (not_even_and_odd m); auto.
+case H0; auto.
+intros H0; case H0; auto.
Qed.
-Lemma odd_plus_even_inv_r : (n,m:nat) (odd (plus n m)) -> (odd n) -> (even m).
+Lemma odd_plus_even_inv_r : forall n m, odd (n + m) -> odd n -> even m.
Proof.
-Intros n m H; Case (even_plus_aux n m).
-Intros H' H'0; Elim H'.
-Intros H'1; Case H'1; Auto.
-Intros H0; Case H0; Auto.
-Intros H0 H1 H2; Case (not_even_and_odd n); Auto.
-Case H0; Auto.
+intros n m H; case (even_plus_aux n m).
+intros H' H'0; elim H'.
+intros H'1; case H'1; auto.
+intros H0; case H0; auto.
+intros H0 H1 H2; case (not_even_and_odd n); auto.
+case H0; auto.
Qed.
-Lemma odd_plus_odd_inv_l : (n,m:nat) (odd (plus n m)) -> (even m) -> (odd n).
+Lemma odd_plus_odd_inv_l : forall n m, odd (n + m) -> even m -> odd n.
Proof.
-Intros n m H; Case (even_plus_aux n m).
-Intros H' H'0; Elim H'.
-Intros H'1; Case H'1; Auto.
-Intros H0; Case H0; Auto.
-Intros H0 H1 H2; Case (not_even_and_odd m); Auto.
-Case H0; Auto.
+intros n m H; case (even_plus_aux n m).
+intros H' H'0; elim H'.
+intros H'1; case H'1; auto.
+intros H0; case H0; auto.
+intros H0 H1 H2; case (not_even_and_odd m); auto.
+case H0; auto.
Qed.
-Lemma odd_plus_odd_inv_r : (n,m:nat) (odd (plus n m)) -> (even n) -> (odd m).
+Lemma odd_plus_odd_inv_r : forall n m, odd (n + m) -> even n -> odd m.
Proof.
-Intros n m H; Case (even_plus_aux n m).
-Intros H' H'0; Elim H'.
-Intros H'1; Case H'1; Auto.
-Intros H0 H1 H2; Case (not_even_and_odd n); Auto.
-Case H0; Auto.
-Intros H0; Case H0; Auto.
+intros n m H; case (even_plus_aux n m).
+intros H' H'0; elim H'.
+intros H'1; case H'1; auto.
+intros H0 H1 H2; case (not_even_and_odd n); auto.
+case H0; auto.
+intros H0; case H0; auto.
Qed.
-Hints Resolve odd_plus_l odd_plus_r :arith.
+Hint Resolve odd_plus_l odd_plus_r: arith.
Lemma even_mult_aux :
- (n,m:nat)
- (iff (odd (mult n m)) (odd n) /\ (odd m)) /\
- (iff (even (mult n m)) (even n) \/ (even m)).
+ forall n m,
+ (odd (n * m) <-> odd n /\ odd m) /\ (even (n * m) <-> even n \/ even m).
Proof.
-Intros n; Elim n; Simpl; Auto with arith.
-Intros m; Split; Split; Auto with arith.
-Intros H'; Inversion H'.
-Intros H'; Elim H'; Auto.
-Intros n0 H' m; Split; Split; Auto with arith.
-Intros H'0.
-Elim (even_plus_aux m (mult n0 m)); Intros H'3 H'4; Case H'3; Intros H'1 H'2;
- Case H'1; Auto.
-Intros H'5; Elim H'5; Intros H'6 H'7; Auto with arith.
-Split; Auto with arith.
-Case (H' m).
-Intros H'8 H'9; Case H'9.
-Intros H'10; Case H'10; Auto with arith.
-Intros H'11 H'12; Case (not_even_and_odd m); Auto with arith.
-Intros H'5; Elim H'5; Intros H'6 H'7; Case (not_even_and_odd (mult n0 m)); Auto.
-Case (H' m).
-Intros H'8 H'9; Case H'9; Auto.
-Intros H'0; Elim H'0; Intros H'1 H'2; Clear H'0.
-Elim (even_plus_aux m (mult n0 m)); Auto.
-Intros H'0 H'3.
-Elim H'0.
-Intros H'4 H'5; Apply H'5; Auto.
-Left; Split; Auto with arith.
-Case (H' m).
-Intros H'6 H'7; Elim H'7.
-Intros H'8 H'9; Apply H'9.
-Left.
-Inversion H'1; Auto.
-Intros H'0.
-Elim (even_plus_aux m (mult n0 m)); Intros H'3 H'4; Case H'4.
-Intros H'1 H'2.
-Elim H'1; Auto.
-Intros H; Case H; Auto.
-Intros H'5; Elim H'5; Intros H'6 H'7; Auto with arith.
-Left.
-Case (H' m).
-Intros H'8; Elim H'8.
-Intros H'9; Elim H'9; Auto with arith.
-Intros H'0; Elim H'0; Intros H'1.
-Case (even_or_odd m); Intros H'2.
-Apply even_even_plus; Auto.
-Case (H' m).
-Intros H H0; Case H0; Auto.
-Apply odd_even_plus; Auto.
-Inversion H'1; Case (H' m); Auto.
-Intros H1; Case H1; Auto.
-Apply even_even_plus; Auto.
-Case (H' m).
-Intros H H0; Case H0; Auto.
+intros n; elim n; simpl in |- *; auto with arith.
+intros m; split; split; auto with arith.
+intros H'; inversion H'.
+intros H'; elim H'; auto.
+intros n0 H' m; split; split; auto with arith.
+intros H'0.
+elim (even_plus_aux m (n0 * m)); intros H'3 H'4; case H'3; intros H'1 H'2;
+ case H'1; auto.
+intros H'5; elim H'5; intros H'6 H'7; auto with arith.
+split; auto with arith.
+case (H' m).
+intros H'8 H'9; case H'9.
+intros H'10; case H'10; auto with arith.
+intros H'11 H'12; case (not_even_and_odd m); auto with arith.
+intros H'5; elim H'5; intros H'6 H'7; case (not_even_and_odd (n0 * m)); auto.
+case (H' m).
+intros H'8 H'9; case H'9; auto.
+intros H'0; elim H'0; intros H'1 H'2; clear H'0.
+elim (even_plus_aux m (n0 * m)); auto.
+intros H'0 H'3.
+elim H'0.
+intros H'4 H'5; apply H'5; auto.
+left; split; auto with arith.
+case (H' m).
+intros H'6 H'7; elim H'7.
+intros H'8 H'9; apply H'9.
+left.
+inversion H'1; auto.
+intros H'0.
+elim (even_plus_aux m (n0 * m)); intros H'3 H'4; case H'4.
+intros H'1 H'2.
+elim H'1; auto.
+intros H; case H; auto.
+intros H'5; elim H'5; intros H'6 H'7; auto with arith.
+left.
+case (H' m).
+intros H'8; elim H'8.
+intros H'9; elim H'9; auto with arith.
+intros H'0; elim H'0; intros H'1.
+case (even_or_odd m); intros H'2.
+apply even_even_plus; auto.
+case (H' m).
+intros H H0; case H0; auto.
+apply odd_even_plus; auto.
+inversion H'1; case (H' m); auto.
+intros H1; case H1; auto.
+apply even_even_plus; auto.
+case (H' m).
+intros H H0; case H0; auto.
Qed.
-Lemma even_mult_l : (n,m:nat) (even n) -> (even (mult n m)).
+Lemma even_mult_l : forall n m, even n -> even (n * m).
Proof.
-Intros n m; Case (even_mult_aux n m); Auto.
-Intros H H0; Case H0; Auto.
+intros n m; case (even_mult_aux n m); auto.
+intros H H0; case H0; auto.
Qed.
-Lemma even_mult_r: (n,m:nat) (even m) -> (even (mult n m)).
+Lemma even_mult_r : forall n m, even m -> even (n * m).
Proof.
-Intros n m; Case (even_mult_aux n m); Auto.
-Intros H H0; Case H0; Auto.
+intros n m; case (even_mult_aux n m); auto.
+intros H H0; case H0; auto.
Qed.
-Hints Resolve even_mult_l even_mult_r :arith.
+Hint Resolve even_mult_l even_mult_r: arith.
-Lemma even_mult_inv_r: (n,m:nat) (even (mult n m)) -> (odd n) -> (even m).
+Lemma even_mult_inv_r : forall n m, even (n * m) -> odd n -> even m.
Proof.
-Intros n m H' H'0.
-Case (even_mult_aux n m).
-Intros H'1 H'2; Elim H'2.
-Intros H'3; Elim H'3; Auto.
-Intros H; Case (not_even_and_odd n); Auto.
+intros n m H' H'0.
+case (even_mult_aux n m).
+intros H'1 H'2; elim H'2.
+intros H'3; elim H'3; auto.
+intros H; case (not_even_and_odd n); auto.
Qed.
-Lemma even_mult_inv_l : (n,m:nat) (even (mult n m)) -> (odd m) -> (even n).
+Lemma even_mult_inv_l : forall n m, even (n * m) -> odd m -> even n.
Proof.
-Intros n m H' H'0.
-Case (even_mult_aux n m).
-Intros H'1 H'2; Elim H'2.
-Intros H'3; Elim H'3; Auto.
-Intros H; Case (not_even_and_odd m); Auto.
+intros n m H' H'0.
+case (even_mult_aux n m).
+intros H'1 H'2; elim H'2.
+intros H'3; elim H'3; auto.
+intros H; case (not_even_and_odd m); auto.
Qed.
-Lemma odd_mult : (n,m:nat) (odd n) -> (odd m) -> (odd (mult n m)).
+Lemma odd_mult : forall n m, odd n -> odd m -> odd (n * m).
Proof.
-Intros n m; Case (even_mult_aux n m); Intros H; Case H; Auto.
+intros n m; case (even_mult_aux n m); intros H; case H; auto.
Qed.
-Hints Resolve even_mult_l even_mult_r odd_mult :arith.
+Hint Resolve even_mult_l even_mult_r odd_mult: arith.
-Lemma odd_mult_inv_l : (n,m:nat) (odd (mult n m)) -> (odd n).
+Lemma odd_mult_inv_l : forall n m, odd (n * m) -> odd n.
Proof.
-Intros n m H'.
-Case (even_mult_aux n m).
-Intros H'1 H'2; Elim H'1.
-Intros H'3; Elim H'3; Auto.
+intros n m H'.
+case (even_mult_aux n m).
+intros H'1 H'2; elim H'1.
+intros H'3; elim H'3; auto.
Qed.
-Lemma odd_mult_inv_r : (n,m:nat) (odd (mult n m)) -> (odd m).
+Lemma odd_mult_inv_r : forall n m, odd (n * m) -> odd m.
Proof.
-Intros n m H'.
-Case (even_mult_aux n m).
-Intros H'1 H'2; Elim H'1.
-Intros H'3; Elim H'3; Auto.
+intros n m H'.
+case (even_mult_aux n m).
+intros H'1 H'2; elim H'1.
+intros H'3; elim H'3; auto.
Qed.
-
diff --git a/theories/Arith/Factorial.v b/theories/Arith/Factorial.v
index 1d1ee00af..69b55e009 100644
--- a/theories/Arith/Factorial.v
+++ b/theories/Arith/Factorial.v
@@ -8,44 +8,43 @@
(*i $Id$ i*)
-Require Plus.
-Require Mult.
-Require Lt.
-V7only [Import nat_scope.].
+Require Import Plus.
+Require Import Mult.
+Require Import Lt.
Open Local Scope nat_scope.
(** Factorial *)
-Fixpoint fact [n:nat]:nat:=
- Cases n of
- O => (S O)
- |(S n) => (mult (S n) (fact n))
+Fixpoint fact (n:nat) : nat :=
+ match n with
+ | O => 1
+ | S n => S n * fact n
end.
-Arguments Scope fact [ nat_scope ].
+Arguments Scope fact [nat_scope].
-Lemma lt_O_fact : (n:nat)(lt O (fact n)).
+Lemma lt_O_fact : forall n:nat, 0 < fact n.
Proof.
-Induction n; Unfold lt; Simpl; Auto with arith.
+simple induction n; unfold lt in |- *; simpl in |- *; auto with arith.
Qed.
-Lemma fact_neq_0:(n:nat)~(fact n)=O.
+Lemma fact_neq_0 : forall n:nat, fact n <> 0.
Proof.
-Intro.
-Apply sym_not_eq.
-Apply lt_O_neq.
-Apply lt_O_fact.
+intro.
+apply sym_not_eq.
+apply lt_O_neq.
+apply lt_O_fact.
Qed.
-Lemma fact_growing : (n,m:nat) (le n m) -> (le (fact n) (fact m)).
+Lemma fact_le : forall n m:nat, n <= m -> fact n <= fact m.
Proof.
-NewInduction 1.
-Apply le_n.
-Assert (le (mult (S O) (fact n)) (mult (S m) (fact m))).
-Apply le_mult_mult.
-Apply lt_le_S; Apply lt_O_Sn.
-Assumption.
-Simpl (mult (S O) (fact n)) in H0.
-Rewrite <- plus_n_O in H0.
-Assumption.
-Qed.
+induction 1.
+apply le_n.
+assert (1 * fact n <= S m * fact m).
+apply mult_le_compat.
+apply lt_le_S; apply lt_O_Sn.
+assumption.
+simpl (1 * fact n) in H0.
+rewrite <- plus_n_O in H0.
+assumption.
+Qed. \ No newline at end of file
diff --git a/theories/Arith/Gt.v b/theories/Arith/Gt.v
index ce4661df6..c0afdb0ae 100755
--- a/theories/Arith/Gt.v
+++ b/theories/Arith/Gt.v
@@ -8,142 +8,141 @@
(*i $Id$ i*)
-Require Le.
-Require Lt.
-Require Plus.
-V7only [Import nat_scope.].
+Require Import Le.
+Require Import Lt.
+Require Import Plus.
Open Local Scope nat_scope.
-Implicit Variables Type m,n,p:nat.
+Implicit Types m n p : nat.
(** Order and successor *)
-Theorem gt_Sn_O : (n:nat)(gt (S n) O).
+Theorem gt_Sn_O : forall n, S n > 0.
Proof.
- Auto with arith.
+ auto with arith.
Qed.
-Hints Resolve gt_Sn_O : arith v62.
+Hint Resolve gt_Sn_O: arith v62.
-Theorem gt_Sn_n : (n:nat)(gt (S n) n).
+Theorem gt_Sn_n : forall n, S n > n.
Proof.
- Auto with arith.
+ auto with arith.
Qed.
-Hints Resolve gt_Sn_n : arith v62.
+Hint Resolve gt_Sn_n: arith v62.
-Theorem gt_n_S : (n,m:nat)(gt n m)->(gt (S n) (S m)).
+Theorem gt_n_S : forall n m, n > m -> S n > S m.
Proof.
- Auto with arith.
+ auto with arith.
Qed.
-Hints Resolve gt_n_S : arith v62.
+Hint Resolve gt_n_S: arith v62.
-Lemma gt_S_n : (n,p:nat)(gt (S p) (S n))->(gt p n).
+Lemma gt_S_n : forall n m, S m > S n -> m > n.
Proof.
- Auto with arith.
+ auto with arith.
Qed.
-Hints Immediate gt_S_n : arith v62.
+Hint Immediate gt_S_n: arith v62.
-Theorem gt_S : (n,m:nat)(gt (S n) m)->((gt n m)\/(m=n)).
+Theorem gt_S : forall n m, S n > m -> n > m \/ m = n.
Proof.
- Intros n m H; Unfold gt; Apply le_lt_or_eq; Auto with arith.
+ intros n m H; unfold gt in |- *; apply le_lt_or_eq; auto with arith.
Qed.
-Lemma gt_pred : (n,p:nat)(gt p (S n))->(gt (pred p) n).
+Lemma gt_pred : forall n m, m > S n -> pred m > n.
Proof.
- Auto with arith.
+ auto with arith.
Qed.
-Hints Immediate gt_pred : arith v62.
+Hint Immediate gt_pred: arith v62.
(** Irreflexivity *)
-Lemma gt_antirefl : (n:nat)~(gt n n).
-Proof lt_n_n.
-Hints Resolve gt_antirefl : arith v62.
+Lemma gt_irrefl : forall n, ~ n > n.
+Proof lt_irrefl.
+Hint Resolve gt_irrefl: arith v62.
(** Asymmetry *)
-Lemma gt_not_sym : (n,m:nat)(gt n m) -> ~(gt m n).
-Proof [n,m:nat](lt_not_sym m n).
+Lemma gt_asym : forall n m, n > m -> ~ m > n.
+Proof fun n m => lt_asym m n.
-Hints Resolve gt_not_sym : arith v62.
+Hint Resolve gt_asym: arith v62.
(** Relating strict and large orders *)
-Lemma le_not_gt : (n,m:nat)(le n m) -> ~(gt n m).
+Lemma le_not_gt : forall n m, n <= m -> ~ n > m.
Proof le_not_lt.
-Hints Resolve le_not_gt : arith v62.
+Hint Resolve le_not_gt: arith v62.
-Lemma gt_not_le : (n,m:nat)(gt n m) -> ~(le n m).
+Lemma gt_not_le : forall n m, n > m -> ~ n <= m.
Proof.
-Auto with arith.
+auto with arith.
Qed.
-Hints Resolve gt_not_le : arith v62.
+Hint Resolve gt_not_le: arith v62.
-Theorem le_S_gt : (n,m:nat)(le (S n) m)->(gt m n).
+Theorem le_S_gt : forall n m, S n <= m -> m > n.
Proof.
- Auto with arith.
+ auto with arith.
Qed.
-Hints Immediate le_S_gt : arith v62.
+Hint Immediate le_S_gt: arith v62.
-Lemma gt_S_le : (n,p:nat)(gt (S p) n)->(le n p).
+Lemma gt_S_le : forall n m, S m > n -> n <= m.
Proof.
- Intros n p; Exact (lt_n_Sm_le n p).
+ intros n p; exact (lt_n_Sm_le n p).
Qed.
-Hints Immediate gt_S_le : arith v62.
+Hint Immediate gt_S_le: arith v62.
-Lemma gt_le_S : (n,p:nat)(gt p n)->(le (S n) p).
+Lemma gt_le_S : forall n m, m > n -> S n <= m.
Proof.
- Auto with arith.
+ auto with arith.
Qed.
-Hints Resolve gt_le_S : arith v62.
+Hint Resolve gt_le_S: arith v62.
-Lemma le_gt_S : (n,p:nat)(le n p)->(gt (S p) n).
+Lemma le_gt_S : forall n m, n <= m -> S m > n.
Proof.
- Auto with arith.
+ auto with arith.
Qed.
-Hints Resolve le_gt_S : arith v62.
+Hint Resolve le_gt_S: arith v62.
(** Transitivity *)
-Theorem le_gt_trans : (n,m,p:nat)(le m n)->(gt m p)->(gt n p).
+Theorem le_gt_trans : forall n m p, m <= n -> m > p -> n > p.
Proof.
- Red; Intros; Apply lt_le_trans with m; Auto with arith.
+ red in |- *; intros; apply lt_le_trans with m; auto with arith.
Qed.
-Theorem gt_le_trans : (n,m,p:nat)(gt n m)->(le p m)->(gt n p).
+Theorem gt_le_trans : forall n m p, n > m -> p <= m -> n > p.
Proof.
- Red; Intros; Apply le_lt_trans with m; Auto with arith.
+ red in |- *; intros; apply le_lt_trans with m; auto with arith.
Qed.
-Lemma gt_trans : (n,m,p:nat)(gt n m)->(gt m p)->(gt n p).
+Lemma gt_trans : forall n m p, n > m -> m > p -> n > p.
Proof.
- Red; Intros n m p H1 H2.
- Apply lt_trans with m; Auto with arith.
+ red in |- *; intros n m p H1 H2.
+ apply lt_trans with m; auto with arith.
Qed.
-Theorem gt_trans_S : (n,m,p:nat)(gt (S n) m)->(gt m p)->(gt n p).
+Theorem gt_trans_S : forall n m p, S n > m -> m > p -> n > p.
Proof.
- Red; Intros; Apply lt_le_trans with m; Auto with arith.
+ red in |- *; intros; apply lt_le_trans with m; auto with arith.
Qed.
-Hints Resolve gt_trans_S le_gt_trans gt_le_trans : arith v62.
+Hint Resolve gt_trans_S le_gt_trans gt_le_trans: arith v62.
(** Comparison to 0 *)
-Theorem gt_O_eq : (n:nat)((gt n O)\/(O=n)).
+Theorem gt_O_eq : forall n, n > 0 \/ 0 = n.
Proof.
- Intro n ; Apply gt_S ; Auto with arith.
+ intro n; apply gt_S; auto with arith.
Qed.
(** Simplification and compatibility *)
-Lemma simpl_gt_plus_l : (n,m,p:nat)(gt (plus p n) (plus p m))->(gt n m).
+Lemma plus_gt_reg_l : forall n m p, p + n > p + m -> n > m.
Proof.
- Red; Intros n m p H; Apply simpl_lt_plus_l with p; Auto with arith.
+ red in |- *; intros n m p H; apply plus_lt_reg_l with p; auto with arith.
Qed.
-Lemma gt_reg_l : (n,m,p:nat)(gt n m)->(gt (plus p n) (plus p m)).
+Lemma plus_gt_compat_l : forall n m p, n > m -> p + n > p + m.
Proof.
- Auto with arith.
+ auto with arith.
Qed.
-Hints Resolve gt_reg_l : arith v62.
+Hint Resolve plus_gt_compat_l: arith v62. \ No newline at end of file
diff --git a/theories/Arith/Le.v b/theories/Arith/Le.v
index c80689836..d31104665 100755
--- a/theories/Arith/Le.v
+++ b/theories/Arith/Le.v
@@ -9,114 +9,114 @@
(*i $Id$ i*)
(** Order on natural numbers *)
-V7only [Import nat_scope.].
Open Local Scope nat_scope.
-Implicit Variables Type m,n,p:nat.
+Implicit Types m n p : nat.
(** Reflexivity *)
-Theorem le_refl : (n:nat)(le n n).
+Theorem le_refl : forall n, n <= n.
Proof.
-Exact le_n.
+exact le_n.
Qed.
(** Transitivity *)
-Theorem le_trans : (n,m,p:nat)(le n m)->(le m p)->(le n p).
+Theorem le_trans : forall n m p, n <= m -> m <= p -> n <= p.
Proof.
- NewInduction 2; Auto.
+ induction 2; auto.
Qed.
-Hints Resolve le_trans : arith v62.
+Hint Resolve le_trans: arith v62.
(** Order, successor and predecessor *)
-Theorem le_n_S : (n,m:nat)(le n m)->(le (S n) (S m)).
+Theorem le_n_S : forall n m, n <= m -> S n <= S m.
Proof.
- NewInduction 1; Auto.
+ induction 1; auto.
Qed.
-Theorem le_n_Sn : (n:nat)(le n (S n)).
+Theorem le_n_Sn : forall n, n <= S n.
Proof.
- Auto.
+ auto.
Qed.
-Theorem le_O_n : (n:nat)(le O n).
+Theorem le_O_n : forall n, 0 <= n.
Proof.
- NewInduction n ; Auto.
+ induction n; auto.
Qed.
-Hints Resolve le_n_S le_n_Sn le_O_n le_n_S : arith v62.
+Hint Resolve le_n_S le_n_Sn le_O_n le_n_S: arith v62.
-Theorem le_pred_n : (n:nat)(le (pred n) n).
+Theorem le_pred_n : forall n, pred n <= n.
Proof.
-NewInduction n ; Auto with arith.
+induction n; auto with arith.
Qed.
-Hints Resolve le_pred_n : arith v62.
+Hint Resolve le_pred_n: arith v62.
-Theorem le_trans_S : (n,m:nat)(le (S n) m)->(le n m).
+Theorem le_Sn_le : forall n m, S n <= m -> n <= m.
Proof.
-Intros n m H ; Apply le_trans with (S n); Auto with arith.
+intros n m H; apply le_trans with (S n); auto with arith.
Qed.
-Hints Immediate le_trans_S : arith v62.
+Hint Immediate le_Sn_le: arith v62.
-Theorem le_S_n : (n,m:nat)(le (S n) (S m))->(le n m).
+Theorem le_S_n : forall n m, S n <= S m -> n <= m.
Proof.
-Intros n m H ; Change (le (pred (S n)) (pred (S m))).
-Elim H ; Simpl ; Auto with arith.
+intros n m H; change (pred (S n) <= pred (S m)) in |- *.
+elim H; simpl in |- *; auto with arith.
Qed.
-Hints Immediate le_S_n : arith v62.
+Hint Immediate le_S_n: arith v62.
-Theorem le_pred : (n,m:nat)(le n m)->(le (pred n) (pred m)).
+Theorem le_pred : forall n m, n <= m -> pred n <= pred m.
Proof.
-NewInduction n as [|n IHn]. Simpl. Auto with arith.
-NewDestruct m as [|m]. Simpl. Intro H. Inversion H.
-Simpl. Auto with arith.
+induction n as [| n IHn]. simpl in |- *. auto with arith.
+destruct m as [| m]. simpl in |- *. intro H. inversion H.
+simpl in |- *. auto with arith.
Qed.
(** Comparison to 0 *)
-Theorem le_Sn_O : (n:nat)~(le (S n) O).
+Theorem le_Sn_O : forall n, ~ S n <= 0.
Proof.
-Red ; Intros n H.
-Change (IsSucc O) ; Elim H ; Simpl ; Auto with arith.
+red in |- *; intros n H.
+change (IsSucc 0) in |- *; elim H; simpl in |- *; auto with arith.
Qed.
-Hints Resolve le_Sn_O : arith v62.
+Hint Resolve le_Sn_O: arith v62.
-Theorem le_n_O_eq : (n:nat)(le n O)->(O=n).
+Theorem le_n_O_eq : forall n, n <= 0 -> 0 = n.
Proof.
-NewInduction n; Auto with arith.
-Intro; Contradiction le_Sn_O with n.
+induction n; auto with arith.
+intro; contradiction le_Sn_O with n.
Qed.
-Hints Immediate le_n_O_eq : arith v62.
+Hint Immediate le_n_O_eq: arith v62.
(** Negative properties *)
-Theorem le_Sn_n : (n:nat)~(le (S n) n).
+Theorem le_Sn_n : forall n, ~ S n <= n.
Proof.
-NewInduction n; Auto with arith.
+induction n; auto with arith.
Qed.
-Hints Resolve le_Sn_n : arith v62.
+Hint Resolve le_Sn_n: arith v62.
(** Antisymmetry *)
-Theorem le_antisym : (n,m:nat)(le n m)->(le m n)->(n=m).
+Theorem le_antisym : forall n m, n <= m -> m <= n -> n = m.
Proof.
-Intros n m h ; NewDestruct h as [|m0]; Auto with arith.
-Intros H1.
-Absurd (le (S m0) m0) ; Auto with arith.
-Apply le_trans with n ; Auto with arith.
+intros n m h; destruct h as [| m0 H]; auto with arith.
+intros H1.
+absurd (S m0 <= m0); auto with arith.
+apply le_trans with n; auto with arith.
Qed.
-Hints Immediate le_antisym : arith v62.
+Hint Immediate le_antisym: arith v62.
(** A different elimination principle for the order on natural numbers *)
-Lemma le_elim_rel : (P:nat->nat->Prop)
- ((p:nat)(P O p))->
- ((p,q:nat)(le p q)->(P p q)->(P (S p) (S q)))->
- (n,m:nat)(le n m)->(P n m).
+Lemma le_elim_rel :
+ forall P:nat -> nat -> Prop,
+ (forall p, P 0 p) ->
+ (forall p (q:nat), p <= q -> P p q -> P (S p) (S q)) ->
+ forall n m, n <= m -> P n m.
Proof.
-NewInduction n; Auto with arith.
-Intros m Le.
-Elim Le; Auto with arith.
-Qed.
+induction n; auto with arith.
+intros m Le.
+elim Le; auto with arith.
+Qed. \ No newline at end of file
diff --git a/theories/Arith/Lt.v b/theories/Arith/Lt.v
index 8c80e64c2..425087ea5 100755
--- a/theories/Arith/Lt.v
+++ b/theories/Arith/Lt.v
@@ -8,169 +8,168 @@
(*i $Id$ i*)
-Require Le.
-V7only [Import nat_scope.].
+Require Import Le.
Open Local Scope nat_scope.
-Implicit Variables Type m,n,p:nat.
+Implicit Types m n p : nat.
(** Irreflexivity *)
-Theorem lt_n_n : (n:nat)~(lt n n).
+Theorem lt_irrefl : forall n, ~ n < n.
Proof le_Sn_n.
-Hints Resolve lt_n_n : arith v62.
+Hint Resolve lt_irrefl: arith v62.
(** Relationship between [le] and [lt] *)
-Theorem lt_le_S : (n,p:nat)(lt n p)->(le (S n) p).
+Theorem lt_le_S : forall n m, n < m -> S n <= m.
Proof.
-Auto with arith.
+auto with arith.
Qed.
-Hints Immediate lt_le_S : arith v62.
+Hint Immediate lt_le_S: arith v62.
-Theorem lt_n_Sm_le : (n,m:nat)(lt n (S m))->(le n m).
+Theorem lt_n_Sm_le : forall n m, n < S m -> n <= m.
Proof.
-Auto with arith.
+auto with arith.
Qed.
-Hints Immediate lt_n_Sm_le : arith v62.
+Hint Immediate lt_n_Sm_le: arith v62.
-Theorem le_lt_n_Sm : (n,m:nat)(le n m)->(lt n (S m)).
+Theorem le_lt_n_Sm : forall n m, n <= m -> n < S m.
Proof.
-Auto with arith.
+auto with arith.
Qed.
-Hints Immediate le_lt_n_Sm : arith v62.
+Hint Immediate le_lt_n_Sm: arith v62.
-Theorem le_not_lt : (n,m:nat)(le n m) -> ~(lt m n).
+Theorem le_not_lt : forall n m, n <= m -> ~ m < n.
Proof.
-NewInduction 1; Auto with arith.
+induction 1; auto with arith.
Qed.
-Theorem lt_not_le : (n,m:nat)(lt n m) -> ~(le m n).
+Theorem lt_not_le : forall n m, n < m -> ~ m <= n.
Proof.
-Red; Intros n m Lt Le; Exact (le_not_lt m n Le Lt).
+red in |- *; intros n m Lt Le; exact (le_not_lt m n Le Lt).
Qed.
-Hints Immediate le_not_lt lt_not_le : arith v62.
+Hint Immediate le_not_lt lt_not_le: arith v62.
(** Asymmetry *)
-Theorem lt_not_sym : (n,m:nat)(lt n m) -> ~(lt m n).
+Theorem lt_asym : forall n m, n < m -> ~ m < n.
Proof.
-NewInduction 1; Auto with arith.
+induction 1; auto with arith.
Qed.
(** Order and successor *)
-Theorem lt_n_Sn : (n:nat)(lt n (S n)).
+Theorem lt_n_Sn : forall n, n < S n.
Proof.
-Auto with arith.
+auto with arith.
Qed.
-Hints Resolve lt_n_Sn : arith v62.
+Hint Resolve lt_n_Sn: arith v62.
-Theorem lt_S : (n,m:nat)(lt n m)->(lt n (S m)).
+Theorem lt_S : forall n m, n < m -> n < S m.
Proof.
-Auto with arith.
+auto with arith.
Qed.
-Hints Resolve lt_S : arith v62.
+Hint Resolve lt_S: arith v62.
-Theorem lt_n_S : (n,m:nat)(lt n m)->(lt (S n) (S m)).
+Theorem lt_n_S : forall n m, n < m -> S n < S m.
Proof.
-Auto with arith.
+auto with arith.
Qed.
-Hints Resolve lt_n_S : arith v62.
+Hint Resolve lt_n_S: arith v62.
-Theorem lt_S_n : (n,m:nat)(lt (S n) (S m))->(lt n m).
+Theorem lt_S_n : forall n m, S n < S m -> n < m.
Proof.
-Auto with arith.
+auto with arith.
Qed.
-Hints Immediate lt_S_n : arith v62.
+Hint Immediate lt_S_n: arith v62.
-Theorem lt_O_Sn : (n:nat)(lt O (S n)).
+Theorem lt_O_Sn : forall n, 0 < S n.
Proof.
-Auto with arith.
+auto with arith.
Qed.
-Hints Resolve lt_O_Sn : arith v62.
+Hint Resolve lt_O_Sn: arith v62.
-Theorem lt_n_O : (n:nat)~(lt n O).
+Theorem lt_n_O : forall n, ~ n < 0.
Proof le_Sn_O.
-Hints Resolve lt_n_O : arith v62.
+Hint Resolve lt_n_O: arith v62.
(** Predecessor *)
-Lemma S_pred : (n,m:nat)(lt m n)->n=(S (pred n)).
+Lemma S_pred : forall n m, m < n -> n = S (pred n).
Proof.
-NewInduction 1; Auto with arith.
+induction 1; auto with arith.
Qed.
-Lemma lt_pred : (n,p:nat)(lt (S n) p)->(lt n (pred p)).
+Lemma lt_pred : forall n m, S n < m -> n < pred m.
Proof.
-NewInduction 1; Simpl; Auto with arith.
+induction 1; simpl in |- *; auto with arith.
Qed.
-Hints Immediate lt_pred : arith v62.
+Hint Immediate lt_pred: arith v62.
-Lemma lt_pred_n_n : (n:nat)(lt O n)->(lt (pred n) n).
-NewDestruct 1; Simpl; Auto with arith.
+Lemma lt_pred_n_n : forall n, 0 < n -> pred n < n.
+destruct 1; simpl in |- *; auto with arith.
Qed.
-Hints Resolve lt_pred_n_n : arith v62.
+Hint Resolve lt_pred_n_n: arith v62.
(** Transitivity properties *)
-Theorem lt_trans : (n,m,p:nat)(lt n m)->(lt m p)->(lt n p).
+Theorem lt_trans : forall n m p, n < m -> m < p -> n < p.
Proof.
-NewInduction 2; Auto with arith.
+induction 2; auto with arith.
Qed.
-Theorem lt_le_trans : (n,m,p:nat)(lt n m)->(le m p)->(lt n p).
+Theorem lt_le_trans : forall n m p, n < m -> m <= p -> n < p.
Proof.
-NewInduction 2; Auto with arith.
+induction 2; auto with arith.
Qed.
-Theorem le_lt_trans : (n,m,p:nat)(le n m)->(lt m p)->(lt n p).
+Theorem le_lt_trans : forall n m p, n <= m -> m < p -> n < p.
Proof.
-NewInduction 2; Auto with arith.
+induction 2; auto with arith.
Qed.
-Hints Resolve lt_trans lt_le_trans le_lt_trans : arith v62.
+Hint Resolve lt_trans lt_le_trans le_lt_trans: arith v62.
(** Large = strict or equal *)
-Theorem le_lt_or_eq : (n,m:nat)(le n m)->((lt n m) \/ n=m).
+Theorem le_lt_or_eq : forall n m, n <= m -> n < m \/ n = m.
Proof.
-NewInduction 1; Auto with arith.
+induction 1; auto with arith.
Qed.
-Theorem lt_le_weak : (n,m:nat)(lt n m)->(le n m).
+Theorem lt_le_weak : forall n m, n < m -> n <= m.
Proof.
-Auto with arith.
+auto with arith.
Qed.
-Hints Immediate lt_le_weak : arith v62.
+Hint Immediate lt_le_weak: arith v62.
(** Dichotomy *)
-Theorem le_or_lt : (n,m:nat)((le n m)\/(lt m n)).
+Theorem le_or_lt : forall n m, n <= m \/ m < n.
Proof.
-Intros n m; Pattern n m; Apply nat_double_ind; Auto with arith.
-NewInduction 1; Auto with arith.
+intros n m; pattern n, m in |- *; apply nat_double_ind; auto with arith.
+induction 1; auto with arith.
Qed.
-Theorem nat_total_order: (m,n: nat) ~ m = n -> (lt m n) \/ (lt n m).
+Theorem nat_total_order : forall n m, n <> m -> n < m \/ m < n.
Proof.
-Intros m n diff.
-Elim (le_or_lt n m); [Intro H'0 | Auto with arith].
-Elim (le_lt_or_eq n m); Auto with arith.
-Intro H'; Elim diff; Auto with arith.
+intros m n diff.
+elim (le_or_lt n m); [ intro H'0 | auto with arith ].
+elim (le_lt_or_eq n m); auto with arith.
+intro H'; elim diff; auto with arith.
Qed.
(** Comparison to 0 *)
-Theorem neq_O_lt : (n:nat)(~O=n)->(lt O n).
+Theorem neq_O_lt : forall n, 0 <> n -> 0 < n.
Proof.
-NewInduction n; Auto with arith.
-Intros; Absurd O=O; Trivial with arith.
+induction n; auto with arith.
+intros; absurd (0 = 0); trivial with arith.
Qed.
-Hints Immediate neq_O_lt : arith v62.
+Hint Immediate neq_O_lt: arith v62.
-Theorem lt_O_neq : (n:nat)(lt O n)->(~O=n).
+Theorem lt_O_neq : forall n, 0 < n -> 0 <> n.
Proof.
-NewInduction 1; Auto with arith.
+induction 1; auto with arith.
Qed.
-Hints Immediate lt_O_neq : arith v62.
+Hint Immediate lt_O_neq: arith v62. \ No newline at end of file
diff --git a/theories/Arith/Max.v b/theories/Arith/Max.v
index ac8ff97a1..c915c0690 100755
--- a/theories/Arith/Max.v
+++ b/theories/Arith/Max.v
@@ -8,80 +8,78 @@
(*i $Id$ i*)
-Require Arith.
+Require Import Arith.
-V7only [Import nat_scope.].
Open Local Scope nat_scope.
-Implicit Variables Type m,n:nat.
+Implicit Types m n : nat.
(** maximum of two natural numbers *)
-Fixpoint max [n:nat] : nat -> nat :=
-[m:nat]Cases n m of
- O _ => m
- | (S n') O => n
- | (S n') (S m') => (S (max n' m'))
- end.
+Fixpoint max n m {struct n} : nat :=
+ match n, m with
+ | O, _ => m
+ | S n', O => n
+ | S n', S m' => S (max n' m')
+ end.
(** Simplifications of [max] *)
-Lemma max_SS : (n,m:nat)((S (max n m))=(max (S n) (S m))).
+Lemma max_SS : forall n m, S (max n m) = max (S n) (S m).
Proof.
-Auto with arith.
+auto with arith.
Qed.
-Lemma max_sym : (n,m:nat)(max n m)=(max m n).
+Lemma max_comm : forall n m, max n m = max m n.
Proof.
-NewInduction n;NewInduction m;Simpl;Auto with arith.
+induction n; induction m; simpl in |- *; auto with arith.
Qed.
(** [max] and [le] *)
-Lemma max_l : (n,m:nat)(le m n)->(max n m)=n.
+Lemma max_l : forall n m, m <= n -> max n m = n.
Proof.
-NewInduction n;NewInduction m;Simpl;Auto with arith.
+induction n; induction m; simpl in |- *; auto with arith.
Qed.
-Lemma max_r : (n,m:nat)(le n m)->(max n m)=m.
+Lemma max_r : forall n m, n <= m -> max n m = m.
Proof.
-NewInduction n;NewInduction m;Simpl;Auto with arith.
+induction n; induction m; simpl in |- *; auto with arith.
Qed.
-Lemma le_max_l : (n,m:nat)(le n (max n m)).
+Lemma le_max_l : forall n m, n <= max n m.
Proof.
-NewInduction n; Intros; Simpl; Auto with arith.
-Elim m; Intros; Simpl; Auto with arith.
+induction n; intros; simpl in |- *; auto with arith.
+elim m; intros; simpl in |- *; auto with arith.
Qed.
-Lemma le_max_r : (n,m:nat)(le m (max n m)).
+Lemma le_max_r : forall n m, m <= max n m.
Proof.
-NewInduction n; Simpl; Auto with arith.
-NewInduction m; Simpl; Auto with arith.
+induction n; simpl in |- *; auto with arith.
+induction m; simpl in |- *; auto with arith.
Qed.
-Hints Resolve max_r max_l le_max_l le_max_r: arith v62.
+Hint Resolve max_r max_l le_max_l le_max_r: arith v62.
(** [max n m] is equal to [n] or [m] *)
-Lemma max_dec : (n,m:nat){(max n m)=n}+{(max n m)=m}.
+Lemma max_dec : forall n m, {max n m = n} + {max n m = m}.
Proof.
-NewInduction n;NewInduction m;Simpl;Auto with arith.
-Elim (IHn m);Intro H;Elim H;Auto.
+induction n; induction m; simpl in |- *; auto with arith.
+elim (IHn m); intro H; elim H; auto.
Qed.
-Lemma max_case : (n,m:nat)(P:nat->Set)(P n)->(P m)->(P (max n m)).
+Lemma max_case : forall n m (P:nat -> Set), P n -> P m -> P (max n m).
Proof.
-NewInduction n; Simpl; Auto with arith.
-NewInduction m; Intros; Simpl; Auto with arith.
-Pattern (max n m); Apply IHn ; Auto with arith.
+induction n; simpl in |- *; auto with arith.
+induction m; intros; simpl in |- *; auto with arith.
+pattern (max n m) in |- *; apply IHn; auto with arith.
Qed.
-Lemma max_case2 : (n,m:nat)(P:nat->Prop)(P n)->(P m)->(P (max n m)).
+Lemma max_case2 : forall n m (P:nat -> Prop), P n -> P m -> P (max n m).
Proof.
-NewInduction n; Simpl; Auto with arith.
-NewInduction m; Intros; Simpl; Auto with arith.
-Pattern (max n m); Apply IHn ; Auto with arith.
+induction n; simpl in |- *; auto with arith.
+induction m; intros; simpl in |- *; auto with arith.
+pattern (max n m) in |- *; apply IHn; auto with arith.
Qed.
-
diff --git a/theories/Arith/Min.v b/theories/Arith/Min.v
index 81559526b..18fba26a2 100755
--- a/theories/Arith/Min.v
+++ b/theories/Arith/Min.v
@@ -8,77 +8,76 @@
(*i $Id$ i*)
-Require Arith.
+Require Import Arith.
-V7only [Import nat_scope.].
Open Local Scope nat_scope.
-Implicit Variables Type m,n:nat.
+Implicit Types m n : nat.
(** minimum of two natural numbers *)
-Fixpoint min [n:nat] : nat -> nat :=
-[m:nat]Cases n m of
- O _ => O
- | (S n') O => O
- | (S n') (S m') => (S (min n' m'))
- end.
+Fixpoint min n m {struct n} : nat :=
+ match n, m with
+ | O, _ => 0
+ | S n', O => 0
+ | S n', S m' => S (min n' m')
+ end.
(** Simplifications of [min] *)
-Lemma min_SS : (n,m:nat)((S (min n m))=(min (S n) (S m))).
+Lemma min_SS : forall n m, S (min n m) = min (S n) (S m).
Proof.
-Auto with arith.
+auto with arith.
Qed.
-Lemma min_sym : (n,m:nat)(min n m)=(min m n).
+Lemma min_comm : forall n m, min n m = min m n.
Proof.
-NewInduction n;NewInduction m;Simpl;Auto with arith.
+induction n; induction m; simpl in |- *; auto with arith.
Qed.
(** [min] and [le] *)
-Lemma min_l : (n,m:nat)(le n m)->(min n m)=n.
+Lemma min_l : forall n m, n <= m -> min n m = n.
Proof.
-NewInduction n;NewInduction m;Simpl;Auto with arith.
+induction n; induction m; simpl in |- *; auto with arith.
Qed.
-Lemma min_r : (n,m:nat)(le m n)->(min n m)=m.
+Lemma min_r : forall n m, m <= n -> min n m = m.
Proof.
-NewInduction n;NewInduction m;Simpl;Auto with arith.
+induction n; induction m; simpl in |- *; auto with arith.
Qed.
-Lemma le_min_l : (n,m:nat)(le (min n m) n).
+Lemma le_min_l : forall n m, min n m <= n.
Proof.
-NewInduction n; Intros; Simpl; Auto with arith.
-Elim m; Intros; Simpl; Auto with arith.
+induction n; intros; simpl in |- *; auto with arith.
+elim m; intros; simpl in |- *; auto with arith.
Qed.
-Lemma le_min_r : (n,m:nat)(le (min n m) m).
+Lemma le_min_r : forall n m, min n m <= m.
Proof.
-NewInduction n; Simpl; Auto with arith.
-NewInduction m; Simpl; Auto with arith.
+induction n; simpl in |- *; auto with arith.
+induction m; simpl in |- *; auto with arith.
Qed.
-Hints Resolve min_l min_r le_min_l le_min_r : arith v62.
+Hint Resolve min_l min_r le_min_l le_min_r: arith v62.
(** [min n m] is equal to [n] or [m] *)
-Lemma min_dec : (n,m:nat){(min n m)=n}+{(min n m)=m}.
+Lemma min_dec : forall n m, {min n m = n} + {min n m = m}.
Proof.
-NewInduction n;NewInduction m;Simpl;Auto with arith.
-Elim (IHn m);Intro H;Elim H;Auto.
+induction n; induction m; simpl in |- *; auto with arith.
+elim (IHn m); intro H; elim H; auto.
Qed.
-Lemma min_case : (n,m:nat)(P:nat->Set)(P n)->(P m)->(P (min n m)).
+Lemma min_case : forall n m (P:nat -> Set), P n -> P m -> P (min n m).
Proof.
-NewInduction n; Simpl; Auto with arith.
-NewInduction m; Intros; Simpl; Auto with arith.
-Pattern (min n m); Apply IHn ; Auto with arith.
+induction n; simpl in |- *; auto with arith.
+induction m; intros; simpl in |- *; auto with arith.
+pattern (min n m) in |- *; apply IHn; auto with arith.
Qed.
-Lemma min_case2 : (n,m:nat)(P:nat->Prop)(P n)->(P m)->(P (min n m)).
+Lemma min_case2 : forall n m (P:nat -> Prop), P n -> P m -> P (min n m).
Proof.
-NewInduction n; Simpl; Auto with arith.
-NewInduction m; Intros; Simpl; Auto with arith.
-Pattern (min n m); Apply IHn ; Auto with arith.
-Qed.
+induction n; simpl in |- *; auto with arith.
+induction m; intros; simpl in |- *; auto with arith.
+pattern (min n m) in |- *; apply IHn; auto with arith.
+Qed. \ No newline at end of file
diff --git a/theories/Arith/Minus.v b/theories/Arith/Minus.v
index 658c25194..783c494a2 100755
--- a/theories/Arith/Minus.v
+++ b/theories/Arith/Minus.v
@@ -10,111 +10,114 @@
(** Subtraction (difference between two natural numbers) *)
-Require Lt.
-Require Le.
+Require Import Lt.
+Require Import Le.
-V7only [Import nat_scope.].
Open Local Scope nat_scope.
-Implicit Variables Type m,n,p:nat.
+Implicit Types m n p : nat.
(** 0 is right neutral *)
-Lemma minus_n_O : (n:nat)(n=(minus n O)).
+Lemma minus_n_O : forall n, n = n - 0.
Proof.
-NewInduction n; Simpl; Auto with arith.
+induction n; simpl in |- *; auto with arith.
Qed.
-Hints Resolve minus_n_O : arith v62.
+Hint Resolve minus_n_O: arith v62.
(** Permutation with successor *)
-Lemma minus_Sn_m : (n,m:nat)(le m n)->((S (minus n m))=(minus (S n) m)).
+Lemma minus_Sn_m : forall n m, m <= n -> S (n - m) = S n - m.
Proof.
-Intros n m Le; Pattern m n; Apply le_elim_rel; Simpl; Auto with arith.
+intros n m Le; pattern m, n in |- *; apply le_elim_rel; simpl in |- *;
+ auto with arith.
Qed.
-Hints Resolve minus_Sn_m : arith v62.
+Hint Resolve minus_Sn_m: arith v62.
-Theorem pred_of_minus : (x:nat)(pred x)=(minus x (S O)).
-Intro x; NewInduction x; Simpl; Auto with arith.
+Theorem pred_of_minus : forall n, pred n = n - 1.
+intro x; induction x; simpl in |- *; auto with arith.
Qed.
(** Diagonal *)
-Lemma minus_n_n : (n:nat)(O=(minus n n)).
+Lemma minus_n_n : forall n, 0 = n - n.
Proof.
-NewInduction n; Simpl; Auto with arith.
+induction n; simpl in |- *; auto with arith.
Qed.
-Hints Resolve minus_n_n : arith v62.
+Hint Resolve minus_n_n: arith v62.
(** Simplification *)
-Lemma minus_plus_simpl :
- (n,m,p:nat)((minus n m)=(minus (plus p n) (plus p m))).
+Lemma minus_plus_simpl_l_reverse : forall n m p, n - m = p + n - (p + m).
Proof.
- NewInduction p; Simpl; Auto with arith.
+ induction p; simpl in |- *; auto with arith.
Qed.
-Hints Resolve minus_plus_simpl : arith v62.
+Hint Resolve minus_plus_simpl_l_reverse: arith v62.
(** Relation with plus *)
-Lemma plus_minus : (n,m,p:nat)(n=(plus m p))->(p=(minus n m)).
+Lemma plus_minus : forall n m p, n = m + p -> p = n - m.
Proof.
-Intros n m p; Pattern m n; Apply nat_double_ind; Simpl; Intros.
-Replace (minus n0 O) with n0; Auto with arith.
-Absurd O=(S (plus n0 p)); Auto with arith.
-Auto with arith.
+intros n m p; pattern m, n in |- *; apply nat_double_ind; simpl in |- *;
+ intros.
+replace (n0 - 0) with n0; auto with arith.
+absurd (0 = S (n0 + p)); auto with arith.
+auto with arith.
Qed.
-Hints Immediate plus_minus : arith v62.
+Hint Immediate plus_minus: arith v62.
-Lemma minus_plus : (n,m:nat)(minus (plus n m) n)=m.
-Symmetry; Auto with arith.
+Lemma minus_plus : forall n m, n + m - n = m.
+symmetry in |- *; auto with arith.
Qed.
-Hints Resolve minus_plus : arith v62.
+Hint Resolve minus_plus: arith v62.
-Lemma le_plus_minus : (n,m:nat)(le n m)->(m=(plus n (minus m n))).
+Lemma le_plus_minus : forall n m, n <= m -> m = n + (m - n).
Proof.
-Intros n m Le; Pattern n m; Apply le_elim_rel; Simpl; Auto with arith.
+intros n m Le; pattern n, m in |- *; apply le_elim_rel; simpl in |- *;
+ auto with arith.
Qed.
-Hints Resolve le_plus_minus : arith v62.
+Hint Resolve le_plus_minus: arith v62.
-Lemma le_plus_minus_r : (n,m:nat)(le n m)->(plus n (minus m n))=m.
+Lemma le_plus_minus_r : forall n m, n <= m -> n + (m - n) = m.
Proof.
-Symmetry; Auto with arith.
+symmetry in |- *; auto with arith.
Qed.
-Hints Resolve le_plus_minus_r : arith v62.
+Hint Resolve le_plus_minus_r: arith v62.
(** Relation with order *)
-Theorem le_minus: (i,h:nat) (le (minus i h) i).
+Theorem le_minus : forall n m, n - m <= n.
Proof.
-Intros i h;Pattern i h; Apply nat_double_ind; [
- Auto
-| Auto
-| Intros m n H; Simpl; Apply le_trans with m:=m; Auto ].
+intros i h; pattern i, h in |- *; apply nat_double_ind;
+ [ auto
+ | auto
+ | intros m n H; simpl in |- *; apply le_trans with (m := m); auto ].
Qed.
-Lemma lt_minus : (n,m:nat)(le m n)->(lt O m)->(lt (minus n m) n).
+Lemma lt_minus : forall n m, m <= n -> 0 < m -> n - m < n.
Proof.
-Intros n m Le; Pattern m n; Apply le_elim_rel; Simpl; Auto with arith.
-Intros; Absurd (lt O O); Auto with arith.
-Intros p q lepq Hp gtp.
-Elim (le_lt_or_eq O p); Auto with arith.
-Auto with arith.
-NewInduction 1; Elim minus_n_O; Auto with arith.
+intros n m Le; pattern m, n in |- *; apply le_elim_rel; simpl in |- *;
+ auto with arith.
+intros; absurd (0 < 0); auto with arith.
+intros p q lepq Hp gtp.
+elim (le_lt_or_eq 0 p); auto with arith.
+auto with arith.
+induction 1; elim minus_n_O; auto with arith.
Qed.
-Hints Resolve lt_minus : arith v62.
+Hint Resolve lt_minus: arith v62.
-Lemma lt_O_minus_lt : (n,m:nat)(lt O (minus n m))->(lt m n).
+Lemma lt_O_minus_lt : forall n m, 0 < n - m -> m < n.
Proof.
-Intros n m; Pattern n m; Apply nat_double_ind; Simpl; Auto with arith.
-Intros; Absurd (lt O O); Trivial with arith.
-Qed.
-Hints Immediate lt_O_minus_lt : arith v62.
-
-Theorem inj_minus_aux: (x,y:nat) ~(le y x) -> (minus x y) = O.
-Intros y x; Pattern y x ; Apply nat_double_ind; [
- Simpl; Trivial with arith
-| Intros n H; Absurd (le O (S n)); [ Assumption | Apply le_O_n]
-| Simpl; Intros n m H1 H2; Apply H1;
- Unfold not ; Intros H3; Apply H2; Apply le_n_S; Assumption].
+intros n m; pattern n, m in |- *; apply nat_double_ind; simpl in |- *;
+ auto with arith.
+intros; absurd (0 < 0); trivial with arith.
Qed.
+Hint Immediate lt_O_minus_lt: arith v62.
+
+Theorem not_le_minus_0 : forall n m, ~ m <= n -> n - m = 0.
+intros y x; pattern y, x in |- *; apply nat_double_ind;
+ [ simpl in |- *; trivial with arith
+ | intros n H; absurd (0 <= S n); [ assumption | apply le_O_n ]
+ | simpl in |- *; intros n m H1 H2; apply H1; unfold not in |- *; intros H3;
+ apply H2; apply le_n_S; assumption ].
+Qed. \ No newline at end of file
diff --git a/theories/Arith/Mult.v b/theories/Arith/Mult.v
index eb36ffa24..49fcb06e0 100755
--- a/theories/Arith/Mult.v
+++ b/theories/Arith/Mult.v
@@ -13,178 +13,166 @@ Require Export Minus.
Require Export Lt.
Require Export Le.
-V7only [Import nat_scope.].
Open Local Scope nat_scope.
-Implicit Variables Type m,n,p:nat.
+Implicit Types m n p : nat.
(** Zero property *)
-Lemma mult_0_r : (n:nat) (mult n O)=O.
+Lemma mult_0_r : forall n, n * 0 = 0.
Proof.
-Intro; Symmetry; Apply mult_n_O.
+intro; symmetry in |- *; apply mult_n_O.
Qed.
-Lemma mult_0_l : (n:nat) (mult O n)=O.
+Lemma mult_0_l : forall n, 0 * n = 0.
Proof.
-Reflexivity.
+reflexivity.
Qed.
(** Distributivity *)
-Lemma mult_plus_distr :
- (n,m,p:nat)((mult (plus n m) p)=(plus (mult n p) (mult m p))).
+Lemma mult_plus_distr_r : forall n m p, (n + m) * p = n * p + m * p.
Proof.
-Intros; Elim n; Simpl; Intros; Auto with arith.
-Elim plus_assoc_l; Elim H; Auto with arith.
+intros; elim n; simpl in |- *; intros; auto with arith.
+elim plus_assoc; elim H; auto with arith.
Qed.
-Hints Resolve mult_plus_distr : arith v62.
+Hint Resolve mult_plus_distr_r: arith v62.
-Lemma mult_plus_distr_r : (n,m,p:nat) (mult n (plus m p))=(plus (mult n m) (mult n p)).
+Lemma mult_plus_distr_l : forall n m p, n * (m + p) = n * m + n * p.
Proof.
- NewInduction n. Trivial.
- Intros. Simpl. Rewrite (IHn m p). Apply sym_eq. Apply plus_permute_2_in_4.
+ induction n. trivial.
+ intros. simpl in |- *. rewrite (IHn m p). apply sym_eq. apply plus_permute_2_in_4.
Qed.
-Lemma mult_minus_distr : (n,m,p:nat)((mult (minus n m) p)=(minus (mult n p) (mult m p))).
+Lemma mult_minus_distr_r : forall n m p, (n - m) * p = n * p - m * p.
Proof.
-Intros; Pattern n m; Apply nat_double_ind; Simpl; Intros; Auto with arith.
-Elim minus_plus_simpl; Auto with arith.
+intros; pattern n, m in |- *; apply nat_double_ind; simpl in |- *; intros;
+ auto with arith.
+elim minus_plus_simpl_l_reverse; auto with arith.
Qed.
-Hints Resolve mult_minus_distr : arith v62.
+Hint Resolve mult_minus_distr_r: arith v62.
(** Associativity *)
-Lemma mult_assoc_r : (n,m,p:nat)((mult (mult n m) p) = (mult n (mult m p))).
+Lemma mult_assoc_reverse : forall n m p, n * m * p = n * (m * p).
Proof.
-Intros; Elim n; Intros; Simpl; Auto with arith.
-Rewrite mult_plus_distr.
-Elim H; Auto with arith.
+intros; elim n; intros; simpl in |- *; auto with arith.
+rewrite mult_plus_distr_r.
+elim H; auto with arith.
Qed.
-Hints Resolve mult_assoc_r : arith v62.
+Hint Resolve mult_assoc_reverse: arith v62.
-Lemma mult_assoc_l : (n,m,p:nat)(mult n (mult m p)) = (mult (mult n m) p).
+Lemma mult_assoc : forall n m p, n * (m * p) = n * m * p.
Proof.
-Auto with arith.
+auto with arith.
Qed.
-Hints Resolve mult_assoc_l : arith v62.
+Hint Resolve mult_assoc: arith v62.
(** Commutativity *)
-Lemma mult_sym : (n,m:nat)(mult n m)=(mult m n).
+Lemma mult_comm : forall n m, n * m = m * n.
Proof.
-Intros; Elim n; Intros; Simpl; Auto with arith.
-Elim mult_n_Sm.
-Elim H; Apply plus_sym.
+intros; elim n; intros; simpl in |- *; auto with arith.
+elim mult_n_Sm.
+elim H; apply plus_comm.
Qed.
-Hints Resolve mult_sym : arith v62.
+Hint Resolve mult_comm: arith v62.
(** 1 is neutral *)
-Lemma mult_1_n : (n:nat)(mult (S O) n)=n.
+Lemma mult_1_l : forall n, 1 * n = n.
Proof.
-Simpl; Auto with arith.
+simpl in |- *; auto with arith.
Qed.
-Hints Resolve mult_1_n : arith v62.
+Hint Resolve mult_1_l: arith v62.
-Lemma mult_n_1 : (n:nat)(mult n (S O))=n.
+Lemma mult_1_r : forall n, n * 1 = n.
Proof.
-Intro; Elim mult_sym; Auto with arith.
+intro; elim mult_comm; auto with arith.
Qed.
-Hints Resolve mult_n_1 : arith v62.
+Hint Resolve mult_1_r: arith v62.
(** Compatibility with orders *)
-Lemma mult_O_le : (n,m:nat)(m=O)\/(le n (mult m n)).
+Lemma mult_O_le : forall n m, m = 0 \/ n <= m * n.
Proof.
-NewInduction m; Simpl; Auto with arith.
+induction m; simpl in |- *; auto with arith.
Qed.
-Hints Resolve mult_O_le : arith v62.
+Hint Resolve mult_O_le: arith v62.
-Lemma mult_le_compat_l : (n,m,p:nat) (le n m) -> (le (mult p n) (mult p m)).
+Lemma mult_le_compat_l : forall n m p, n <= m -> p * n <= p * m.
Proof.
- NewInduction p as [|p IHp]. Intros. Simpl. Apply le_n.
- Intros. Simpl. Apply le_plus_plus. Assumption.
- Apply IHp. Assumption.
+ induction p as [| p IHp]. intros. simpl in |- *. apply le_n.
+ intros. simpl in |- *. apply plus_le_compat. assumption.
+ apply IHp. assumption.
Qed.
-Hints Resolve mult_le_compat_l : arith.
-V7only [
-Notation mult_le := [m,n,p:nat](mult_le_compat_l p n m).
-].
+Hint Resolve mult_le_compat_l: arith.
-Lemma le_mult_right : (m,n,p:nat)(le m n)->(le (mult m p) (mult n p)).
-Intros m n p H.
-Rewrite mult_sym. Rewrite (mult_sym n).
-Auto with arith.
+Lemma mult_le_compat_r : forall n m p, n <= m -> n * p <= m * p.
+intros m n p H.
+rewrite mult_comm. rewrite (mult_comm n).
+auto with arith.
Qed.
-Lemma le_mult_mult :
- (m,n,p,q:nat)(le m n)->(le p q)->(le (mult m p) (mult n q)).
+Lemma mult_le_compat :
+ forall n m p (q:nat), n <= m -> p <= q -> n * p <= m * q.
Proof.
-Intros m n p q Hmn Hpq; NewInduction Hmn.
-NewInduction Hpq.
+intros m n p q Hmn Hpq; induction Hmn.
+induction Hpq.
(* m*p<=m*p *)
-Apply le_n.
+apply le_n.
(* m*p<=m*m0 -> m*p<=m*(S m0) *)
-Rewrite <- mult_n_Sm; Apply le_trans with (mult m m0).
-Assumption.
-Apply le_plus_l.
+rewrite <- mult_n_Sm; apply le_trans with (m * m0).
+assumption.
+apply le_plus_l.
(* m*p<=m0*q -> m*p<=(S m0)*q *)
-Simpl; Apply le_trans with (mult m0 q).
-Assumption.
-Apply le_plus_r.
+simpl in |- *; apply le_trans with (m0 * q).
+assumption.
+apply le_plus_r.
Qed.
-Lemma mult_lt : (m,n,p:nat) (lt n p) -> (lt (mult (S m) n) (mult (S m) p)).
+Lemma mult_S_lt_compat_l : forall n m p, m < p -> S n * m < S n * p.
Proof.
- Intro m; NewInduction m. Intros. Simpl. Rewrite <- plus_n_O. Rewrite <- plus_n_O. Assumption.
- Intros. Exact (lt_plus_plus ? ? ? ? H (IHm ? ? H)).
+ intro m; induction m. intros. simpl in |- *. rewrite <- plus_n_O. rewrite <- plus_n_O. assumption.
+ intros. exact (plus_lt_compat _ _ _ _ H (IHm _ _ H)).
Qed.
-Hints Resolve mult_lt : arith.
-V7only [
-Notation lt_mult_left := mult_lt.
-(* Theorem lt_mult_left :
- (x,y,z:nat) (lt x y) -> (lt (mult (S z) x) (mult (S z) y)).
-*)
-].
+Hint Resolve mult_S_lt_compat_l: arith.
-Lemma lt_mult_right :
- (m,n,p:nat) (lt m n) -> (lt (0) p) -> (lt (mult m p) (mult n p)).
-Intros m n p H H0.
-NewInduction p.
-Elim (lt_n_n ? H0).
-Rewrite mult_sym.
-Replace (mult n (S p)) with (mult (S p) n); Auto with arith.
+Lemma mult_lt_compat_r : forall n m p, n < m -> 0 < p -> n * p < m * p.
+intros m n p H H0.
+induction p.
+elim (lt_irrefl _ H0).
+rewrite mult_comm.
+replace (n * S p) with (S p * n); auto with arith.
Qed.
-Lemma mult_le_conv_1 : (m,n,p:nat) (le (mult (S m) n) (mult (S m) p)) -> (le n p).
+Lemma mult_S_le_reg_l : forall n m p, S n * m <= S n * p -> m <= p.
Proof.
- Intros m n p H. Elim (le_or_lt n p). Trivial.
- Intro H0. Cut (lt (mult (S m) n) (mult (S m) n)). Intro. Elim (lt_n_n ? H1).
- Apply le_lt_trans with m:=(mult (S m) p). Assumption.
- Apply mult_lt. Assumption.
+ intros m n p H. elim (le_or_lt n p). trivial.
+ intro H0. cut (S m * n < S m * n). intro. elim (lt_irrefl _ H1).
+ apply le_lt_trans with (m := S m * p). assumption.
+ apply mult_S_lt_compat_l. assumption.
Qed.
(** n|->2*n and n|->2n+1 have disjoint image *)
-V7only [ (* From Zdivides *) ].
-Theorem odd_even_lem:
- (p, q : ?) ~ (plus (mult (2) p) (1)) = (mult (2) q).
-Intros p; Elim p; Auto.
-Intros q; Case q; Simpl.
-Red; Intros; Discriminate.
-Intros q'; Rewrite [x, y : ?] (plus_sym x (S y)); Simpl; Red; Intros;
- Discriminate.
-Intros p' H q; Case q.
-Simpl; Red; Intros; Discriminate.
-Intros q'; Red; Intros H0; Case (H q').
-Replace (mult (S (S O)) q') with (minus (mult (S (S O)) (S q')) (2)).
-Rewrite <- H0; Simpl; Auto.
-Repeat Rewrite [x, y : ?] (plus_sym x (S y)); Simpl; Auto.
-Simpl; Repeat Rewrite [x, y : ?] (plus_sym x (S y)); Simpl; Auto.
-Case q'; Simpl; Auto.
+Theorem odd_even_lem : forall p q, 2 * p + 1 <> 2 * q.
+intros p; elim p; auto.
+intros q; case q; simpl in |- *.
+red in |- *; intros; discriminate.
+intros q'; rewrite (fun x y => plus_comm x (S y)); simpl in |- *; red in |- *;
+ intros; discriminate.
+intros p' H q; case q.
+simpl in |- *; red in |- *; intros; discriminate.
+intros q'; red in |- *; intros H0; case (H q').
+replace (2 * q') with (2 * S q' - 2).
+rewrite <- H0; simpl in |- *; auto.
+repeat rewrite (fun x y => plus_comm x (S y)); simpl in |- *; auto.
+simpl in |- *; repeat rewrite (fun x y => plus_comm x (S y)); simpl in |- *;
+ auto.
+case q'; simpl in |- *; auto.
Qed.
@@ -194,31 +182,30 @@ Qed.
tail-recursive, whereas [mult] is not. This can be useful
when extracting programs. *)
-Fixpoint mult_acc [s,m,n:nat] : nat :=
- Cases n of
- O => s
- | (S p) => (mult_acc (tail_plus m s) m p)
- end.
+Fixpoint mult_acc (s:nat) m n {struct n} : nat :=
+ match n with
+ | O => s
+ | S p => mult_acc (tail_plus m s) m p
+ end.
-Lemma mult_acc_aux : (n,s,m:nat)(plus s (mult n m))= (mult_acc s m n).
+Lemma mult_acc_aux : forall n m p, m + n * p = mult_acc m p n.
Proof.
-NewInduction n as [|p IHp]; Simpl;Auto.
-Intros s m; Rewrite <- plus_tail_plus; Rewrite <- IHp.
-Rewrite <- plus_assoc_r; Apply (f_equal2 nat nat);Auto.
-Rewrite plus_sym;Auto.
+induction n as [| p IHp]; simpl in |- *; auto.
+intros s m; rewrite <- plus_tail_plus; rewrite <- IHp.
+rewrite <- plus_assoc_reverse; apply (f_equal2 (A1:=nat) (A2:=nat)); auto.
+rewrite plus_comm; auto.
Qed.
-Definition tail_mult := [n,m:nat](mult_acc O m n).
+Definition tail_mult n m := mult_acc 0 m n.
-Lemma mult_tail_mult : (n,m:nat)(mult n m)=(tail_mult n m).
+Lemma mult_tail_mult : forall n m, n * m = tail_mult n m.
Proof.
-Intros; Unfold tail_mult; Rewrite <- mult_acc_aux;Auto.
+intros; unfold tail_mult in |- *; rewrite <- mult_acc_aux; auto.
Qed.
(** [TailSimpl] transforms any [tail_plus] and [tail_mult] into [plus]
and [mult] and simplify *)
-Tactic Definition TailSimpl :=
- Repeat Rewrite <- plus_tail_plus;
- Repeat Rewrite <- mult_tail_mult;
- Simpl.
+Ltac tail_simpl :=
+ repeat rewrite <- plus_tail_plus; repeat rewrite <- mult_tail_mult;
+ simpl in |- *. \ No newline at end of file
diff --git a/theories/Arith/Peano_dec.v b/theories/Arith/Peano_dec.v
index 96a8523f9..4d657d060 100755
--- a/theories/Arith/Peano_dec.v
+++ b/theories/Arith/Peano_dec.v
@@ -8,29 +8,27 @@
(*i $Id$ i*)
-Require Decidable.
+Require Import Decidable.
-V7only [Import nat_scope.].
Open Local Scope nat_scope.
-Implicit Variables Type m,n,x,y:nat.
+Implicit Types m n x y : nat.
-Theorem O_or_S : (n:nat)({m:nat|(S m)=n})+{O=n}.
+Theorem O_or_S : forall n, {m : nat | S m = n} + {0 = n}.
Proof.
-NewInduction n.
-Auto.
-Left; Exists n; Auto.
+induction n.
+auto.
+left; exists n; auto.
Defined.
-Theorem eq_nat_dec : (n,m:nat){n=m}+{~(n=m)}.
+Theorem eq_nat_dec : forall n m, {n = m} + {n <> m}.
Proof.
-NewInduction n; NewInduction m; Auto.
-Elim (IHn m); Auto.
+induction n; induction m; auto.
+elim (IHn m); auto.
Defined.
-Hints Resolve O_or_S eq_nat_dec : arith.
+Hint Resolve O_or_S eq_nat_dec: arith.
-Theorem dec_eq_nat:(x,y:nat)(decidable (x=y)).
-Intros x y; Unfold decidable; Elim (eq_nat_dec x y); Auto with arith.
+Theorem dec_eq_nat : forall n m, decidable (n = m).
+intros x y; unfold decidable in |- *; elim (eq_nat_dec x y); auto with arith.
Defined.
-
diff --git a/theories/Arith/Plus.v b/theories/Arith/Plus.v
index ffa94fcd0..496ac3330 100755
--- a/theories/Arith/Plus.v
+++ b/theories/Arith/Plus.v
@@ -10,183 +10,176 @@
(** Properties of addition *)
-Require Le.
-Require Lt.
+Require Import Le.
+Require Import Lt.
-V7only [Import nat_scope.].
Open Local Scope nat_scope.
-Implicit Variables Type m,n,p,q:nat.
+Implicit Types m n p q : nat.
(** Zero is neutral *)
-Lemma plus_0_l : (n:nat) (O+n)=n.
+Lemma plus_0_l : forall n, 0 + n = n.
Proof.
-Reflexivity.
+reflexivity.
Qed.
-Lemma plus_0_r : (n:nat) (n+O)=n.
+Lemma plus_0_r : forall n, n + 0 = n.
Proof.
-Intro; Symmetry; Apply plus_n_O.
+intro; symmetry in |- *; apply plus_n_O.
Qed.
(** Commutativity *)
-Lemma plus_sym : (n,m:nat)(n+m)=(m+n).
+Lemma plus_comm : forall n m, n + m = m + n.
Proof.
-Intros n m ; Elim n ; Simpl ; Auto with arith.
-Intros y H ; Elim (plus_n_Sm m y) ; Auto with arith.
+intros n m; elim n; simpl in |- *; auto with arith.
+intros y H; elim (plus_n_Sm m y); auto with arith.
Qed.
-Hints Immediate plus_sym : arith v62.
+Hint Immediate plus_comm: arith v62.
(** Associativity *)
-Lemma plus_Snm_nSm : (n,m:nat)((S n)+m)=(n+(S m)).
-Intros.
-Simpl.
-Rewrite -> (plus_sym n m).
-Rewrite -> (plus_sym n (S m)).
-Trivial with arith.
+Lemma plus_Snm_nSm : forall n m, S n + m = n + S m.
+intros.
+simpl in |- *.
+rewrite (plus_comm n m).
+rewrite (plus_comm n (S m)).
+trivial with arith.
Qed.
-Lemma plus_assoc_l : (n,m,p:nat)((n+(m+p))=((n+m)+p)).
+Lemma plus_assoc : forall n m p, n + (m + p) = n + m + p.
Proof.
-Intros n m p; Elim n; Simpl; Auto with arith.
+intros n m p; elim n; simpl in |- *; auto with arith.
Qed.
-Hints Resolve plus_assoc_l : arith v62.
+Hint Resolve plus_assoc: arith v62.
-Lemma plus_permute : (n,m,p:nat) ((n+(m+p))=(m+(n+p))).
+Lemma plus_permute : forall n m p, n + (m + p) = m + (n + p).
Proof.
-Intros; Rewrite (plus_assoc_l m n p); Rewrite (plus_sym m n); Auto with arith.
+intros; rewrite (plus_assoc m n p); rewrite (plus_comm m n); auto with arith.
Qed.
-Lemma plus_assoc_r : (n,m,p:nat)(((n+m)+p)=(n+(m+p))).
+Lemma plus_assoc_reverse : forall n m p, n + m + p = n + (m + p).
Proof.
-Auto with arith.
+auto with arith.
Qed.
-Hints Resolve plus_assoc_r : arith v62.
+Hint Resolve plus_assoc_reverse: arith v62.
(** Simplification *)
-Lemma plus_reg_l : (n,m,p:nat)((p+n)=(p+m))->(n=m).
+Lemma plus_reg_l : forall n m p, p + n = p + m -> n = m.
Proof.
-Intros m p n; NewInduction n ; Simpl ; Auto with arith.
+intros m p n; induction n; simpl in |- *; auto with arith.
Qed.
-V7only [
-Notation simpl_plus_l := [n,m,p:nat](plus_reg_l m p n).
-].
-Lemma plus_le_reg_l : (n,m,p:nat) (p+n)<=(p+m) -> n<=m.
+Lemma plus_le_reg_l : forall n m p, p + n <= p + m -> n <= m.
Proof.
-NewInduction p; Simpl; Auto with arith.
+induction p; simpl in |- *; auto with arith.
Qed.
-V7only [
-Notation simpl_le_plus_l := [p,n,m:nat](plus_le_reg_l n m p).
-].
-Lemma simpl_lt_plus_l : (n,m,p:nat) (p+n)<(p+m) -> n<m.
+Lemma plus_lt_reg_l : forall n m p, p + n < p + m -> n < m.
Proof.
-NewInduction p; Simpl; Auto with arith.
+induction p; simpl in |- *; auto with arith.
Qed.
(** Compatibility with order *)
-Lemma le_reg_l : (n,m,p:nat) n<=m -> (p+n)<=(p+m).
+Lemma plus_le_compat_l : forall n m p, n <= m -> p + n <= p + m.
Proof.
-NewInduction p; Simpl; Auto with arith.
+induction p; simpl in |- *; auto with arith.
Qed.
-Hints Resolve le_reg_l : arith v62.
+Hint Resolve plus_le_compat_l: arith v62.
-Lemma le_reg_r : (a,b,c:nat) a<=b -> (a+c)<=(b+c).
+Lemma plus_le_compat_r : forall n m p, n <= m -> n + p <= m + p.
Proof.
-NewInduction 1 ; Simpl; Auto with arith.
+induction 1; simpl in |- *; auto with arith.
Qed.
-Hints Resolve le_reg_r : arith v62.
+Hint Resolve plus_le_compat_r: arith v62.
-Lemma le_plus_l : (n,m:nat) n<=(n+m).
+Lemma le_plus_l : forall n m, n <= n + m.
Proof.
-NewInduction n; Simpl; Auto with arith.
+induction n; simpl in |- *; auto with arith.
Qed.
-Hints Resolve le_plus_l : arith v62.
+Hint Resolve le_plus_l: arith v62.
-Lemma le_plus_r : (n,m:nat) m<=(n+m).
+Lemma le_plus_r : forall n m, m <= n + m.
Proof.
-Intros n m; Elim n; Simpl; Auto with arith.
+intros n m; elim n; simpl in |- *; auto with arith.
Qed.
-Hints Resolve le_plus_r : arith v62.
+Hint Resolve le_plus_r: arith v62.
-Theorem le_plus_trans : (n,m,p:nat) n<=m -> n<=(m+p).
+Theorem le_plus_trans : forall n m p, n <= m -> n <= m + p.
Proof.
-Intros; Apply le_trans with m:=m; Auto with arith.
+intros; apply le_trans with (m := m); auto with arith.
Qed.
-Hints Resolve le_plus_trans : arith v62.
+Hint Resolve le_plus_trans: arith v62.
-Theorem lt_plus_trans : (n,m,p:nat) n<m -> n<(m+p).
+Theorem lt_plus_trans : forall n m p, n < m -> n < m + p.
Proof.
-Intros; Apply lt_le_trans with m:=m; Auto with arith.
+intros; apply lt_le_trans with (m := m); auto with arith.
Qed.
-Hints Immediate lt_plus_trans : arith v62.
+Hint Immediate lt_plus_trans: arith v62.
-Lemma lt_reg_l : (n,m,p:nat) n<m -> (p+n)<(p+m).
+Lemma plus_lt_compat_l : forall n m p, n < m -> p + n < p + m.
Proof.
-NewInduction p; Simpl; Auto with arith.
+induction p; simpl in |- *; auto with arith.
Qed.
-Hints Resolve lt_reg_l : arith v62.
+Hint Resolve plus_lt_compat_l: arith v62.
-Lemma lt_reg_r : (n,m,p:nat) n<m -> (n+p)<(m+p).
+Lemma plus_lt_compat_r : forall n m p, n < m -> n + p < m + p.
Proof.
-Intros n m p H ; Rewrite (plus_sym n p) ; Rewrite (plus_sym m p).
-Elim p; Auto with arith.
+intros n m p H; rewrite (plus_comm n p); rewrite (plus_comm m p).
+elim p; auto with arith.
Qed.
-Hints Resolve lt_reg_r : arith v62.
+Hint Resolve plus_lt_compat_r: arith v62.
-Lemma le_plus_plus : (n,m,p,q:nat) n<=m -> p<=q -> (n+p)<=(m+q).
+Lemma plus_le_compat : forall n m p q, n <= m -> p <= q -> n + p <= m + q.
Proof.
-Intros n m p q H H0.
-Elim H; Simpl; Auto with arith.
+intros n m p q H H0.
+elim H; simpl in |- *; auto with arith.
Qed.
-Lemma le_lt_plus_plus : (n,m,p,q:nat) n<=m -> p<q -> (n+p)<(m+q).
+Lemma plus_le_lt_compat : forall n m p q, n <= m -> p < q -> n + p < m + q.
Proof.
- Unfold lt. Intros. Change ((S n)+p)<=(m+q). Rewrite plus_Snm_nSm.
- Apply le_plus_plus; Assumption.
+ unfold lt in |- *. intros. change (S n + p <= m + q) in |- *. rewrite plus_Snm_nSm.
+ apply plus_le_compat; assumption.
Qed.
-Lemma lt_le_plus_plus : (n,m,p,q:nat) n<m -> p<=q -> (n+p)<(m+q).
+Lemma plus_lt_le_compat : forall n m p q, n < m -> p <= q -> n + p < m + q.
Proof.
- Unfold lt. Intros. Change ((S n)+p)<=(m+q). Apply le_plus_plus; Assumption.
+ unfold lt in |- *. intros. change (S n + p <= m + q) in |- *. apply plus_le_compat; assumption.
Qed.
-Lemma lt_plus_plus : (n,m,p,q:nat) n<m -> p<q -> (n+p)<(m+q).
+Lemma plus_lt_compat : forall n m p q, n < m -> p < q -> n + p < m + q.
Proof.
- Intros. Apply lt_le_plus_plus. Assumption.
- Apply lt_le_weak. Assumption.
+ intros. apply plus_lt_le_compat. assumption.
+ apply lt_le_weak. assumption.
Qed.
(** Inversion lemmas *)
-Lemma plus_is_O : (m,n:nat) (m+n)=O -> m=O /\ n=O.
+Lemma plus_is_O : forall n m, n + m = 0 -> n = 0 /\ m = 0.
Proof.
- Intro m; NewDestruct m; Auto.
- Intros. Discriminate H.
+ intro m; destruct m as [| n]; auto.
+ intros. discriminate H.
Qed.
-Definition plus_is_one :
- (m,n:nat) (m+n)=(S O) -> {m=O /\ n=(S O)}+{m=(S O) /\ n=O}.
+Definition plus_is_one :
+ forall m n, m + n = 1 -> {m = 0 /\ n = 1} + {m = 1 /\ n = 0}.
Proof.
- Intro m; NewDestruct m; Auto.
- NewDestruct n; Auto.
- Intros.
- Simpl in H. Discriminate H.
+ intro m; destruct m as [| n]; auto.
+ destruct n; auto.
+ intros.
+ simpl in H. discriminate H.
Defined.
(** Derived properties *)
-Lemma plus_permute_2_in_4 : (m,n,p,q:nat) ((m+n)+(p+q))=((m+p)+(n+q)).
+Lemma plus_permute_2_in_4 : forall n m p q, n + m + (p + q) = n + p + (m + q).
Proof.
- Intros m n p q.
- Rewrite <- (plus_assoc_l m n (p+q)). Rewrite (plus_assoc_l n p q).
- Rewrite (plus_sym n p). Rewrite <- (plus_assoc_l p n q). Apply plus_assoc_l.
+ intros m n p q.
+ rewrite <- (plus_assoc m n (p + q)). rewrite (plus_assoc n p q).
+ rewrite (plus_comm n p). rewrite <- (plus_assoc p n q). apply plus_assoc.
Qed.
(** Tail-recursive plus *)
@@ -195,15 +188,15 @@ Qed.
tail-recursive, whereas [plus] is not. This can be useful
when extracting programs. *)
-Fixpoint plus_acc [q,n:nat] : nat :=
- Cases n of
- O => q
- | (S p) => (plus_acc (S q) p)
- end.
+Fixpoint plus_acc q n {struct n} : nat :=
+ match n with
+ | O => q
+ | S p => plus_acc (S q) p
+ end.
-Definition tail_plus := [n,m:nat](plus_acc m n).
+Definition tail_plus n m := plus_acc m n.
-Lemma plus_tail_plus : (n,m:nat)(n+m)=(tail_plus n m).
-Unfold tail_plus; NewInduction n as [|n IHn]; Simpl; Auto.
-Intro m; Rewrite <- IHn; Simpl; Auto.
-Qed.
+Lemma plus_tail_plus : forall n m, n + m = tail_plus n m.
+unfold tail_plus in |- *; induction n as [| n IHn]; simpl in |- *; auto.
+intro m; rewrite <- IHn; simpl in |- *; auto.
+Qed. \ No newline at end of file
diff --git a/theories/Arith/Wf_nat.v b/theories/Arith/Wf_nat.v
index 51df19b29..a7a50795e 100755
--- a/theories/Arith/Wf_nat.v
+++ b/theories/Arith/Wf_nat.v
@@ -10,36 +10,35 @@
(** Well-founded relations and natural numbers *)
-Require Lt.
+Require Import Lt.
-V7only [Import nat_scope.].
Open Local Scope nat_scope.
-Implicit Variables Type m,n,p:nat.
+Implicit Types m n p : nat.
-Chapter Well_founded_Nat.
+Section Well_founded_Nat.
Variable A : Set.
Variable f : A -> nat.
-Definition ltof := [a,b:A](lt (f a) (f b)).
-Definition gtof := [a,b:A](gt (f b) (f a)).
+Definition ltof (a b:A) := f a < f b.
+Definition gtof (a b:A) := f b > f a.
-Theorem well_founded_ltof : (well_founded A ltof).
+Theorem well_founded_ltof : well_founded ltof.
Proof.
-Red.
-Cut (n:nat)(a:A)(lt (f a) n)->(Acc A ltof a).
-Intros H a; Apply (H (S (f a))); Auto with arith.
-NewInduction n.
-Intros; Absurd (lt (f a) O); Auto with arith.
-Intros a ltSma.
-Apply Acc_intro.
-Unfold ltof; Intros b ltfafb.
-Apply IHn.
-Apply lt_le_trans with (f a); Auto with arith.
+red in |- *.
+cut (forall n (a:A), f a < n -> Acc ltof a).
+intros H a; apply (H (S (f a))); auto with arith.
+induction n.
+intros; absurd (f a < 0); auto with arith.
+intros a ltSma.
+apply Acc_intro.
+unfold ltof in |- *; intros b ltfafb.
+apply IHn.
+apply lt_le_trans with (f a); auto with arith.
Qed.
-Theorem well_founded_gtof : (well_founded A gtof).
+Theorem well_founded_gtof : well_founded gtof.
Proof well_founded_ltof.
(** It is possible to directly prove the induction principle going
@@ -59,142 +58,149 @@ the ML-like program for [induction_ltof2] is : [[
where rec indrec a = F a indrec;;
]] *)
-Theorem induction_ltof1
- : (P:A->Set)((x:A)((y:A)(ltof y x)->(P y))->(P x))->(a:A)(P a).
+Theorem induction_ltof1 :
+ forall P:A -> Set,
+ (forall x:A, (forall y:A, ltof y x -> P y) -> P x) -> forall a:A, P a.
Proof.
-Intros P F; Cut (n:nat)(a:A)(lt (f a) n)->(P a).
-Intros H a; Apply (H (S (f a))); Auto with arith.
-NewInduction n.
-Intros; Absurd (lt (f a) O); Auto with arith.
-Intros a ltSma.
-Apply F.
-Unfold ltof; Intros b ltfafb.
-Apply IHn.
-Apply lt_le_trans with (f a); Auto with arith.
+intros P F; cut (forall n (a:A), f a < n -> P a).
+intros H a; apply (H (S (f a))); auto with arith.
+induction n.
+intros; absurd (f a < 0); auto with arith.
+intros a ltSma.
+apply F.
+unfold ltof in |- *; intros b ltfafb.
+apply IHn.
+apply lt_le_trans with (f a); auto with arith.
Defined.
-Theorem induction_gtof1
- : (P:A->Set)((x:A)((y:A)(gtof y x)->(P y))->(P x))->(a:A)(P a).
+Theorem induction_gtof1 :
+ forall P:A -> Set,
+ (forall x:A, (forall y:A, gtof y x -> P y) -> P x) -> forall a:A, P a.
Proof.
-Exact induction_ltof1.
+exact induction_ltof1.
Defined.
-Theorem induction_ltof2
- : (P:A->Set)((x:A)((y:A)(ltof y x)->(P y))->(P x))->(a:A)(P a).
+Theorem induction_ltof2 :
+ forall P:A -> Set,
+ (forall x:A, (forall y:A, ltof y x -> P y) -> P x) -> forall a:A, P a.
Proof.
-Exact (well_founded_induction A ltof well_founded_ltof).
+exact (well_founded_induction well_founded_ltof).
Defined.
-Theorem induction_gtof2
- : (P:A->Set)((x:A)((y:A)(gtof y x)->(P y))->(P x))->(a:A)(P a).
+Theorem induction_gtof2 :
+ forall P:A -> Set,
+ (forall x:A, (forall y:A, gtof y x -> P y) -> P x) -> forall a:A, P a.
Proof.
-Exact induction_ltof2.
+exact induction_ltof2.
Defined.
(** If a relation [R] is compatible with [lt] i.e. if [x R y => f(x) < f(y)]
then [R] is well-founded. *)
-Variable R : A->A->Prop.
+Variable R : A -> A -> Prop.
-Hypothesis H_compat : (x,y:A) (R x y) -> (lt (f x) (f y)).
+Hypothesis H_compat : forall x y:A, R x y -> f x < f y.
-Theorem well_founded_lt_compat : (well_founded A R).
+Theorem well_founded_lt_compat : well_founded R.
Proof.
-Red.
-Cut (n:nat)(a:A)(lt (f a) n)->(Acc A R a).
-Intros H a; Apply (H (S (f a))); Auto with arith.
-NewInduction n.
-Intros; Absurd (lt (f a) O); Auto with arith.
-Intros a ltSma.
-Apply Acc_intro.
-Intros b ltfafb.
-Apply IHn.
-Apply lt_le_trans with (f a); Auto with arith.
+red in |- *.
+cut (forall n (a:A), f a < n -> Acc R a).
+intros H a; apply (H (S (f a))); auto with arith.
+induction n.
+intros; absurd (f a < 0); auto with arith.
+intros a ltSma.
+apply Acc_intro.
+intros b ltfafb.
+apply IHn.
+apply lt_le_trans with (f a); auto with arith.
Qed.
End Well_founded_Nat.
-Lemma lt_wf : (well_founded nat lt).
-Proof (well_founded_ltof nat [m:nat]m).
+Lemma lt_wf : well_founded lt.
+Proof well_founded_ltof nat (fun m => m).
-Lemma lt_wf_rec1 : (p:nat)(P:nat->Set)
- ((n:nat)((m:nat)(lt m n)->(P m))->(P n)) -> (P p).
+Lemma lt_wf_rec1 :
+ forall n (P:nat -> Set), (forall n, (forall m, m < n -> P m) -> P n) -> P n.
Proof.
-Exact [p:nat][P:nat->Set][F:(n:nat)((m:nat)(lt m n)->(P m))->(P n)]
- (induction_ltof1 nat [m:nat]m P F p).
+exact
+ (fun p (P:nat -> Set) (F:forall n, (forall m, m < n -> P m) -> P n) =>
+ induction_ltof1 nat (fun m => m) P F p).
Defined.
-Lemma lt_wf_rec : (p:nat)(P:nat->Set)
- ((n:nat)((m:nat)(lt m n)->(P m))->(P n)) -> (P p).
+Lemma lt_wf_rec :
+ forall n (P:nat -> Set), (forall n, (forall m, m < n -> P m) -> P n) -> P n.
Proof.
-Exact [p:nat][P:nat->Set][F:(n:nat)((m:nat)(lt m n)->(P m))->(P n)]
- (induction_ltof2 nat [m:nat]m P F p).
+exact
+ (fun p (P:nat -> Set) (F:forall n, (forall m, m < n -> P m) -> P n) =>
+ induction_ltof2 nat (fun m => m) P F p).
Defined.
-Lemma lt_wf_ind : (p:nat)(P:nat->Prop)
- ((n:nat)((m:nat)(lt m n)->(P m))->(P n)) -> (P p).
-Intro p; Intros; Elim (lt_wf p); Auto with arith.
+Lemma lt_wf_ind :
+ forall n (P:nat -> Prop), (forall n, (forall m, m < n -> P m) -> P n) -> P n.
+intro p; intros; elim (lt_wf p); auto with arith.
Qed.
-Lemma gt_wf_rec : (p:nat)(P:nat->Set)
- ((n:nat)((m:nat)(gt n m)->(P m))->(P n)) -> (P p).
+Lemma gt_wf_rec :
+ forall n (P:nat -> Set), (forall n, (forall m, n > m -> P m) -> P n) -> P n.
Proof.
-Exact lt_wf_rec.
+exact lt_wf_rec.
Defined.
-Lemma gt_wf_ind : (p:nat)(P:nat->Prop)
- ((n:nat)((m:nat)(gt n m)->(P m))->(P n)) -> (P p).
+Lemma gt_wf_ind :
+ forall n (P:nat -> Prop), (forall n, (forall m, n > m -> P m) -> P n) -> P n.
Proof lt_wf_ind.
-Lemma lt_wf_double_rec :
- (P:nat->nat->Set)
- ((n,m:nat)((p,q:nat)(lt p n)->(P p q))->((p:nat)(lt p m)->(P n p))->(P n m))
- -> (p,q:nat)(P p q).
-Intros P Hrec p; Pattern p; Apply lt_wf_rec.
-Intros n H q; Pattern q; Apply lt_wf_rec; Auto with arith.
+Lemma lt_wf_double_rec :
+ forall P:nat -> nat -> Set,
+ (forall n m,
+ (forall p (q:nat), p < n -> P p q) ->
+ (forall p, p < m -> P n p) -> P n m) -> forall n m, P n m.
+intros P Hrec p; pattern p in |- *; apply lt_wf_rec.
+intros n H q; pattern q in |- *; apply lt_wf_rec; auto with arith.
Defined.
-Lemma lt_wf_double_ind :
- (P:nat->nat->Prop)
- ((n,m:nat)((p,q:nat)(lt p n)->(P p q))->((p:nat)(lt p m)->(P n p))->(P n m))
- -> (p,q:nat)(P p q).
-Intros P Hrec p; Pattern p; Apply lt_wf_ind.
-Intros n H q; Pattern q; Apply lt_wf_ind; Auto with arith.
+Lemma lt_wf_double_ind :
+ forall P:nat -> nat -> Prop,
+ (forall n m,
+ (forall p (q:nat), p < n -> P p q) ->
+ (forall p, p < m -> P n p) -> P n m) -> forall n m, P n m.
+intros P Hrec p; pattern p in |- *; apply lt_wf_ind.
+intros n H q; pattern q in |- *; apply lt_wf_ind; auto with arith.
Qed.
-Hints Resolve lt_wf : arith.
-Hints Resolve well_founded_lt_compat : arith.
+Hint Resolve lt_wf: arith.
+Hint Resolve well_founded_lt_compat: arith.
Section LT_WF_REL.
-Variable A :Set.
-Variable R:A->A->Prop.
+Variable A : Set.
+Variable R : A -> A -> Prop.
(* Relational form of inversion *)
Variable F : A -> nat -> Prop.
-Definition inv_lt_rel
- [x,y]:=(EX n | (F x n) & (m:nat)(F y m)->(lt n m)).
-
-Hypothesis F_compat : (x,y:A) (R x y) -> (inv_lt_rel x y).
-Remark acc_lt_rel :
- (x:A)(EX n | (F x n))->(Acc A R x).
-Intros x (n,fxn); Generalize x fxn; Clear x fxn.
-Pattern n; Apply lt_wf_ind; Intros.
-Constructor; Intros.
-Case (F_compat y x); Trivial; Intros.
-Apply (H x0); Auto.
-Save.
-
-Theorem well_founded_inv_lt_rel_compat : (well_founded A R).
-Constructor; Intros.
-Case (F_compat y a); Trivial; Intros.
-Apply acc_lt_rel; Trivial.
-Exists x; Trivial.
-Save.
+Definition inv_lt_rel x y :=
+ exists2 n : _ | F x n & (forall m, F y m -> n < m).
+
+Hypothesis F_compat : forall x y:A, R x y -> inv_lt_rel x y.
+Remark acc_lt_rel : forall x:A, ( exists n : _ | F x n) -> Acc R x.
+intros x [n fxn]; generalize x fxn; clear x fxn.
+pattern n in |- *; apply lt_wf_ind; intros.
+constructor; intros.
+case (F_compat y x); trivial; intros.
+apply (H x0); auto.
+Qed.
+
+Theorem well_founded_inv_lt_rel_compat : well_founded R.
+constructor; intros.
+case (F_compat y a); trivial; intros.
+apply acc_lt_rel; trivial.
+exists x; trivial.
+Qed.
End LT_WF_REL.
-Lemma well_founded_inv_rel_inv_lt_rel
- : (A:Set)(F:A->nat->Prop)(well_founded A (inv_lt_rel A F)).
-Intros; Apply (well_founded_inv_lt_rel_compat A (inv_lt_rel A F) F); Trivial.
-Save.
+Lemma well_founded_inv_rel_inv_lt_rel :
+ forall (A:Set) (F:A -> nat -> Prop), well_founded (inv_lt_rel A F).
+intros; apply (well_founded_inv_lt_rel_compat A (inv_lt_rel A F) F); trivial.
+Qed. \ No newline at end of file
diff --git a/theories/Bool/Bool.v b/theories/Bool/Bool.v
index 3d0a7a2f1..fa786550c 100755
--- a/theories/Bool/Bool.v
+++ b/theories/Bool/Bool.v
@@ -14,131 +14,130 @@
[Inductive bool : Set := true : bool | false : bool] *)
(** Interpretation of booleans as Proposition *)
-Definition Is_true := [b:bool](Cases b of
- true => True
- | false => False
- end).
-Hints Unfold Is_true : bool.
+Definition Is_true (b:bool) :=
+ match b with
+ | true => True
+ | false => False
+ end.
+Hint Unfold Is_true: bool.
-Lemma Is_true_eq_left : (x:bool)x=true -> (Is_true x).
+Lemma Is_true_eq_left : forall x:bool, x = true -> Is_true x.
Proof.
- Intros; Rewrite H; Auto with bool.
+ intros; rewrite H; auto with bool.
Qed.
-Lemma Is_true_eq_right : (x:bool)true=x -> (Is_true x).
+Lemma Is_true_eq_right : forall x:bool, true = x -> Is_true x.
Proof.
- Intros; Rewrite <- H; Auto with bool.
+ intros; rewrite <- H; auto with bool.
Qed.
-Hints Immediate Is_true_eq_right Is_true_eq_left : bool.
+Hint Immediate Is_true_eq_right Is_true_eq_left: bool.
(*******************)
(** Discrimination *)
(*******************)
-Lemma diff_true_false : ~true=false.
+Lemma diff_true_false : true <> false.
Proof.
-Unfold not; Intro contr; Change (Is_true false).
-Elim contr; Simpl; Trivial with bool.
+unfold not in |- *; intro contr; change (Is_true false) in |- *.
+elim contr; simpl in |- *; trivial with bool.
Qed.
-Hints Resolve diff_true_false : bool v62.
+Hint Resolve diff_true_false: bool v62.
-Lemma diff_false_true : ~false=true.
+Lemma diff_false_true : false <> true.
Proof.
-Red; Intros H; Apply diff_true_false.
-Symmetry.
-Assumption.
+red in |- *; intros H; apply diff_true_false.
+symmetry in |- *.
+assumption.
Qed.
-Hints Resolve diff_false_true : bool v62.
+Hint Resolve diff_false_true: bool v62.
-Lemma eq_true_false_abs : (b:bool)(b=true)->(b=false)->False.
-Intros b H; Rewrite H; Auto with bool.
+Lemma eq_true_false_abs : forall b:bool, b = true -> b = false -> False.
+intros b H; rewrite H; auto with bool.
Qed.
-Hints Resolve eq_true_false_abs : bool.
+Hint Resolve eq_true_false_abs: bool.
-Lemma not_true_is_false : (b:bool)~b=true->b=false.
-NewDestruct b.
-Intros.
-Red in H; Elim H.
-Reflexivity.
-Intros abs.
-Reflexivity.
+Lemma not_true_is_false : forall b:bool, b <> true -> b = false.
+destruct b.
+intros.
+red in H; elim H.
+reflexivity.
+intros abs.
+reflexivity.
Qed.
-Lemma not_false_is_true : (b:bool)~b=false->b=true.
-NewDestruct b.
-Intros.
-Reflexivity.
-Intro H; Red in H; Elim H.
-Reflexivity.
+Lemma not_false_is_true : forall b:bool, b <> false -> b = true.
+destruct b.
+intros.
+reflexivity.
+intro H; red in H; elim H.
+reflexivity.
Qed.
(**********************)
(** Order on booleans *)
(**********************)
-Definition leb := [b1,b2:bool]
- Cases b1 of
- | true => b2=true
- | false => True
+Definition leb (b1 b2:bool) :=
+ match b1 with
+ | true => b2 = true
+ | false => True
end.
-Hints Unfold leb : bool v62.
+Hint Unfold leb: bool v62.
(*************)
(** Equality *)
(*************)
-Definition eqb : bool->bool->bool :=
- [b1,b2:bool]
- Cases b1 b2 of
- true true => true
- | true false => false
- | false true => false
- | false false => true
- end.
+Definition eqb (b1 b2:bool) : bool :=
+ match b1, b2 with
+ | true, true => true
+ | true, false => false
+ | false, true => false
+ | false, false => true
+ end.
-Lemma eqb_refl : (x:bool)(Is_true (eqb x x)).
-NewDestruct x; Simpl; Auto with bool.
+Lemma eqb_refl : forall x:bool, Is_true (eqb x x).
+destruct x; simpl in |- *; auto with bool.
Qed.
-Lemma eqb_eq : (x,y:bool)(Is_true (eqb x y))->x=y.
-NewDestruct x; NewDestruct y; Simpl; Tauto.
+Lemma eqb_eq : forall x y:bool, Is_true (eqb x y) -> x = y.
+destruct x; destruct y; simpl in |- *; tauto.
Qed.
-Lemma Is_true_eq_true : (x:bool) (Is_true x) -> x=true.
-NewDestruct x; Simpl; Tauto.
+Lemma Is_true_eq_true : forall x:bool, Is_true x -> x = true.
+destruct x; simpl in |- *; tauto.
Qed.
-Lemma Is_true_eq_true2 : (x:bool) x=true -> (Is_true x).
-NewDestruct x; Simpl; Auto with bool.
+Lemma Is_true_eq_true2 : forall x:bool, x = true -> Is_true x.
+destruct x; simpl in |- *; auto with bool.
Qed.
-Lemma eqb_subst :
- (P:bool->Prop)(b1,b2:bool)(eqb b1 b2)=true->(P b1)->(P b2).
-Unfold eqb .
-Intros P b1.
-Intros b2.
-Case b1.
-Case b2.
-Trivial with bool.
-Intros H.
-Inversion_clear H.
-Case b2.
-Intros H.
-Inversion_clear H.
-Trivial with bool.
+Lemma eqb_subst :
+ forall (P:bool -> Prop) (b1 b2:bool), eqb b1 b2 = true -> P b1 -> P b2.
+unfold eqb in |- *.
+intros P b1.
+intros b2.
+case b1.
+case b2.
+trivial with bool.
+intros H.
+inversion_clear H.
+case b2.
+intros H.
+inversion_clear H.
+trivial with bool.
Qed.
-Lemma eqb_reflx : (b:bool)(eqb b b)=true.
-Intro b.
-Case b.
-Trivial with bool.
-Trivial with bool.
+Lemma eqb_reflx : forall b:bool, eqb b b = true.
+intro b.
+case b.
+trivial with bool.
+trivial with bool.
Qed.
-Lemma eqb_prop : (a,b:bool)(eqb a b)=true -> a=b.
-NewDestruct a; NewDestruct b; Simpl; Intro;
- Discriminate H Orelse Reflexivity.
+Lemma eqb_prop : forall a b:bool, eqb a b = true -> a = b.
+destruct a; destruct b; simpl in |- *; intro; discriminate H || reflexivity.
Qed.
@@ -146,36 +145,34 @@ Qed.
(** Logical combinators *)
(************************)
-Definition ifb : bool -> bool -> bool -> bool
- := [b1,b2,b3:bool](Cases b1 of true => b2 | false => b3 end).
+Definition ifb (b1 b2 b3:bool) : bool :=
+ match b1 with
+ | true => b2
+ | false => b3
+ end.
-Definition andb : bool -> bool -> bool
- := [b1,b2:bool](ifb b1 b2 false).
+Definition andb (b1 b2:bool) : bool := ifb b1 b2 false.
-Definition orb : bool -> bool -> bool
- := [b1,b2:bool](ifb b1 true b2).
+Definition orb (b1 b2:bool) : bool := ifb b1 true b2.
-Definition implb : bool -> bool -> bool
- := [b1,b2:bool](ifb b1 b2 true).
+Definition implb (b1 b2:bool) : bool := ifb b1 b2 true.
-Definition xorb : bool -> bool -> bool
- := [b1,b2:bool]
- Cases b1 b2 of
- true true => false
- | true false => true
- | false true => true
- | false false => false
- end.
+Definition xorb (b1 b2:bool) : bool :=
+ match b1, b2 with
+ | true, true => false
+ | true, false => true
+ | false, true => true
+ | false, false => false
+ end.
-Definition negb := [b:bool]Cases b of
- true => false
- | false => true
- end.
+Definition negb (b:bool) := match b with
+ | true => false
+ | false => true
+ end.
-Infix "||" orb (at level 4, left associativity) : bool_scope.
-Infix "&&" andb (at level 3, no associativity) : bool_scope
- V8only (at level 40, left associativity).
-V8Notation "- b" := (negb b) : bool_scope.
+Infix "||" := orb (at level 50, left associativity) : bool_scope.
+Infix "&&" := andb (at level 40, left associativity) : bool_scope.
+Notation "- b" := (negb b) : bool_scope.
Open Local Scope bool_scope.
@@ -183,54 +180,55 @@ Open Local Scope bool_scope.
(** Lemmas about [negb] *)
(**************************)
-Lemma negb_intro : (b:bool)b=(negb (negb b)).
+Lemma negb_intro : forall b:bool, b = - - b.
Proof.
-NewDestruct b; Reflexivity.
+destruct b; reflexivity.
Qed.
-Lemma negb_elim : (b:bool)(negb (negb b))=b.
+Lemma negb_elim : forall b:bool, - - b = b.
Proof.
-NewDestruct b; Reflexivity.
+destruct b; reflexivity.
Qed.
-Lemma negb_orb : (b1,b2:bool)
- (negb (orb b1 b2)) = (andb (negb b1) (negb b2)).
+Lemma negb_orb : forall b1 b2:bool, - (b1 || b2) = - b1 && - b2.
Proof.
- NewDestruct b1; NewDestruct b2; Simpl; Reflexivity.
+ destruct b1; destruct b2; simpl in |- *; reflexivity.
Qed.
-Lemma negb_andb : (b1,b2:bool)
- (negb (andb b1 b2)) = (orb (negb b1) (negb b2)).
+Lemma negb_andb : forall b1 b2:bool, - (b1 && b2) = - b1 || - b2.
Proof.
- NewDestruct b1; NewDestruct b2; Simpl; Reflexivity.
+ destruct b1; destruct b2; simpl in |- *; reflexivity.
Qed.
-Lemma negb_sym : (b,b':bool)(b'=(negb b))->(b=(negb b')).
+Lemma negb_sym : forall b b':bool, b' = - b -> b = - b'.
Proof.
-NewDestruct b; NewDestruct b'; Intros; Simpl; Trivial with bool.
+destruct b; destruct b'; intros; simpl in |- *; trivial with bool.
Qed.
-Lemma no_fixpoint_negb : (b:bool)~(negb b)=b.
+Lemma no_fixpoint_negb : forall b:bool, - b <> b.
Proof.
-NewDestruct b; Simpl; Unfold not; Intro; Apply diff_true_false; Auto with bool.
+destruct b; simpl in |- *; unfold not in |- *; intro; apply diff_true_false;
+ auto with bool.
Qed.
-Lemma eqb_negb1 : (b:bool)(eqb (negb b) b)=false.
-NewDestruct b.
-Trivial with bool.
-Trivial with bool.
+Lemma eqb_negb1 : forall b:bool, eqb (- b) b = false.
+destruct b.
+trivial with bool.
+trivial with bool.
Qed.
-Lemma eqb_negb2 : (b:bool)(eqb b (negb b))=false.
-NewDestruct b.
-Trivial with bool.
-Trivial with bool.
+Lemma eqb_negb2 : forall b:bool, eqb b (- b) = false.
+destruct b.
+trivial with bool.
+trivial with bool.
Qed.
-Lemma if_negb : (A:Set) (b:bool) (x,y:A) (if (negb b) then x else y)=(if b then y else x).
+Lemma if_negb :
+ forall (A:Set) (b:bool) (x y:A),
+ (if - b then x else y) = (if b then y else x).
Proof.
- NewDestruct b;Trivial.
+ destruct b; trivial.
Qed.
@@ -238,304 +236,305 @@ Qed.
(** A few lemmas about [or] *)
(****************************)
-Lemma orb_prop :
- (a,b:bool)(orb a b)=true -> (a = true)\/(b = true).
-NewDestruct a; NewDestruct b; Simpl; Try (Intro H;Discriminate H); Auto with bool.
+Lemma orb_prop : forall a b:bool, a || b = true -> a = true \/ b = true.
+destruct a; destruct b; simpl in |- *; try (intro H; discriminate H);
+ auto with bool.
Qed.
-Lemma orb_prop2 :
- (a,b:bool)(Is_true (orb a b)) -> (Is_true a)\/(Is_true b).
-NewDestruct a; NewDestruct b; Simpl; Try (Intro H;Discriminate H); Auto with bool.
+Lemma orb_prop2 : forall a b:bool, Is_true (a || b) -> Is_true a \/ Is_true b.
+destruct a; destruct b; simpl in |- *; try (intro H; discriminate H);
+ auto with bool.
Qed.
-Lemma orb_true_intro
- : (b1,b2:bool)(b1=true)\/(b2=true)->(orb b1 b2)=true.
-NewDestruct b1; Auto with bool.
-NewDestruct 1; Intros.
-Elim diff_true_false; Auto with bool.
-Rewrite H; Trivial with bool.
+Lemma orb_true_intro :
+ forall b1 b2:bool, b1 = true \/ b2 = true -> b1 || b2 = true.
+destruct b1; auto with bool.
+destruct 1; intros.
+elim diff_true_false; auto with bool.
+rewrite H; trivial with bool.
Qed.
-Hints Resolve orb_true_intro : bool v62.
+Hint Resolve orb_true_intro: bool v62.
-Lemma orb_b_true : (b:bool)(orb b true)=true.
-Auto with bool.
+Lemma orb_b_true : forall b:bool, b || true = true.
+auto with bool.
Qed.
-Hints Resolve orb_b_true : bool v62.
+Hint Resolve orb_b_true: bool v62.
-Lemma orb_true_b : (b:bool)(orb true b)=true.
-Trivial with bool.
+Lemma orb_true_b : forall b:bool, true || b = true.
+trivial with bool.
Qed.
-Definition orb_true_elim : (b1,b2:bool)(orb b1 b2)=true -> {b1=true}+{b2=true}.
-NewDestruct b1; Simpl; Auto with bool.
+Definition orb_true_elim :
+ forall b1 b2:bool, b1 || b2 = true -> {b1 = true} + {b2 = true}.
+destruct b1; simpl in |- *; auto with bool.
Defined.
-Lemma orb_false_intro
- : (b1,b2:bool)(b1=false)->(b2=false)->(orb b1 b2)=false.
-Intros b1 b2 H1 H2; Rewrite H1; Rewrite H2; Trivial with bool.
+Lemma orb_false_intro :
+ forall b1 b2:bool, b1 = false -> b2 = false -> b1 || b2 = false.
+intros b1 b2 H1 H2; rewrite H1; rewrite H2; trivial with bool.
Qed.
-Hints Resolve orb_false_intro : bool v62.
+Hint Resolve orb_false_intro: bool v62.
-Lemma orb_b_false : (b:bool)(orb b false)=b.
+Lemma orb_b_false : forall b:bool, b || false = b.
Proof.
- NewDestruct b; Trivial with bool.
+ destruct b; trivial with bool.
Qed.
-Hints Resolve orb_b_false : bool v62.
+Hint Resolve orb_b_false: bool v62.
-Lemma orb_false_b : (b:bool)(orb false b)=b.
+Lemma orb_false_b : forall b:bool, false || b = b.
Proof.
- NewDestruct b; Trivial with bool.
+ destruct b; trivial with bool.
Qed.
-Hints Resolve orb_false_b : bool v62.
+Hint Resolve orb_false_b: bool v62.
-Lemma orb_false_elim :
- (b1,b2:bool)(orb b1 b2)=false -> (b1=false)/\(b2=false).
+Lemma orb_false_elim :
+ forall b1 b2:bool, b1 || b2 = false -> b1 = false /\ b2 = false.
Proof.
- NewDestruct b1.
- Intros; Elim diff_true_false; Auto with bool.
- NewDestruct b2.
- Intros; Elim diff_true_false; Auto with bool.
- Auto with bool.
+ destruct b1.
+ intros; elim diff_true_false; auto with bool.
+ destruct b2.
+ intros; elim diff_true_false; auto with bool.
+ auto with bool.
Qed.
-Lemma orb_neg_b :
- (b:bool)(orb b (negb b))=true.
+Lemma orb_neg_b : forall b:bool, b || - b = true.
Proof.
- NewDestruct b; Reflexivity.
+ destruct b; reflexivity.
Qed.
-Hints Resolve orb_neg_b : bool v62.
+Hint Resolve orb_neg_b: bool v62.
-Lemma orb_sym : (b1,b2:bool)(orb b1 b2)=(orb b2 b1).
-NewDestruct b1; NewDestruct b2; Reflexivity.
+Lemma orb_comm : forall b1 b2:bool, b1 || b2 = b2 || b1.
+destruct b1; destruct b2; reflexivity.
Qed.
-Lemma orb_assoc : (b1,b2,b3:bool)(orb b1 (orb b2 b3))=(orb (orb b1 b2) b3).
+Lemma orb_assoc : forall b1 b2 b3:bool, b1 || (b2 || b3) = b1 || b2 || b3.
Proof.
- NewDestruct b1; NewDestruct b2; NewDestruct b3; Reflexivity.
+ destruct b1; destruct b2; destruct b3; reflexivity.
Qed.
-Hints Resolve orb_sym orb_assoc orb_b_false orb_false_b : bool v62.
+Hint Resolve orb_comm orb_assoc orb_b_false orb_false_b: bool v62.
(*****************************)
(** A few lemmas about [and] *)
(*****************************)
-Lemma andb_prop :
- (a,b:bool)(andb a b) = true -> (a = true)/\(b = true).
+Lemma andb_prop : forall a b:bool, a && b = true -> a = true /\ b = true.
Proof.
- NewDestruct a; NewDestruct b; Simpl; Try (Intro H;Discriminate H);
- Auto with bool.
+ destruct a; destruct b; simpl in |- *; try (intro H; discriminate H);
+ auto with bool.
Qed.
-Hints Resolve andb_prop : bool v62.
+Hint Resolve andb_prop: bool v62.
-Definition andb_true_eq : (a,b:bool) true = (andb a b) -> true = a /\ true = b.
+Definition andb_true_eq :
+ forall a b:bool, true = a && b -> true = a /\ true = b.
Proof.
- NewDestruct a; NewDestruct b; Auto.
+ destruct a; destruct b; auto.
Defined.
-Lemma andb_prop2 :
- (a,b:bool)(Is_true (andb a b)) -> (Is_true a)/\(Is_true b).
+Lemma andb_prop2 :
+ forall a b:bool, Is_true (a && b) -> Is_true a /\ Is_true b.
Proof.
- NewDestruct a; NewDestruct b; Simpl; Try (Intro H;Discriminate H);
- Auto with bool.
+ destruct a; destruct b; simpl in |- *; try (intro H; discriminate H);
+ auto with bool.
Qed.
-Hints Resolve andb_prop2 : bool v62.
+Hint Resolve andb_prop2: bool v62.
-Lemma andb_true_intro : (b1,b2:bool)(b1=true)/\(b2=true)->(andb b1 b2)=true.
+Lemma andb_true_intro :
+ forall b1 b2:bool, b1 = true /\ b2 = true -> b1 && b2 = true.
Proof.
- NewDestruct b1; NewDestruct b2; Simpl; Tauto Orelse Auto with bool.
+ destruct b1; destruct b2; simpl in |- *; tauto || auto with bool.
Qed.
-Hints Resolve andb_true_intro : bool v62.
+Hint Resolve andb_true_intro: bool v62.
-Lemma andb_true_intro2 :
- (b1,b2:bool)(Is_true b1)->(Is_true b2)->(Is_true (andb b1 b2)).
+Lemma andb_true_intro2 :
+ forall b1 b2:bool, Is_true b1 -> Is_true b2 -> Is_true (b1 && b2).
Proof.
- NewDestruct b1; NewDestruct b2; Simpl; Tauto.
+ destruct b1; destruct b2; simpl in |- *; tauto.
Qed.
-Hints Resolve andb_true_intro2 : bool v62.
+Hint Resolve andb_true_intro2: bool v62.
-Lemma andb_false_intro1
- : (b1,b2:bool)(b1=false)->(andb b1 b2)=false.
-NewDestruct b1; NewDestruct b2; Simpl; Tauto Orelse Auto with bool.
+Lemma andb_false_intro1 : forall b1 b2:bool, b1 = false -> b1 && b2 = false.
+destruct b1; destruct b2; simpl in |- *; tauto || auto with bool.
Qed.
-Lemma andb_false_intro2
- : (b1,b2:bool)(b2=false)->(andb b1 b2)=false.
-NewDestruct b1; NewDestruct b2; Simpl; Tauto Orelse Auto with bool.
+Lemma andb_false_intro2 : forall b1 b2:bool, b2 = false -> b1 && b2 = false.
+destruct b1; destruct b2; simpl in |- *; tauto || auto with bool.
Qed.
-Lemma andb_b_false : (b:bool)(andb b false)=false.
-NewDestruct b; Auto with bool.
+Lemma andb_b_false : forall b:bool, b && false = false.
+destruct b; auto with bool.
Qed.
-Lemma andb_false_b : (b:bool)(andb false b)=false.
-Trivial with bool.
+Lemma andb_false_b : forall b:bool, false && b = false.
+trivial with bool.
Qed.
-Lemma andb_b_true : (b:bool)(andb b true)=b.
-NewDestruct b; Auto with bool.
+Lemma andb_b_true : forall b:bool, b && true = b.
+destruct b; auto with bool.
Qed.
-Lemma andb_true_b : (b:bool)(andb true b)=b.
-Trivial with bool.
+Lemma andb_true_b : forall b:bool, true && b = b.
+trivial with bool.
Qed.
-Definition andb_false_elim :
- (b1,b2:bool)(andb b1 b2)=false -> {b1=false}+{b2=false}.
-NewDestruct b1; Simpl; Auto with bool.
+Definition andb_false_elim :
+ forall b1 b2:bool, b1 && b2 = false -> {b1 = false} + {b2 = false}.
+destruct b1; simpl in |- *; auto with bool.
Defined.
-Hints Resolve andb_false_elim : bool v62.
+Hint Resolve andb_false_elim: bool v62.
-Lemma andb_neg_b :
- (b:bool)(andb b (negb b))=false.
-NewDestruct b; Reflexivity.
+Lemma andb_neg_b : forall b:bool, b && - b = false.
+destruct b; reflexivity.
Qed.
-Hints Resolve andb_neg_b : bool v62.
+Hint Resolve andb_neg_b: bool v62.
-Lemma andb_sym : (b1,b2:bool)(andb b1 b2)=(andb b2 b1).
-NewDestruct b1; NewDestruct b2; Reflexivity.
+Lemma andb_comm : forall b1 b2:bool, b1 && b2 = b2 && b1.
+destruct b1; destruct b2; reflexivity.
Qed.
-Lemma andb_assoc : (b1,b2,b3:bool)(andb b1 (andb b2 b3))=(andb (andb b1 b2) b3).
-NewDestruct b1; NewDestruct b2; NewDestruct b3; Reflexivity.
+Lemma andb_assoc : forall b1 b2 b3:bool, b1 && (b2 && b3) = b1 && b2 && b3.
+destruct b1; destruct b2; destruct b3; reflexivity.
Qed.
-Hints Resolve andb_sym andb_assoc : bool v62.
+Hint Resolve andb_comm andb_assoc: bool v62.
(*******************************)
(** Properties of [xorb] *)
(*******************************)
-Lemma xorb_false : (b:bool) (xorb b false)=b.
+Lemma xorb_false : forall b:bool, xorb b false = b.
Proof.
- NewDestruct b; Trivial.
+ destruct b; trivial.
Qed.
-Lemma false_xorb : (b:bool) (xorb false b)=b.
+Lemma false_xorb : forall b:bool, xorb false b = b.
Proof.
- NewDestruct b; Trivial.
+ destruct b; trivial.
Qed.
-Lemma xorb_true : (b:bool) (xorb b true)=(negb b).
+Lemma xorb_true : forall b:bool, xorb b true = - b.
Proof.
- Trivial.
+ trivial.
Qed.
-Lemma true_xorb : (b:bool) (xorb true b)=(negb b).
+Lemma true_xorb : forall b:bool, xorb true b = - b.
Proof.
- NewDestruct b; Trivial.
+ destruct b; trivial.
Qed.
-Lemma xorb_nilpotent : (b:bool) (xorb b b)=false.
+Lemma xorb_nilpotent : forall b:bool, xorb b b = false.
Proof.
- NewDestruct b; Trivial.
+ destruct b; trivial.
Qed.
-Lemma xorb_comm : (b,b':bool) (xorb b b')=(xorb b' b).
+Lemma xorb_comm : forall b b':bool, xorb b b' = xorb b' b.
Proof.
- NewDestruct b; NewDestruct b'; Trivial.
+ destruct b; destruct b'; trivial.
Qed.
-Lemma xorb_assoc : (b,b',b'':bool) (xorb (xorb b b') b'')=(xorb b (xorb b' b'')).
+Lemma xorb_assoc :
+ forall b b' b'':bool, xorb (xorb b b') b'' = xorb b (xorb b' b'').
Proof.
- NewDestruct b; NewDestruct b'; NewDestruct b''; Trivial.
+ destruct b; destruct b'; destruct b''; trivial.
Qed.
-Lemma xorb_eq : (b,b':bool) (xorb b b')=false -> b=b'.
+Lemma xorb_eq : forall b b':bool, xorb b b' = false -> b = b'.
Proof.
- NewDestruct b; NewDestruct b'; Trivial.
- Unfold xorb. Intros. Rewrite H. Reflexivity.
+ destruct b; destruct b'; trivial.
+ unfold xorb in |- *. intros. rewrite H. reflexivity.
Qed.
-Lemma xorb_move_l_r_1 : (b,b',b'':bool) (xorb b b')=b'' -> b'=(xorb b b'').
+Lemma xorb_move_l_r_1 :
+ forall b b' b'':bool, xorb b b' = b'' -> b' = xorb b b''.
Proof.
- Intros. Rewrite <- (false_xorb b'). Rewrite <- (xorb_nilpotent b). Rewrite xorb_assoc.
- Rewrite H. Reflexivity.
+ intros. rewrite <- (false_xorb b'). rewrite <- (xorb_nilpotent b). rewrite xorb_assoc.
+ rewrite H. reflexivity.
Qed.
-Lemma xorb_move_l_r_2 : (b,b',b'':bool) (xorb b b')=b'' -> b=(xorb b'' b').
+Lemma xorb_move_l_r_2 :
+ forall b b' b'':bool, xorb b b' = b'' -> b = xorb b'' b'.
Proof.
- Intros. Rewrite xorb_comm in H. Rewrite (xorb_move_l_r_1 b' b b'' H). Apply xorb_comm.
+ intros. rewrite xorb_comm in H. rewrite (xorb_move_l_r_1 b' b b'' H). apply xorb_comm.
Qed.
-Lemma xorb_move_r_l_1 : (b,b',b'':bool) b=(xorb b' b'') -> (xorb b' b)=b''.
+Lemma xorb_move_r_l_1 :
+ forall b b' b'':bool, b = xorb b' b'' -> xorb b' b = b''.
Proof.
- Intros. Rewrite H. Rewrite <- xorb_assoc. Rewrite xorb_nilpotent. Apply false_xorb.
+ intros. rewrite H. rewrite <- xorb_assoc. rewrite xorb_nilpotent. apply false_xorb.
Qed.
-Lemma xorb_move_r_l_2 : (b,b',b'':bool) b=(xorb b' b'') -> (xorb b b'')=b'.
+Lemma xorb_move_r_l_2 :
+ forall b b' b'':bool, b = xorb b' b'' -> xorb b b'' = b'.
Proof.
- Intros. Rewrite H. Rewrite xorb_assoc. Rewrite xorb_nilpotent. Apply xorb_false.
+ intros. rewrite H. rewrite xorb_assoc. rewrite xorb_nilpotent. apply xorb_false.
Qed.
(*******************************)
(** De Morgan's law *)
(*******************************)
-Lemma demorgan1 : (b1,b2,b3:bool)
- (andb b1 (orb b2 b3)) = (orb (andb b1 b2) (andb b1 b3)).
-NewDestruct b1; NewDestruct b2; NewDestruct b3; Reflexivity.
+Lemma demorgan1 :
+ forall b1 b2 b3:bool, b1 && (b2 || b3) = b1 && b2 || b1 && b3.
+destruct b1; destruct b2; destruct b3; reflexivity.
Qed.
-Lemma demorgan2 : (b1,b2,b3:bool)
- (andb (orb b1 b2) b3) = (orb (andb b1 b3) (andb b2 b3)).
-NewDestruct b1; NewDestruct b2; NewDestruct b3; Reflexivity.
+Lemma demorgan2 :
+ forall b1 b2 b3:bool, (b1 || b2) && b3 = b1 && b3 || b2 && b3.
+destruct b1; destruct b2; destruct b3; reflexivity.
Qed.
-Lemma demorgan3 : (b1,b2,b3:bool)
- (orb b1 (andb b2 b3)) = (andb (orb b1 b2) (orb b1 b3)).
-NewDestruct b1; NewDestruct b2; NewDestruct b3; Reflexivity.
+Lemma demorgan3 :
+ forall b1 b2 b3:bool, b1 || b2 && b3 = (b1 || b2) && (b1 || b3).
+destruct b1; destruct b2; destruct b3; reflexivity.
Qed.
-Lemma demorgan4 : (b1,b2,b3:bool)
- (orb (andb b1 b2) b3) = (andb (orb b1 b3) (orb b2 b3)).
-NewDestruct b1; NewDestruct b2; NewDestruct b3; Reflexivity.
+Lemma demorgan4 :
+ forall b1 b2 b3:bool, b1 && b2 || b3 = (b1 || b3) && (b2 || b3).
+destruct b1; destruct b2; destruct b3; reflexivity.
Qed.
-Lemma absoption_andb : (b1,b2:bool)
- (andb b1 (orb b1 b2)) = b1.
+Lemma absoption_andb : forall b1 b2:bool, b1 && (b1 || b2) = b1.
Proof.
- NewDestruct b1; NewDestruct b2; Simpl; Reflexivity.
+ destruct b1; destruct b2; simpl in |- *; reflexivity.
Qed.
-Lemma absoption_orb : (b1,b2:bool)
- (orb b1 (andb b1 b2)) = b1.
+Lemma absoption_orb : forall b1 b2:bool, b1 || b1 && b2 = b1.
Proof.
- NewDestruct b1; NewDestruct b2; Simpl; Reflexivity.
+ destruct b1; destruct b2; simpl in |- *; reflexivity.
Qed.
(** Misc. equalities between booleans (to be used by Auto) *)
-Lemma bool_1 : (b1,b2:bool)(b1=true <-> b2=true) -> b1=b2.
+Lemma bool_1 : forall b1 b2:bool, (b1 = true <-> b2 = true) -> b1 = b2.
Proof.
- Intros b1 b2; Case b1; Case b2; Intuition.
+ intros b1 b2; case b1; case b2; intuition.
Qed.
-Lemma bool_2 : (b1,b2:bool)b1=b2 -> b1=true -> b2=true.
+Lemma bool_2 : forall b1 b2:bool, b1 = b2 -> b1 = true -> b2 = true.
Proof.
- Intros b1 b2; Case b1; Case b2; Intuition.
+ intros b1 b2; case b1; case b2; intuition.
Qed.
-Lemma bool_3 : (b:bool) ~(negb b)=true -> b=true.
+Lemma bool_3 : forall b:bool, - b <> true -> b = true.
Proof.
- NewDestruct b; Intuition.
+ destruct b; intuition.
Qed.
-Lemma bool_4 : (b:bool) b=true -> ~(negb b)=true.
+Lemma bool_4 : forall b:bool, b = true -> - b <> true.
Proof.
- NewDestruct b; Intuition.
+ destruct b; intuition.
Qed.
-Lemma bool_5 : (b:bool) (negb b)=true -> ~b=true.
+Lemma bool_5 : forall b:bool, - b = true -> b <> true.
Proof.
- NewDestruct b; Intuition.
+ destruct b; intuition.
Qed.
-Lemma bool_6 : (b:bool) ~b=true -> (negb b)=true.
+Lemma bool_6 : forall b:bool, b <> true -> - b = true.
Proof.
- NewDestruct b; Intuition.
+ destruct b; intuition.
Qed.
-Hints Resolve bool_1 bool_2 bool_3 bool_4 bool_5 bool_6.
+Hint Resolve bool_1 bool_2 bool_3 bool_4 bool_5 bool_6. \ No newline at end of file
diff --git a/theories/Bool/BoolEq.v b/theories/Bool/BoolEq.v
index 61204ba30..ef48e6272 100644
--- a/theories/Bool/BoolEq.v
+++ b/theories/Bool/BoolEq.v
@@ -20,53 +20,54 @@ Section Bool_eq_dec.
Variable beq : A -> A -> bool.
- Variable beq_refl : (x:A)true=(beq x x).
+ Variable beq_refl : forall x:A, true = beq x x.
- Variable beq_eq : (x,y:A)true=(beq x y)->x=y.
+ Variable beq_eq : forall x y:A, true = beq x y -> x = y.
- Definition beq_eq_true : (x,y:A)x=y->true=(beq x y).
+ Definition beq_eq_true : forall x y:A, x = y -> true = beq x y.
Proof.
- Intros x y H.
- Case H.
- Apply beq_refl.
+ intros x y H.
+ case H.
+ apply beq_refl.
Defined.
- Definition beq_eq_not_false : (x,y:A)x=y->~false=(beq x y).
+ Definition beq_eq_not_false : forall x y:A, x = y -> false <> beq x y.
Proof.
- Intros x y e.
- Rewrite <- beq_eq_true; Trivial; Discriminate.
+ intros x y e.
+ rewrite <- beq_eq_true; trivial; discriminate.
Defined.
- Definition beq_false_not_eq : (x,y:A)false=(beq x y)->~x=y.
+ Definition beq_false_not_eq : forall x y:A, false = beq x y -> x <> y.
Proof.
- Exact [x,y:A; H:(false=(beq x y)); e:(x=y)](beq_eq_not_false x y e H).
+ exact
+ (fun (x y:A) (H:false = beq x y) (e:x = y) => beq_eq_not_false x y e H).
Defined.
- Definition exists_beq_eq : (x,y:A){b:bool | b=(beq x y)}.
+ Definition exists_beq_eq : forall x y:A, {b : bool | b = beq x y}.
Proof.
- Intros.
- Exists (beq x y).
- Constructor.
+ intros.
+ exists (beq x y).
+ constructor.
Defined.
- Definition not_eq_false_beq : (x,y:A)~x=y->false=(beq x y).
+ Definition not_eq_false_beq : forall x y:A, x <> y -> false = beq x y.
Proof.
- Intros x y H.
- Symmetry.
- Apply not_true_is_false.
- Intro.
- Apply H.
- Apply beq_eq.
- Symmetry.
- Assumption.
+ intros x y H.
+ symmetry in |- *.
+ apply not_true_is_false.
+ intro.
+ apply H.
+ apply beq_eq.
+ symmetry in |- *.
+ assumption.
Defined.
- Definition eq_dec : (x,y:A){x=y}+{~x=y}.
+ Definition eq_dec : forall x y:A, {x = y} + {x <> y}.
Proof.
- Intros x y; Case (exists_beq_eq x y).
- Intros b; Case b; Intro H.
- Left; Apply beq_eq; Assumption.
- Right; Apply beq_false_not_eq; Assumption.
+ intros x y; case (exists_beq_eq x y).
+ intros b; case b; intro H.
+ left; apply beq_eq; assumption.
+ right; apply beq_false_not_eq; assumption.
Defined.
-End Bool_eq_dec.
+End Bool_eq_dec. \ No newline at end of file
diff --git a/theories/Bool/Bvector.v b/theories/Bool/Bvector.v
index 792d6a067..86b59db26 100644
--- a/theories/Bool/Bvector.v
+++ b/theories/Bool/Bvector.v
@@ -12,9 +12,8 @@
Require Export Bool.
Require Export Sumbool.
-Require Arith.
+Require Import Arith.
-V7only [Import nat_scope.].
Open Local Scope nat_scope.
(*
@@ -82,64 +81,64 @@ de taille n dans les vecteurs de taille n en appliquant f terme à terme.
Variable A : Set.
-Inductive vector: nat -> Set :=
- | Vnil : (vector O)
- | Vcons : (a:A) (n:nat) (vector n) -> (vector (S n)).
+Inductive vector : nat -> Set :=
+ | Vnil : vector 0
+ | Vcons : forall (a:A) (n:nat), vector n -> vector (S n).
-Definition Vhead : (n:nat) (vector (S n)) -> A.
+Definition Vhead : forall n:nat, vector (S n) -> A.
Proof.
- Intros n v; Inversion v; Exact a.
+ intros n v; inversion v; exact a.
Defined.
-Definition Vtail : (n:nat) (vector (S n)) -> (vector n).
+Definition Vtail : forall n:nat, vector (S n) -> vector n.
Proof.
- Intros n v; Inversion v; Exact H0.
+ intros n v; inversion v; exact H0.
Defined.
-Definition Vlast : (n:nat) (vector (S n)) -> A.
+Definition Vlast : forall n:nat, vector (S n) -> A.
Proof.
- NewInduction n as [|n f]; Intro v.
- Inversion v.
- Exact a.
+ induction n as [| n f]; intro v.
+ inversion v.
+ exact a.
- Inversion v.
- Exact (f H0).
+ inversion v.
+ exact (f H0).
Defined.
-Definition Vconst : (a:A) (n:nat) (vector n).
+Definition Vconst : forall (a:A) (n:nat), vector n.
Proof.
- NewInduction n as [|n v].
- Exact Vnil.
+ induction n as [| n v].
+ exact Vnil.
- Exact (Vcons a n v).
+ exact (Vcons a n v).
Defined.
-Lemma Vshiftout : (n:nat) (vector (S n)) -> (vector n).
+Lemma Vshiftout : forall n:nat, vector (S n) -> vector n.
Proof.
- NewInduction n as [|n f]; Intro v.
- Exact Vnil.
+ induction n as [| n f]; intro v.
+ exact Vnil.
- Inversion v.
- Exact (Vcons a n (f H0)).
+ inversion v.
+ exact (Vcons a n (f H0)).
Defined.
-Lemma Vshiftin : (n:nat) A -> (vector n) -> (vector (S n)).
+Lemma Vshiftin : forall n:nat, A -> vector n -> vector (S n).
Proof.
- NewInduction n as [|n f]; Intros a v.
- Exact (Vcons a O v).
+ induction n as [| n f]; intros a v.
+ exact (Vcons a 0 v).
- Inversion v.
- Exact (Vcons a (S n) (f a H0)).
+ inversion v.
+ exact (Vcons a (S n) (f a H0)).
Defined.
-Lemma Vshiftrepeat : (n:nat) (vector (S n)) -> (vector (S (S n))).
+Lemma Vshiftrepeat : forall n:nat, vector (S n) -> vector (S (S n)).
Proof.
- NewInduction n as [|n f]; Intro v.
- Inversion v.
- Exact (Vcons a (1) v).
+ induction n as [| n f]; intro v.
+ inversion v.
+ exact (Vcons a 1 v).
- Inversion v.
- Exact (Vcons a (S (S n)) (f H0)).
+ inversion v.
+ exact (Vcons a (S (S n)) (f H0)).
Defined.
(*
@@ -149,50 +148,50 @@ Proof.
Save.
*)
-Lemma Vtrunc : (n,p:nat) (gt n p) -> (vector n) -> (vector (minus n p)).
+Lemma Vtrunc : forall n p:nat, n > p -> vector n -> vector (n - p).
Proof.
- NewInduction p as [|p f]; Intros H v.
- Rewrite <- minus_n_O.
- Exact v.
+ induction p as [| p f]; intros H v.
+ rewrite <- minus_n_O.
+ exact v.
- Apply (Vshiftout (minus n (S p))).
+ apply (Vshiftout (n - S p)).
-Rewrite minus_Sn_m.
-Apply f.
-Auto with *.
-Exact v.
-Auto with *.
+rewrite minus_Sn_m.
+apply f.
+auto with *.
+exact v.
+auto with *.
Defined.
-Lemma Vextend : (n,p:nat) (vector n) -> (vector p) -> (vector (plus n p)).
+Lemma Vextend : forall n p:nat, vector n -> vector p -> vector (n + p).
Proof.
- NewInduction n as [|n f]; Intros p v v0.
- Simpl; Exact v0.
+ induction n as [| n f]; intros p v v0.
+ simpl in |- *; exact v0.
- Inversion v.
- Simpl; Exact (Vcons a (plus n p) (f p H0 v0)).
+ inversion v.
+ simpl in |- *; exact (Vcons a (n + p) (f p H0 v0)).
Defined.
Variable f : A -> A.
-Lemma Vunary : (n:nat)(vector n)->(vector n).
+Lemma Vunary : forall n:nat, vector n -> vector n.
Proof.
- NewInduction n as [|n g]; Intro v.
- Exact Vnil.
+ induction n as [| n g]; intro v.
+ exact Vnil.
- Inversion v.
- Exact (Vcons (f a) n (g H0)).
+ inversion v.
+ exact (Vcons (f a) n (g H0)).
Defined.
Variable g : A -> A -> A.
-Lemma Vbinary : (n:nat)(vector n)->(vector n)->(vector n).
+Lemma Vbinary : forall n:nat, vector n -> vector n -> vector n.
Proof.
- NewInduction n as [|n h]; Intros v v0.
- Exact Vnil.
+ induction n as [| n h]; intros v v0.
+ exact Vnil.
- Inversion v; Inversion v0.
- Exact (Vcons (g a a0) n (h H0 H2)).
+ inversion v; inversion v0.
+ exact (Vcons (g a a0) n (h H0 H2)).
Defined.
End VECTORS.
@@ -211,56 +210,58 @@ ATTENTION : Tous les décalages prennent la taille moins un comme paramètre
(ils ne travaillent que sur des vecteurs au moins de longueur un).
*)
-Definition Bvector := (vector bool).
+Definition Bvector := vector bool.
-Definition Bnil := (Vnil bool).
+Definition Bnil := Vnil bool.
-Definition Bcons := (Vcons bool).
+Definition Bcons := Vcons bool.
-Definition Bvect_true := (Vconst bool true).
+Definition Bvect_true := Vconst bool true.
-Definition Bvect_false := (Vconst bool false).
+Definition Bvect_false := Vconst bool false.
-Definition Blow := (Vhead bool).
+Definition Blow := Vhead bool.
-Definition Bhigh := (Vtail bool).
+Definition Bhigh := Vtail bool.
-Definition Bsign := (Vlast bool).
+Definition Bsign := Vlast bool.
-Definition Bneg := (Vunary bool negb).
+Definition Bneg := Vunary bool negb.
-Definition BVand := (Vbinary bool andb).
+Definition BVand := Vbinary bool andb.
-Definition BVor := (Vbinary bool orb).
+Definition BVor := Vbinary bool orb.
-Definition BVxor := (Vbinary bool xorb).
+Definition BVxor := Vbinary bool xorb.
-Definition BshiftL := [n:nat; bv : (Bvector (S n)); carry:bool]
- (Bcons carry n (Vshiftout bool n bv)).
+Definition BshiftL (n:nat) (bv:Bvector (S n)) (carry:bool) :=
+ Bcons carry n (Vshiftout bool n bv).
-Definition BshiftRl := [n:nat; bv : (Bvector (S n)); carry:bool]
- (Bhigh (S n) (Vshiftin bool (S n) carry bv)).
+Definition BshiftRl (n:nat) (bv:Bvector (S n)) (carry:bool) :=
+ Bhigh (S n) (Vshiftin bool (S n) carry bv).
-Definition BshiftRa := [n:nat; bv : (Bvector (S n))]
- (Bhigh (S n) (Vshiftrepeat bool n bv)).
+Definition BshiftRa (n:nat) (bv:Bvector (S n)) :=
+ Bhigh (S n) (Vshiftrepeat bool n bv).
-Fixpoint BshiftL_iter [n:nat; bv:(Bvector (S n)); p:nat]:(Bvector (S n)) :=
-Cases p of
- | O => bv
- | (S p') => (BshiftL n (BshiftL_iter n bv p') false)
-end.
+Fixpoint BshiftL_iter (n:nat) (bv:Bvector (S n)) (p:nat) {struct p} :
+ Bvector (S n) :=
+ match p with
+ | O => bv
+ | S p' => BshiftL n (BshiftL_iter n bv p') false
+ end.
-Fixpoint BshiftRl_iter [n:nat; bv:(Bvector (S n)); p:nat]:(Bvector (S n)) :=
-Cases p of
- | O => bv
- | (S p') => (BshiftRl n (BshiftRl_iter n bv p') false)
-end.
+Fixpoint BshiftRl_iter (n:nat) (bv:Bvector (S n)) (p:nat) {struct p} :
+ Bvector (S n) :=
+ match p with
+ | O => bv
+ | S p' => BshiftRl n (BshiftRl_iter n bv p') false
+ end.
-Fixpoint BshiftRa_iter [n:nat; bv:(Bvector (S n)); p:nat]:(Bvector (S n)) :=
-Cases p of
- | O => bv
- | (S p') => (BshiftRa n (BshiftRa_iter n bv p'))
-end.
+Fixpoint BshiftRa_iter (n:nat) (bv:Bvector (S n)) (p:nat) {struct p} :
+ Bvector (S n) :=
+ match p with
+ | O => bv
+ | S p' => BshiftRa n (BshiftRa_iter n bv p')
+ end.
End BOOLEAN_VECTORS.
-
diff --git a/theories/Bool/DecBool.v b/theories/Bool/DecBool.v
index 28ef57eac..8a15e7624 100755
--- a/theories/Bool/DecBool.v
+++ b/theories/Bool/DecBool.v
@@ -10,18 +10,22 @@
Set Implicit Arguments.
-Definition ifdec : (A,B:Prop)(C:Set)({A}+{B})->C->C->C
- := [A,B,C,H,x,y]if H then [_]x else [_]y.
+Definition ifdec (A B:Prop) (C:Set) (H:{A} + {B}) (x y:C) : C :=
+ if H then fun _ => x else fun _ => y.
-Theorem ifdec_left : (A,B:Prop)(C:Set)(H:{A}+{B})~B->(x,y:C)(ifdec H x y)=x.
-Intros; Case H; Auto.
-Intro; Absurd B; Trivial.
+Theorem ifdec_left :
+ forall (A B:Prop) (C:Set) (H:{A} + {B}),
+ ~ B -> forall x y:C, ifdec H x y = x.
+intros; case H; auto.
+intro; absurd B; trivial.
Qed.
-Theorem ifdec_right : (A,B:Prop)(C:Set)(H:{A}+{B})~A->(x,y:C)(ifdec H x y)=y.
-Intros; Case H; Auto.
-Intro; Absurd A; Trivial.
+Theorem ifdec_right :
+ forall (A B:Prop) (C:Set) (H:{A} + {B}),
+ ~ A -> forall x y:C, ifdec H x y = y.
+intros; case H; auto.
+intro; absurd A; trivial.
Qed.
-Unset Implicit Arguments.
+Unset Implicit Arguments. \ No newline at end of file
diff --git a/theories/Bool/IfProp.v b/theories/Bool/IfProp.v
index 48180678f..bde404cf7 100755
--- a/theories/Bool/IfProp.v
+++ b/theories/Bool/IfProp.v
@@ -8,42 +8,43 @@
(*i $Id$ i*)
-Require Bool.
+Require Import Bool.
-Inductive IfProp [A,B:Prop] : bool-> Prop
- := Iftrue : A -> (IfProp A B true)
- | Iffalse : B -> (IfProp A B false).
+Inductive IfProp (A B:Prop) : bool -> Prop :=
+ | Iftrue : A -> IfProp A B true
+ | Iffalse : B -> IfProp A B false.
-Hints Resolve Iftrue Iffalse : bool v62.
+Hint Resolve Iftrue Iffalse: bool v62.
-Lemma Iftrue_inv : (A,B:Prop)(b:bool) (IfProp A B b) -> b=true -> A.
-NewDestruct 1; Intros; Auto with bool.
-Case diff_true_false; Auto with bool.
+Lemma Iftrue_inv : forall (A B:Prop) (b:bool), IfProp A B b -> b = true -> A.
+destruct 1; intros; auto with bool.
+case diff_true_false; auto with bool.
Qed.
-Lemma Iffalse_inv : (A,B:Prop)(b:bool) (IfProp A B b) -> b=false -> B.
-NewDestruct 1; Intros; Auto with bool.
-Case diff_true_false; Trivial with bool.
+Lemma Iffalse_inv :
+ forall (A B:Prop) (b:bool), IfProp A B b -> b = false -> B.
+destruct 1; intros; auto with bool.
+case diff_true_false; trivial with bool.
Qed.
-Lemma IfProp_true : (A,B:Prop)(IfProp A B true) -> A.
-Intros.
-Inversion H.
-Assumption.
+Lemma IfProp_true : forall A B:Prop, IfProp A B true -> A.
+intros.
+inversion H.
+assumption.
Qed.
-Lemma IfProp_false : (A,B:Prop)(IfProp A B false) -> B.
-Intros.
-Inversion H.
-Assumption.
+Lemma IfProp_false : forall A B:Prop, IfProp A B false -> B.
+intros.
+inversion H.
+assumption.
Qed.
-Lemma IfProp_or : (A,B:Prop)(b:bool)(IfProp A B b) -> A\/B.
-NewDestruct 1; Auto with bool.
+Lemma IfProp_or : forall (A B:Prop) (b:bool), IfProp A B b -> A \/ B.
+destruct 1; auto with bool.
Qed.
-Lemma IfProp_sum : (A,B:Prop)(b:bool)(IfProp A B b) -> {A}+{B}.
-NewDestruct b; Intro H.
-Left; Inversion H; Auto with bool.
-Right; Inversion H; Auto with bool.
-Qed.
+Lemma IfProp_sum : forall (A B:Prop) (b:bool), IfProp A B b -> {A} + {B}.
+destruct b; intro H.
+left; inversion H; auto with bool.
+right; inversion H; auto with bool.
+Qed. \ No newline at end of file
diff --git a/theories/Bool/Sumbool.v b/theories/Bool/Sumbool.v
index 779969e6f..815bcda41 100644
--- a/theories/Bool/Sumbool.v
+++ b/theories/Bool/Sumbool.v
@@ -15,21 +15,23 @@
(** A boolean is either [true] or [false], and this is decidable *)
-Definition sumbool_of_bool : (b:bool) {b=true}+{b=false}.
+Definition sumbool_of_bool : forall b:bool, {b = true} + {b = false}.
Proof.
- NewDestruct b; Auto.
+ destruct b; auto.
Defined.
-Hints Resolve sumbool_of_bool : bool.
+Hint Resolve sumbool_of_bool: bool.
-Definition bool_eq_rec : (b:bool)(P:bool->Set)
- ((b=true)->(P true))->((b=false)->(P false))->(P b).
-NewDestruct b; Auto.
+Definition bool_eq_rec :
+ forall (b:bool) (P:bool -> Set),
+ (b = true -> P true) -> (b = false -> P false) -> P b.
+destruct b; auto.
Defined.
-Definition bool_eq_ind : (b:bool)(P:bool->Prop)
- ((b=true)->(P true))->((b=false)->(P false))->(P b).
-NewDestruct b; Auto.
+Definition bool_eq_ind :
+ forall (b:bool) (P:bool -> Prop),
+ (b = true -> P true) -> (b = false -> P false) -> P b.
+destruct b; auto.
Defined.
@@ -39,39 +41,38 @@ Defined.
Section connectives.
-Variables A,B,C,D : Prop.
+Variables A B C D : Prop.
-Hypothesis H1 : {A}+{B}.
-Hypothesis H2 : {C}+{D}.
+Hypothesis H1 : {A} + {B}.
+Hypothesis H2 : {C} + {D}.
-Definition sumbool_and : {A/\C}+{B\/D}.
+Definition sumbool_and : {A /\ C} + {B \/ D}.
Proof.
-Case H1; Case H2; Auto.
+case H1; case H2; auto.
Defined.
-Definition sumbool_or : {A\/C}+{B/\D}.
+Definition sumbool_or : {A \/ C} + {B /\ D}.
Proof.
-Case H1; Case H2; Auto.
+case H1; case H2; auto.
Defined.
-Definition sumbool_not : {B}+{A}.
+Definition sumbool_not : {B} + {A}.
Proof.
-Case H1; Auto.
+case H1; auto.
Defined.
End connectives.
-Hints Resolve sumbool_and sumbool_or sumbool_not : core.
+Hint Resolve sumbool_and sumbool_or sumbool_not: core.
(** Any decidability function in type [sumbool] can be turned into a function
returning a boolean with the corresponding specification: *)
-Definition bool_of_sumbool :
- (A,B:Prop) {A}+{B} -> { b:bool | if b then A else B }.
+Definition bool_of_sumbool :
+ forall A B:Prop, {A} + {B} -> {b : bool | if b then A else B}.
Proof.
-Intros A B H.
-Elim H; [ Intro; Exists true; Assumption
- | Intro; Exists false; Assumption ].
+intros A B H.
+elim H; [ intro; exists true; assumption | intro; exists false; assumption ].
Defined.
-Implicits bool_of_sumbool.
+Implicit Arguments bool_of_sumbool. \ No newline at end of file
diff --git a/theories/Bool/Zerob.v b/theories/Bool/Zerob.v
index 788025161..6487d08e9 100755
--- a/theories/Bool/Zerob.v
+++ b/theories/Bool/Zerob.v
@@ -8,29 +8,31 @@
(*i $Id$ i*)
-Require Arith.
-Require Bool.
+Require Import Arith.
+Require Import Bool.
-V7only [Import nat_scope.].
Open Local Scope nat_scope.
-Definition zerob : nat->bool
- := [n:nat]Cases n of O => true | (S _) => false end.
+Definition zerob (n:nat) : bool :=
+ match n with
+ | O => true
+ | S _ => false
+ end.
-Lemma zerob_true_intro : (n:nat)(n=O)->(zerob n)=true.
-NewDestruct n; [Trivial with bool | Inversion 1].
+Lemma zerob_true_intro : forall n:nat, n = 0 -> zerob n = true.
+destruct n; [ trivial with bool | inversion 1 ].
Qed.
-Hints Resolve zerob_true_intro : bool.
+Hint Resolve zerob_true_intro: bool.
-Lemma zerob_true_elim : (n:nat)(zerob n)=true->(n=O).
-NewDestruct n; [Trivial with bool | Inversion 1].
+Lemma zerob_true_elim : forall n:nat, zerob n = true -> n = 0.
+destruct n; [ trivial with bool | inversion 1 ].
Qed.
-Lemma zerob_false_intro : (n:nat)~(n=O)->(zerob n)=false.
-NewDestruct n; [NewDestruct 1; Auto with bool | Trivial with bool].
+Lemma zerob_false_intro : forall n:nat, n <> 0 -> zerob n = false.
+destruct n; [ destruct 1; auto with bool | trivial with bool ].
Qed.
-Hints Resolve zerob_false_intro : bool.
+Hint Resolve zerob_false_intro: bool.
-Lemma zerob_false_elim : (n:nat)(zerob n)=false -> ~(n=O).
-NewDestruct n; [Intro H; Inversion H | Auto with bool].
-Qed.
+Lemma zerob_false_elim : forall n:nat, zerob n = false -> n <> 0.
+destruct n; [ intro H; inversion H | auto with bool ].
+Qed. \ No newline at end of file
diff --git a/theories/Init/Datatypes.v b/theories/Init/Datatypes.v
index d93bbbac1..d5a1179c8 100755
--- a/theories/Init/Datatypes.v
+++ b/theories/Init/Datatypes.v
@@ -8,117 +8,114 @@
(*i $Id$ i*)
-Require Notations.
-Require Logic.
+Require Import Notations.
+Require Import Logic.
Set Implicit Arguments.
-V7only [Unset Implicit Arguments.].
(** [unit] is a singleton datatype with sole inhabitant [tt] *)
-Inductive unit : Set := tt : unit.
+Inductive unit : Set :=
+ tt : unit.
(** [bool] is the datatype of the booleans values [true] and [false] *)
-Inductive bool : Set := true : bool
- | false : bool.
+Inductive bool : Set :=
+ | true : bool
+ | false : bool.
Add Printing If bool.
(** [nat] is the datatype of natural numbers built from [O] and successor [S];
note that zero is the letter O, not the numeral 0 *)
-Inductive nat : Set := O : nat
- | S : nat->nat.
+Inductive nat : Set :=
+ | O : nat
+ | S : nat -> nat.
-Delimits Scope nat_scope with nat.
+Delimit Scope nat_scope with nat.
Bind Scope nat_scope with nat.
-Arguments Scope S [ nat_scope ].
+Arguments Scope S [nat_scope].
(** [Empty_set] has no inhabitant *)
-Inductive Empty_set:Set :=.
+Inductive Empty_set : Set :=.
(** [identity A a] is the family of datatypes on [A] whose sole non-empty
member is the singleton datatype [identity A a a] whose
sole inhabitant is denoted [refl_identity A a] *)
-Inductive identity [A:Type; a:A] : A->Set :=
- refl_identity: (identity A a a).
-Hints Resolve refl_identity : core v62.
+Inductive identity (A:Type) (a:A) : A -> Set :=
+ refl_identity : identity (A:=A) a a.
+Hint Resolve refl_identity: core v62.
-Implicits identity_ind [1].
-Implicits identity_rec [1].
-Implicits identity_rect [1].
-V7only [
-Implicits identity_ind [].
-Implicits identity_rec [].
-Implicits identity_rect [].
-].
+Implicit Arguments identity_ind [A].
+Implicit Arguments identity_rec [A].
+Implicit Arguments identity_rect [A].
(** [option A] is the extension of A with a dummy element None *)
-Inductive option [A:Set] : Set := Some : A -> (option A) | None : (option A).
+Inductive option (A:Set) : Set :=
+ | Some : A -> option A
+ | None : option A.
-Implicits None [1].
-V7only [Implicits None [].].
+Implicit Arguments None [A].
(** [sum A B], equivalently [A + B], is the disjoint sum of [A] and [B] *)
(* Syntax defined in Specif.v *)
-Inductive sum [A,B:Set] : Set
- := inl : A -> (sum A B)
- | inr : B -> (sum A B).
+Inductive sum (A B:Set) : Set :=
+ | inl : A -> sum A B
+ | inr : B -> sum A B.
Notation "x + y" := (sum x y) : type_scope.
(** [prod A B], written [A * B], is the product of [A] and [B];
the pair [pair A B a b] of [a] and [b] is abbreviated [(a,b)] *)
-Inductive prod [A,B:Set] : Set := pair : A -> B -> (prod A B).
+Inductive prod (A B:Set) : Set :=
+ pair : A -> B -> prod A B.
Add Printing Let prod.
Notation "x * y" := (prod x y) : type_scope.
-Notation "( x , y )" := (pair ? ? x y) : core_scope V8only "x , y".
+Notation "x , y" := (pair x y) : core_scope.
Section projections.
- Variables A,B:Set.
- Definition fst := [p:(prod A B)]Cases p of (pair x y) => x end.
- Definition snd := [p:(prod A B)]Cases p of (pair x y) => y end.
+ Variables A B : Set.
+ Definition fst (p:A * B) := match p with
+ | (x, y) => x
+ end.
+ Definition snd (p:A * B) := match p with
+ | (x, y) => y
+ end.
End projections.
-V7only [
-Notation Fst := (fst ? ?).
-Notation Snd := (snd ? ?).
-].
-Hints Resolve pair inl inr : core v62.
+Hint Resolve pair inl inr: core v62.
-Lemma surjective_pairing : (A,B:Set;p:A*B)p=(pair A B (Fst p) (Snd p)).
+Lemma surjective_pairing :
+ forall (A B:Set) (p:A * B), p = pair (fst p) (snd p).
Proof.
-NewDestruct p; Reflexivity.
+destruct p; reflexivity.
Qed.
-Lemma injective_projections :
- (A,B:Set;p1,p2:A*B)(Fst p1)=(Fst p2)->(Snd p1)=(Snd p2)->p1=p2.
+Lemma injective_projections :
+ forall (A B:Set) (p1 p2:A * B),
+ fst p1 = fst p2 -> snd p1 = snd p2 -> p1 = p2.
Proof.
-NewDestruct p1; NewDestruct p2; Simpl; Intros Hfst Hsnd.
-Rewrite Hfst; Rewrite Hsnd; Reflexivity.
+destruct p1; destruct p2; simpl in |- *; intros Hfst Hsnd.
+rewrite Hfst; rewrite Hsnd; reflexivity.
Qed.
-V7only[
-(** Parsing only of things in [Datatypes.v] *)
-Notation "< A , B > ( x , y )" := (pair A B x y) (at level 1, only parsing, A annot).
-Notation "< A , B > 'Fst' ( p )" := (fst A B p) (at level 1, only parsing, A annot).
-Notation "< A , B > 'Snd' ( p )" := (snd A B p) (at level 1, only parsing, A annot).
-].
(** Comparison *)
-Inductive relation : Set :=
- EGAL :relation | INFERIEUR : relation | SUPERIEUR : relation.
-
-Definition Op := [r:relation]
- Cases r of
- EGAL => EGAL
- | INFERIEUR => SUPERIEUR
- | SUPERIEUR => INFERIEUR
- end.
+Inductive comparison : Set :=
+ | Eq : comparison
+ | Lt : comparison
+ | Gt : comparison.
+
+Definition CompOpp (r:comparison) :=
+ match r with
+ | Eq => Eq
+ | Lt => Gt
+ | Gt => Lt
+ end. \ No newline at end of file
diff --git a/theories/Init/Logic.v b/theories/Init/Logic.v
index dc067a4b7..7cfe160a0 100755
--- a/theories/Init/Logic.v
+++ b/theories/Init/Logic.v
@@ -9,30 +9,27 @@
(*i $Id$ i*)
Set Implicit Arguments.
-V7only [Unset Implicit Arguments.].
-Require Notations.
+Require Import Notations.
(** [True] is the always true proposition *)
-Inductive True : Prop := I : True.
+Inductive True : Prop :=
+ I : True.
(** [False] is the always false proposition *)
-Inductive False : Prop := .
+Inductive False : Prop :=.
(** [not A], written [~A], is the negation of [A] *)
-Definition not := [A:Prop]A->False.
+Definition not (A:Prop) := A -> False.
Notation "~ x" := (not x) : type_scope.
-Hints Unfold not : core.
+Hint Unfold not: core.
-Inductive and [A,B:Prop] : Prop := conj : A -> B -> A /\ B
+Inductive and (A B:Prop) : Prop :=
+ conj : A -> B -> A /\ B
+ where "A /\ B" := (and A B) : type_scope.
-where "A /\ B" := (and A B) : type_scope.
-
-V7only[
-Notation "< P , Q > { p , q }" := (conj P Q p q) (P annot, at level 1).
-].
Section Conjunction.
@@ -43,61 +40,58 @@ Section Conjunction.
[proj1] and [proj2] are first and second projections of a conjunction *)
- Variables A,B : Prop.
+ Variables A B : Prop.
- Theorem proj1 : (and A B) -> A.
+ Theorem proj1 : A /\ B -> A.
Proof.
- NewDestruct 1; Trivial.
+ destruct 1; trivial.
Qed.
- Theorem proj2 : (and A B) -> B.
+ Theorem proj2 : A /\ B -> B.
Proof.
- NewDestruct 1; Trivial.
+ destruct 1; trivial.
Qed.
End Conjunction.
(** [or A B], written [A \/ B], is the disjunction of [A] and [B] *)
-Inductive or [A,B:Prop] : Prop :=
- or_introl : A -> A \/ B
- | or_intror : B -> A \/ B
-
-where "A \/ B" := (or A B) : type_scope.
+Inductive or (A B:Prop) : Prop :=
+ | or_introl : A -> A \/ B
+ | or_intror : B -> A \/ B
+ where "A \/ B" := (or A B) : type_scope.
(** [iff A B], written [A <-> B], expresses the equivalence of [A] and [B] *)
-Definition iff := [A,B:Prop] (and (A->B) (B->A)).
+Definition iff (A B:Prop) := (A -> B) /\ (B -> A).
Notation "A <-> B" := (iff A B) : type_scope.
Section Equivalence.
-Theorem iff_refl : (A:Prop) (iff A A).
+Theorem iff_refl : forall A:Prop, A <-> A.
Proof.
- Split; Auto.
+ split; auto.
Qed.
-Theorem iff_trans : (a,b,c:Prop) (iff a b) -> (iff b c) -> (iff a c).
+Theorem iff_trans : forall A B C:Prop, (A <-> B) -> (B <-> C) -> (A <-> C).
Proof.
- Intros A B C (H1,H2) (H3,H4); Split; Auto.
+ intros A B C [H1 H2] [H3 H4]; split; auto.
Qed.
-Theorem iff_sym : (A,B:Prop) (iff A B) -> (iff B A).
+Theorem iff_sym : forall A B:Prop, (A <-> B) -> (B <-> A).
Proof.
- Intros A B (H1,H2); Split; Auto.
+ intros A B [H1 H2]; split; auto.
Qed.
End Equivalence.
(** [(IF P Q R)], or more suggestively [(either P and_then Q or_else R)],
denotes either [P] and [Q], or [~P] and [Q] *)
-Definition IF_then_else := [P,Q,R:Prop] (or (and P Q) (and (not P) R)).
-V7only [Notation IF:=IF_then_else.].
+Definition IF_then_else (P Q R:Prop) := P /\ Q \/ ~ P /\ R.
-Notation "'IF' c1 'then' c2 'else' c3" := (IF c1 c2 c3)
- (at level 1, c1, c2, c3 at level 8) : type_scope
- V8only (at level 200).
+Notation "'IF' c1 'then' c2 'else' c3" := (IF_then_else c1 c2 c3)
+ (at level 200) : type_scope.
(** First-order quantifiers *)
@@ -114,57 +108,42 @@ Notation "'IF' c1 'then' c2 'else' c3" := (IF c1 c2 c3)
construction [(all A P)], or simply [(All P)], is provided as an
abbreviation of [(x:A)(P x)] *)
-Inductive ex [A:Type;P:A->Prop] : Prop
- := ex_intro : (x:A)(P x)->(ex A P).
+Inductive ex (A:Type) (P:A -> Prop) : Prop :=
+ ex_intro : forall x:A, P x -> ex (A:=A) P.
-Inductive ex2 [A:Type;P,Q:A->Prop] : Prop
- := ex_intro2 : (x:A)(P x)->(Q x)->(ex2 A P Q).
+Inductive ex2 (A:Type) (P Q:A -> Prop) : Prop :=
+ ex_intro2 : forall x:A, P x -> Q x -> ex2 (A:=A) P Q.
-Definition all := [A:Type][P:A->Prop](x:A)(P x).
+Definition all (A:Type) (P:A -> Prop) := forall x:A, P x.
(*Rule order is important to give printing priority to fully typed ALL and EX*)
-V7only [ Notation Ex := (ex ?). ].
-Notation "'EX' x | p" := (ex ? [x]p)
- (at level 10, p at level 8) : type_scope
- V8only "'exists' x | p" (at level 200, x ident, p at level 99).
-Notation "'EX' x : t | p" := (ex ? [x:t]p)
- (at level 10, p at level 8) : type_scope
- V8only "'exists' x : t | p" (at level 200, x ident, p at level 99).
-
-V7only [ Notation Ex2 := (ex2 ?). ].
-Notation "'EX' x | p & q" := (ex2 ? [x]p [x]q)
- (at level 10, p, q at level 8) : type_scope
- V8only "'exists2' x | p & q" (at level 200, x ident, p, q at level 99).
-Notation "'EX' x : t | p & q" := (ex2 ? [x:t]p [x:t]q)
- (at level 10, p, q at level 8) : type_scope
- V8only "'exists2' x : t | p & q"
- (at level 200, x ident, t at level 200, p, q at level 99).
-
-V7only [Notation All := (all ?).
-Notation "'ALL' x | p" := (all ? [x]p)
- (at level 10, p at level 8) : type_scope
- V8only (at level 200, x ident, p at level 200).
-Notation "'ALL' x : t | p" := (all ? [x:t]p)
- (at level 10, p at level 8) : type_scope
- V8only (at level 200, x ident, t, p at level 200).
-].
+Notation "'exists' x | p" := (ex (fun x => p))
+ (at level 200, x ident, p at level 99) : type_scope.
+Notation "'exists' x : t | p" := (ex (fun x:t => p))
+ (at level 200, x ident, p at level 99) : type_scope.
+
+Notation "'exists2' x | p & q" := (ex2 (fun x => p) (fun x => q))
+ (at level 200, x ident, p, q at level 99) : type_scope.
+Notation "'exists2' x : t | p & q" := (ex2 (fun x:t => p) (fun x:t => q))
+ (at level 200, x ident, t at level 200, p, q at level 99) : type_scope.
+
(** Universal quantification *)
Section universal_quantification.
Variable A : Type.
- Variable P : A->Prop.
+ Variable P : A -> Prop.
- Theorem inst : (x:A)(all ? [x](P x))->(P x).
+ Theorem inst : forall x:A, all (fun x => P x) -> P x.
Proof.
- Unfold all; Auto.
+ unfold all in |- *; auto.
Qed.
- Theorem gen : (B:Prop)(f:(y:A)B->(P y))B->(all A P).
+ Theorem gen : forall (B:Prop) (f:forall y:A, B -> P y), B -> all P.
Proof.
- Red; Auto.
+ red in |- *; auto.
Qed.
End universal_quantification.
@@ -177,66 +156,60 @@ Section universal_quantification.
The others properties (symmetry, transitivity, replacement of
equals) are proved below *)
-Inductive eq [A:Type;x:A] : A->Prop
- := refl_equal : x = x :> A
-
-where "x = y :> A" := (!eq A x y) : type_scope.
+Inductive eq (A:Type) (x:A) : A -> Prop :=
+ refl_equal : x = x :>A
+ where "x = y :> A" := (@eq A x y) : type_scope.
-Notation "x = y" := (eq ? x y) : type_scope.
-Notation "x <> y :> T" := ~ (!eq T x y) : type_scope.
-Notation "x <> y" := ~ x=y : type_scope.
+Notation "x = y" := (x = y :>_) : type_scope.
+Notation "x <> y :> T" := (~ x = y :>T) : type_scope.
+Notation "x <> y" := (x <> y :>_) : type_scope.
-Implicits eq_ind [1].
-Implicits eq_rec [1].
-Implicits eq_rect [1].
-V7only [
-Implicits eq_ind [].
-Implicits eq_rec [].
-Implicits eq_rect [].
-].
+Implicit Arguments eq_ind [A].
+Implicit Arguments eq_rec [A].
+Implicit Arguments eq_rect [A].
-Hints Resolve I conj or_introl or_intror refl_equal : core v62.
-Hints Resolve ex_intro ex_intro2 : core v62.
+Hint Resolve I conj or_introl or_intror refl_equal: core v62.
+Hint Resolve ex_intro ex_intro2: core v62.
Section Logic_lemmas.
- Theorem absurd : (A:Prop)(C:Prop) A -> (not A) -> C.
+ Theorem absurd : forall A C:Prop, A -> ~ A -> C.
Proof.
- Unfold not; Intros A C h1 h2.
- NewDestruct (h2 h1).
+ unfold not in |- *; intros A C h1 h2.
+ destruct (h2 h1).
Qed.
Section equality.
- Variable A,B : Type.
- Variable f : A->B.
- Variable x,y,z : A.
+ Variables A B : Type.
+ Variable f : A -> B.
+ Variables x y z : A.
- Theorem sym_eq : (eq ? x y) -> (eq ? y x).
+ Theorem sym_eq : x = y -> y = x.
Proof.
- NewDestruct 1; Trivial.
+ destruct 1; trivial.
Defined.
Opaque sym_eq.
- Theorem trans_eq : (eq ? x y) -> (eq ? y z) -> (eq ? x z).
+ Theorem trans_eq : x = y -> y = z -> x = z.
Proof.
- NewDestruct 2; Trivial.
+ destruct 2; trivial.
Defined.
Opaque trans_eq.
- Theorem f_equal : (eq ? x y) -> (eq ? (f x) (f y)).
+ Theorem f_equal : x = y -> f x = f y.
Proof.
- NewDestruct 1; Trivial.
+ destruct 1; trivial.
Defined.
Opaque f_equal.
- Theorem sym_not_eq : (not (eq ? x y)) -> (not (eq ? y x)).
+ Theorem sym_not_eq : x <> y -> y <> x.
Proof.
- Red; Intros h1 h2; Apply h1; NewDestruct h2; Trivial.
+ red in |- *; intros h1 h2; apply h1; destruct h2; trivial.
Qed.
- Definition sym_equal := sym_eq.
+ Definition sym_equal := sym_eq.
Definition sym_not_equal := sym_not_eq.
- Definition trans_equal := trans_eq.
+ Definition trans_equal := trans_eq.
End equality.
@@ -250,56 +223,53 @@ Section Logic_lemmas.
Qed.
*)
- Definition eq_ind_r : (A:Type)(x:A)(P:A->Prop)(P x)->(y:A)(eq ? y x)->(P y).
- Intros A x P H y H0; Elim sym_eq with 1:= H0; Assumption.
+ Definition eq_ind_r :
+ forall (A:Type) (x:A) (P:A -> Prop), P x -> forall y:A, y = x -> P y.
+ intros A x P H y H0; elim sym_eq with (1 := H0); assumption.
Defined.
- Definition eq_rec_r : (A:Type)(x:A)(P:A->Set)(P x)->(y:A)(eq ? y x)->(P y).
- Intros A x P H y H0; Elim sym_eq with 1:= H0; Assumption.
+ Definition eq_rec_r :
+ forall (A:Type) (x:A) (P:A -> Set), P x -> forall y:A, y = x -> P y.
+ intros A x P H y H0; elim sym_eq with (1 := H0); assumption.
Defined.
- Definition eq_rect_r : (A:Type)(x:A)(P:A->Type)(P x)->(y:A)(eq ? y x)->(P y).
- Intros A x P H y H0; Elim sym_eq with 1:= H0; Assumption.
+ Definition eq_rect_r :
+ forall (A:Type) (x:A) (P:A -> Type), P x -> forall y:A, y = x -> P y.
+ intros A x P H y H0; elim sym_eq with (1 := H0); assumption.
Defined.
End Logic_lemmas.
-Theorem f_equal2 : (A1,A2,B:Type)(f:A1->A2->B)(x1,y1:A1)(x2,y2:A2)
- (eq ? x1 y1) -> (eq ? x2 y2) -> (eq ? (f x1 x2) (f y1 y2)).
+Theorem f_equal2 :
+ forall (A1 A2 B:Type) (f:A1 -> A2 -> B) (x1 y1:A1)
+ (x2 y2:A2), x1 = y1 -> x2 = y2 -> f x1 x2 = f y1 y2.
Proof.
- NewDestruct 1; NewDestruct 1; Reflexivity.
+ destruct 1; destruct 1; reflexivity.
Qed.
-Theorem f_equal3 : (A1,A2,A3,B:Type)(f:A1->A2->A3->B)(x1,y1:A1)(x2,y2:A2)
- (x3,y3:A3)(eq ? x1 y1) -> (eq ? x2 y2) -> (eq ? x3 y3)
- -> (eq ? (f x1 x2 x3) (f y1 y2 y3)).
+Theorem f_equal3 :
+ forall (A1 A2 A3 B:Type) (f:A1 -> A2 -> A3 -> B) (x1 y1:A1)
+ (x2 y2:A2) (x3 y3:A3),
+ x1 = y1 -> x2 = y2 -> x3 = y3 -> f x1 x2 x3 = f y1 y2 y3.
Proof.
- NewDestruct 1; NewDestruct 1; NewDestruct 1; Reflexivity.
+ destruct 1; destruct 1; destruct 1; reflexivity.
Qed.
-Theorem f_equal4 : (A1,A2,A3,A4,B:Type)(f:A1->A2->A3->A4->B)
- (x1,y1:A1)(x2,y2:A2)(x3,y3:A3)(x4,y4:A4)
- (eq ? x1 y1) -> (eq ? x2 y2) -> (eq ? x3 y3) -> (eq ? x4 y4)
- -> (eq ? (f x1 x2 x3 x4) (f y1 y2 y3 y4)).
+Theorem f_equal4 :
+ forall (A1 A2 A3 A4 B:Type) (f:A1 -> A2 -> A3 -> A4 -> B)
+ (x1 y1:A1) (x2 y2:A2) (x3 y3:A3) (x4 y4:A4),
+ x1 = y1 -> x2 = y2 -> x3 = y3 -> x4 = y4 -> f x1 x2 x3 x4 = f y1 y2 y3 y4.
Proof.
- NewDestruct 1; NewDestruct 1; NewDestruct 1; NewDestruct 1; Reflexivity.
+ destruct 1; destruct 1; destruct 1; destruct 1; reflexivity.
Qed.
-Theorem f_equal5 : (A1,A2,A3,A4,A5,B:Type)(f:A1->A2->A3->A4->A5->B)
- (x1,y1:A1)(x2,y2:A2)(x3,y3:A3)(x4,y4:A4)(x5,y5:A5)
- (eq ? x1 y1) -> (eq ? x2 y2) -> (eq ? x3 y3) -> (eq ? x4 y4) -> (eq ? x5 y5)
- -> (eq ? (f x1 x2 x3 x4 x5) (f y1 y2 y3 y4 y5)).
+Theorem f_equal5 :
+ forall (A1 A2 A3 A4 A5 B:Type) (f:A1 -> A2 -> A3 -> A4 -> A5 -> B)
+ (x1 y1:A1) (x2 y2:A2) (x3 y3:A3) (x4 y4:A4) (x5 y5:A5),
+ x1 = y1 ->
+ x2 = y2 ->
+ x3 = y3 -> x4 = y4 -> x5 = y5 -> f x1 x2 x3 x4 x5 = f y1 y2 y3 y4 y5.
Proof.
- NewDestruct 1; NewDestruct 1; NewDestruct 1; NewDestruct 1; NewDestruct 1;
- Reflexivity.
+ destruct 1; destruct 1; destruct 1; destruct 1; destruct 1; reflexivity.
Qed.
-Hints Immediate sym_eq sym_not_eq : core v62.
-
-V7only[
-(** Parsing only of things in [Logic.v] *)
-Notation "< A > 'All' ( P )" :=(all A P) (A annot, at level 1, only parsing).
-Notation "< A > x = y" := (eq A x y)
- (A annot, at level 1, x at level 0, only parsing).
-Notation "< A > x <> y" := ~(eq A x y)
- (A annot, at level 1, x at level 0, only parsing).
-].
+Hint Immediate sym_eq sym_not_eq: core v62.
diff --git a/theories/Init/Logic_Type.v b/theories/Init/Logic_Type.v
index 1249e62ea..7f88476a4 100755
--- a/theories/Init/Logic_Type.v
+++ b/theories/Init/Logic_Type.v
@@ -9,294 +9,81 @@
(*i $Id$ i*)
Set Implicit Arguments.
-V7only [Unset Implicit Arguments.].
(** This module defines quantification on the world [Type]
([Logic.v] was defining it on the world [Set]) *)
-Require Datatypes.
+Require Import Datatypes.
Require Export Logic.
-V7only [
-(*
-(** [allT A P], or simply [(ALLT x | P(x))], stands for [(x:A)(P x)]
- when [A] is of type [Type] *)
+Definition notT (A:Type) := A -> False.
-Definition allT := [A:Type][P:A->Prop](x:A)(P x).
-*)
-
-Notation allT := all (only parsing).
-Notation inst := Logic.inst (only parsing).
-Notation gen := Logic.gen (only parsing).
-
-(* Order is important to give printing priority to fully typed ALL and EX *)
-
-Notation AllT := (all ?).
-Notation "'ALLT' x | p" := (all ? [x]p) (at level 10, p at level 8).
-Notation "'ALLT' x : t | p" := (all ? [x:t]p) (at level 10, p at level 8).
-
-(*
-Section universal_quantification.
-
-Variable A : Type.
-Variable P : A->Prop.
-
-Theorem inst : (x:A)(allT ? [x](P x))->(P x).
-Proof.
-Unfold all; Auto.
-Qed.
-
-Theorem gen : (B:Prop)(f:(y:A)B->(P y))B->(allT A P).
-Proof.
-Red; Auto.
-Qed.
-
-End universal_quantification.
-*)
-
-(*
-(** * Existential Quantification *)
-
-(** [exT A P], or simply [(EXT x | P(x))], stands for the existential
- quantification on the predicate [P] when [A] is of type [Type] *)
-
-(** [exT2 A P Q], or simply [(EXT x | P(x) & Q(x))], stands for the
- existential quantification on both [P] and [Q] when [A] is of
- type [Type] *)
-Inductive exT [A:Type;P:A->Prop] : Prop
- := exT_intro : (x:A)(P x)->(exT A P).
-*)
-
-Notation exT := ex (only parsing).
-Notation exT_intro := ex_intro (only parsing).
-Notation exT_ind := ex_ind (only parsing).
-
-Notation ExT := (ex ?).
-Notation "'EXT' x | p" := (ex ? [x]p) (at level 10, p at level 8).
-Notation "'EXT' x : t | p" := (ex ? [x:t]p) (at level 10, p at level 8).
-
-(*
-Inductive exT2 [A:Type;P,Q:A->Prop] : Prop
- := exT_intro2 : (x:A)(P x)->(Q x)->(exT2 A P Q).
-*)
-
-Notation exT2 := ex2 (only parsing).
-Notation exT_intro2 := ex_intro2 (only parsing).
-Notation exT2_ind := ex2_ind (only parsing).
-
-Notation ExT2 := (ex2 ?).
-Notation "'EXT' x | p & q" := (ex2 ? [x]p [x]q)
- (at level 10, p, q at level 8).
-Notation "'EXT' x : t | p & q" := (ex2 ? [x:t]p [x:t]q)
- (at level 10, p, q at level 8).
-
-(*
-(** Leibniz equality : [A:Type][x,y:A] (P:A->Prop)(P x)->(P y)
-
- [eqT A x y], or simply [x==y], is Leibniz' equality when [A] is of
- type [Type]. This equality satisfies reflexivity (by definition),
- symmetry, transitivity and stability by congruence *)
-
-
-Inductive eqT [A:Type;x:A] : A -> Prop
- := refl_eqT : (eqT A x x).
-
-Hints Resolve refl_eqT (* exT_intro2 exT_intro *) : core v62.
-*)
-
-Notation eqT := eq (only parsing).
-Notation refl_eqT := refl_equal (only parsing).
-Notation eqT_ind := eq_ind (only parsing).
-Notation eqT_rect := eq_rect (only parsing).
-Notation eqT_rec := eq_rec (only parsing).
-
-Notation "x == y" := (eq ? x y) (at level 5, no associativity, only parsing).
-
-(** Parsing only of things in [Logic_type.v] *)
-
-Notation "< A > x == y" := (eq A x y)
- (A annot, at level 1, x at level 0, only parsing).
-
-(*
-Section Equality_is_a_congruence.
-
- Variables A,B : Type.
- Variable f : A->B.
-
- Variable x,y,z : A.
-
- Lemma sym_eqT : (eqT ? x y) -> (eqT ? y x).
- Proof.
- NewDestruct 1; Trivial.
- Qed.
-
- Lemma trans_eqT : (eqT ? x y) -> (eqT ? y z) -> (eqT ? x z).
- Proof.
- NewDestruct 2; Trivial.
- Qed.
-
- Lemma congr_eqT : (eqT ? x y)->(eqT ? (f x) (f y)).
- Proof.
- NewDestruct 1; Trivial.
- Qed.
-
- Lemma sym_not_eqT : ~(eqT ? x y) -> ~(eqT ? y x).
- Proof.
- Red; Intros H H'; Apply H; NewDestruct H'; Trivial.
- Qed.
-
-End Equality_is_a_congruence.
-*)
-
-Notation sym_eqT := sym_eq (only parsing).
-Notation trans_eqT := trans_eq (only parsing).
-Notation congr_eqT := f_equal (only parsing).
-Notation sym_not_eqT := sym_not_eq (only parsing).
-
-(*
-Hints Immediate sym_eqT sym_not_eqT : core v62.
-*)
-
-(** This states the replacement of equals by equals *)
-
-(*
-Definition eqT_ind_r : (A:Type)(x:A)(P:A->Prop)(P x)->(y:A)(eqT ? y x)->(P y).
-Intros A x P H y H0; Case sym_eqT with 1:=H0; Trivial.
-Defined.
-
-Definition eqT_rec_r : (A:Type)(x:A)(P:A->Set)(P x)->(y:A)(eqT ? y x)->(P y).
-Intros A x P H y H0; Case sym_eqT with 1:=H0; Trivial.
-Defined.
-
-Definition eqT_rect_r : (A:Type)(x:A)(P:A->Type)(P x)->(y:A)(eqT ? y x)->(P y).
-Intros A x P H y H0; Case sym_eqT with 1:=H0; Trivial.
-Defined.
-*)
-
-Notation eqT_ind_r := eq_ind_r (only parsing).
-Notation eqT_rec_r := eq_rec_r (only parsing).
-Notation eqT_rect_r := eq_rect_r (only parsing).
-
-(** Some datatypes at the [Type] level *)
-(*
-Inductive EmptyT: Type :=.
-Inductive UnitT : Type := IT : UnitT.
-*)
-
-Notation EmptyT := False (only parsing).
-Notation UnitT := unit (only parsing).
-Notation IT := tt.
-].
-Definition notT := [A:Type] A->EmptyT.
-
-V7only [
-(** Have you an idea of what means [identityT A a b]? No matter! *)
-
-(*
-Inductive identityT [A:Type; a:A] : A -> Type :=
- refl_identityT : (identityT A a a).
-*)
-
-Notation identityT := identity (only parsing).
-Notation refl_identityT := refl_identity (only parsing).
-
-Notation "< A > x === y" := (!identityT A x y)
- (A annot, at level 1, x at level 0, only parsing).
-
-Notation "x === y" := (identityT ? x y)
- (at level 5, no associativity) : type_scope.
-
-(*
-Hints Resolve refl_identityT : core v62.
-*)
-].
Section identity_is_a_congruence.
- Variables A,B : Type.
- Variable f : A->B.
+ Variables A B : Type.
+ Variable f : A -> B.
- Variable x,y,z : A.
+ Variables x y z : A.
- Lemma sym_id : (identityT ? x y) -> (identityT ? y x).
+ Lemma sym_id : identity x y -> identity y x.
Proof.
- NewDestruct 1; Trivial.
+ destruct 1; trivial.
Qed.
- Lemma trans_id : (identityT ? x y) -> (identityT ? y z) -> (identityT ? x z).
+ Lemma trans_id : identity x y -> identity y z -> identity x z.
Proof.
- NewDestruct 2; Trivial.
+ destruct 2; trivial.
Qed.
- Lemma congr_id : (identityT ? x y)->(identityT ? (f x) (f y)).
+ Lemma congr_id : identity x y -> identity (f x) (f y).
Proof.
- NewDestruct 1; Trivial.
+ destruct 1; trivial.
Qed.
- Lemma sym_not_id : (notT (identityT ? x y)) -> (notT (identityT ? y x)).
+ Lemma sym_not_id : notT (identity x y) -> notT (identity y x).
Proof.
- Red; Intros H H'; Apply H; NewDestruct H'; Trivial.
+ red in |- *; intros H H'; apply H; destruct H'; trivial.
Qed.
End identity_is_a_congruence.
Definition identity_ind_r :
- (A:Type)
- (a:A)
- (P:A->Prop)
- (P a)->(y:A)(identityT ? y a)->(P y).
- Intros A x P H y H0; Case sym_id with 1:= H0; Trivial.
+ forall (A:Type) (a:A) (P:A -> Prop), P a -> forall y:A, identity y a -> P y.
+ intros A x P H y H0; case sym_id with (1 := H0); trivial.
Defined.
-Definition identity_rec_r :
- (A:Type)
- (a:A)
- (P:A->Set)
- (P a)->(y:A)(identityT ? y a)->(P y).
- Intros A x P H y H0; Case sym_id with 1:= H0; Trivial.
+Definition identity_rec_r :
+ forall (A:Type) (a:A) (P:A -> Set), P a -> forall y:A, identity y a -> P y.
+ intros A x P H y H0; case sym_id with (1 := H0); trivial.
Defined.
-Definition identity_rect_r :
- (A:Type)
- (a:A)
- (P:A->Type)
- (P a)->(y:A)(identityT ? y a)->(P y).
- Intros A x P H y H0; Case sym_id with 1:= H0; Trivial.
+Definition identity_rect_r :
+ forall (A:Type) (a:A) (P:A -> Type), P a -> forall y:A, identity y a -> P y.
+ intros A x P H y H0; case sym_id with (1 := H0); trivial.
Defined.
-V7only [
-Notation sym_idT := sym_id (only parsing).
-Notation trans_idT := trans_id (only parsing).
-Notation congr_idT := congr_id (only parsing).
-Notation sym_not_idT := sym_not_id (only parsing).
-Notation identityT_ind_r := identityT_ind_r (only parsing).
-Notation identityT_rec_r := identityT_rec_r (only parsing).
-Notation identityT_rect_r := identityT_rect_r (only parsing).
-].
-Inductive prodT [A,B:Type] : Type := pairT : A -> B -> (prodT A B).
+Inductive prodT (A B:Type) : Type :=
+ pairT : A -> B -> prodT A B.
Section prodT_proj.
- Variables A, B : Type.
+ Variables A B : Type.
- Definition fstT := [H:(prodT A B)]Cases H of (pairT x _) => x end.
- Definition sndT := [H:(prodT A B)]Cases H of (pairT _ y) => y end.
+ Definition fstT (H:prodT A B) := match H with
+ | pairT x _ => x
+ end.
+ Definition sndT (H:prodT A B) := match H with
+ | pairT _ y => y
+ end.
End prodT_proj.
-Definition prodT_uncurry : (A,B,C:Type)((prodT A B)->C)->A->B->C :=
- [A,B,C:Type; f:((prodT A B)->C); x:A; y:B]
- (f (pairT A B x y)).
-
-Definition prodT_curry : (A,B,C:Type)(A->B->C)->(prodT A B)->C :=
- [A,B,C:Type; f:(A->B->C); p:(prodT A B)]
- Cases p of
- | (pairT x y) => (f x y)
- end.
+Definition prodT_uncurry (A B C:Type) (f:prodT A B -> C)
+ (x:A) (y:B) : C := f (pairT x y).
-Hints Immediate sym_id sym_not_id : core v62.
+Definition prodT_curry (A B C:Type) (f:A -> B -> C)
+ (p:prodT A B) : C := match p with
+ | pairT x y => f x y
+ end.
-V7only [
-Implicits fstT [1 2].
-Implicits sndT [1 2].
-Implicits pairT [1 2].
-].
+Hint Immediate sym_id sym_not_id: core v62.
diff --git a/theories/Init/Notations.v b/theories/Init/Notations.v
index 624f6c902..ce1d4d7c9 100644
--- a/theories/Init/Notations.v
+++ b/theories/Init/Notations.v
@@ -12,97 +12,80 @@
(** Notations for logical connectives *)
-Uninterpreted Notation "x <-> y" (at level 8, right associativity)
- V8only (at level 95, no associativity).
-Uninterpreted Notation "x /\ y" (at level 6, right associativity)
- V8only (at level 80, right associativity).
-Uninterpreted Notation "x \/ y" (at level 7, right associativity)
- V8only (at level 85, right associativity).
-Uninterpreted Notation "~ x" (at level 5, right associativity)
- V8only (at level 75, right associativity).
+Reserved Notation "x <-> y" (at level 95, no associativity).
+Reserved Notation "x /\ y" (at level 80, right associativity).
+Reserved Notation "x \/ y" (at level 85, right associativity).
+Reserved Notation "~ x" (at level 75, right associativity).
(** Notations for equality and inequalities *)
-Uninterpreted Notation "x = y :> T"
- (at level 5, y at next level, no associativity).
-Uninterpreted Notation "x = y"
- (at level 5, no associativity).
-Uninterpreted Notation "x = y = z"
- (at level 5, no associativity, y at next level).
+Reserved Notation "x = y :> T"
+(at level 70, y at next level, no associativity).
+Reserved Notation "x = y" (at level 70, no associativity).
+Reserved Notation "x = y = z"
+(at level 70, no associativity, y at next level).
-Uninterpreted Notation "x <> y :> T"
- (at level 5, y at next level, no associativity).
-Uninterpreted Notation "x <> y"
- (at level 5, no associativity).
+Reserved Notation "x <> y :> T"
+(at level 70, y at next level, no associativity).
+Reserved Notation "x <> y" (at level 70, no associativity).
-Uninterpreted V8Notation "x <= y" (at level 70, no associativity).
-Uninterpreted V8Notation "x < y" (at level 70, no associativity).
-Uninterpreted V8Notation "x >= y" (at level 70, no associativity).
-Uninterpreted V8Notation "x > y" (at level 70, no associativity).
+Reserved Notation "x <= y" (at level 70, no associativity).
+Reserved Notation "x < y" (at level 70, no associativity).
+Reserved Notation "x >= y" (at level 70, no associativity).
+Reserved Notation "x > y" (at level 70, no associativity).
-Uninterpreted V8Notation "x <= y <= z" (at level 70, y at next level).
-Uninterpreted V8Notation "x <= y < z" (at level 70, y at next level).
-Uninterpreted V8Notation "x < y < z" (at level 70, y at next level).
-Uninterpreted V8Notation "x < y <= z" (at level 70, y at next level).
+Reserved Notation "x <= y <= z" (at level 70, y at next level).
+Reserved Notation "x <= y < z" (at level 70, y at next level).
+Reserved Notation "x < y < z" (at level 70, y at next level).
+Reserved Notation "x < y <= z" (at level 70, y at next level).
(** Arithmetical notations (also used for type constructors) *)
-Uninterpreted Notation "x + y" (at level 4, left associativity).
-Uninterpreted V8Notation "x - y" (at level 50, left associativity).
-Uninterpreted Notation "x * y" (at level 3, right associativity)
- V8only (at level 40, left associativity).
-Uninterpreted V8Notation "x / y" (at level 40, left associativity).
-Uninterpreted V8Notation "- x" (at level 35, right associativity).
-Uninterpreted V8Notation "/ x" (at level 35, right associativity).
-Uninterpreted V8Notation "x ^ y" (at level 30, left associativity).
+Reserved Notation "x + y" (at level 50, left associativity).
+Reserved Notation "x - y" (at level 50, left associativity).
+Reserved Notation "x * y" (at level 40, left associativity).
+Reserved Notation "x / y" (at level 40, left associativity).
+Reserved Notation "- x" (at level 35, right associativity).
+Reserved Notation "/ x" (at level 35, right associativity).
+Reserved Notation "x ^ y" (at level 30, left associativity).
(** Notations for pairs *)
-Uninterpreted Notation "( x , y )" (at level 0)
- V8only "x , y" (at level 250, left associativity).
+Reserved Notation "x , y" (at level 250, left associativity).
(** Notations for sum-types *)
(* Home-made factorization at level 4 to parse B+{x:A|P} without parentheses *)
-Uninterpreted Notation "B + { x : A | P }"
- (at level 4, left associativity, only parsing)
- V8only (at level 50, x at level 99, left associativity, only parsing).
+Reserved Notation "B + { x : A | P }"
+(at level 50, x at level 99, left associativity, only parsing).
-Uninterpreted Notation "B + { x : A | P & Q }"
- (at level 4, left associativity, only parsing)
- V8only (at level 50, x at level 99, left associativity, only parsing).
+Reserved Notation "B + { x : A | P & Q }"
+(at level 50, x at level 99, left associativity, only parsing).
-Uninterpreted Notation "B + { x : A & P }"
- (at level 4, left associativity, only parsing)
- V8only (at level 50, x at level 99, left associativity, only parsing).
+Reserved Notation "B + { x : A & P }"
+(at level 50, x at level 99, left associativity, only parsing).
-Uninterpreted Notation "B + { x : A & P & Q }"
- (at level 4, left associativity, only parsing)
- V8only (at level 50, x at level 99, left associativity, only parsing).
+Reserved Notation "B + { x : A & P & Q }"
+(at level 50, x at level 99, left associativity, only parsing).
(* At level 1 to factor with {x:A|P} etc *)
-Uninterpreted Notation "{ A } + { B }" (at level 1)
- V8only (at level 0, A at level 99).
+Reserved Notation "{ A } + { B }" (at level 0, A at level 99).
-Uninterpreted Notation "A + { B }" (at level 4, left associativity)
- V8only (at level 50, B at level 99, left associativity).
+Reserved Notation "A + { B }"
+(at level 50, B at level 99, left associativity).
(** Notations for sigma-types or subsets *)
-Uninterpreted Notation "{ x : A | P }" (at level 1)
- V8only (at level 0, x at level 99).
-Uninterpreted Notation "{ x : A | P & Q }" (at level 1)
- V8only (at level 0, x at level 99).
+Reserved Notation "{ x : A | P }" (at level 0, x at level 99).
+Reserved Notation "{ x : A | P & Q }" (at level 0, x at level 99).
-Uninterpreted Notation "{ x : A & P }" (at level 1)
- V8only (at level 0, x at level 99).
-Uninterpreted Notation "{ x : A & P & Q }" (at level 1)
- V8only (at level 0, x at level 99).
+Reserved Notation "{ x : A & P }" (at level 0, x at level 99).
+Reserved Notation "{ x : A & P & Q }" (at level 0, x at level 99).
-Delimits Scope type_scope with type.
-Delimits Scope core_scope with core.
+Delimit Scope type_scope with type.
+Delimit Scope core_scope with core.
Open Scope core_scope.
-Open Scope type_scope.
+Open Scope type_scope. \ No newline at end of file
diff --git a/theories/Init/Peano.v b/theories/Init/Peano.v
index 2356c9cb5..3506b9bab 100755
--- a/theories/Init/Peano.v
+++ b/theories/Init/Peano.v
@@ -23,196 +23,188 @@
including Peano's axioms of arithmetic (in Coq, these are in fact provable)
Case analysis on [nat] and induction on [nat * nat] are provided too *)
-Require Notations.
-Require Datatypes.
-Require Logic.
+Require Import Notations.
+Require Import Datatypes.
+Require Import Logic.
Open Scope nat_scope.
-Definition eq_S := (f_equal nat nat S).
+Definition eq_S := f_equal S.
-Hint eq_S : v62 := Resolve (f_equal nat nat S).
-Hint eq_nat_unary : core := Resolve (f_equal nat).
+Hint Resolve (f_equal S): v62.
+Hint Resolve (f_equal (A:=nat)): core.
(** The predecessor function *)
-Definition pred : nat->nat := [n:nat](Cases n of O => O | (S u) => u end).
-Hint eq_pred : v62 := Resolve (f_equal nat nat pred).
+Definition pred (n:nat) : nat := match n with
+ | O => 0
+ | S u => u
+ end.
+Hint Resolve (f_equal pred): v62.
-Theorem pred_Sn : (m:nat) m=(pred (S m)).
+Theorem pred_Sn : forall n:nat, n = pred (S n).
Proof.
- Auto.
+ auto.
Qed.
-Theorem eq_add_S : (n,m:nat) (S n)=(S m) -> n=m.
+Theorem eq_add_S : forall n m:nat, S n = S m -> n = m.
Proof.
- Intros n m H ; Change (pred (S n))=(pred (S m)); Auto.
+ intros n m H; change (pred (S n) = pred (S m)) in |- *; auto.
Qed.
-Hints Immediate eq_add_S : core v62.
+Hint Immediate eq_add_S: core v62.
(** A consequence of the previous axioms *)
-Theorem not_eq_S : (n,m:nat) ~(n=m) -> ~((S n)=(S m)).
+Theorem not_eq_S : forall n m:nat, n <> m -> S n <> S m.
Proof.
- Red; Auto.
+ red in |- *; auto.
Qed.
-Hints Resolve not_eq_S : core v62.
+Hint Resolve not_eq_S: core v62.
-Definition IsSucc : nat->Prop
- := [n:nat]Cases n of O => False | (S p) => True end.
+Definition IsSucc (n:nat) : Prop :=
+ match n with
+ | O => False
+ | S p => True
+ end.
-Theorem O_S : (n:nat)~(O=(S n)).
+Theorem O_S : forall n:nat, 0 <> S n.
Proof.
- Red;Intros n H.
- Change (IsSucc O).
- Rewrite <- (sym_eq nat O (S n));[Exact I | Assumption].
+ red in |- *; intros n H.
+ change (IsSucc 0) in |- *.
+ rewrite <- (sym_eq (x:=0) (y:=(S n))); [ exact I | assumption ].
Qed.
-Hints Resolve O_S : core v62.
+Hint Resolve O_S: core v62.
-Theorem n_Sn : (n:nat) ~(n=(S n)).
+Theorem n_Sn : forall n:nat, n <> S n.
Proof.
- NewInduction n ; Auto.
+ induction n; auto.
Qed.
-Hints Resolve n_Sn : core v62.
+Hint Resolve n_Sn: core v62.
(** Addition *)
-Fixpoint plus [n:nat] : nat -> nat :=
- [m:nat]Cases n of
- O => m
- | (S p) => (S (plus p m)) end.
-Hint eq_plus : v62 := Resolve (f_equal2 nat nat nat plus).
-Hint eq_nat_binary : core := Resolve (f_equal2 nat nat).
+Fixpoint plus (n m:nat) {struct n} : nat :=
+ match n with
+ | O => m
+ | S p => S (plus p m)
+ end.
+Hint Resolve (f_equal2 plus): v62.
+Hint Resolve (f_equal2 (A1:=nat) (A2:=nat)): core.
-V8Infix "+" plus : nat_scope.
+Infix "+" := plus : nat_scope.
-Lemma plus_n_O : (n:nat) n=(plus n O).
+Lemma plus_n_O : forall n:nat, n = n + 0.
Proof.
- NewInduction n ; Simpl ; Auto.
+ induction n; simpl in |- *; auto.
Qed.
-Hints Resolve plus_n_O : core v62.
+Hint Resolve plus_n_O: core v62.
-Lemma plus_O_n : (n:nat) (plus O n)=n.
+Lemma plus_O_n : forall n:nat, 0 + n = n.
Proof.
- Auto.
+ auto.
Qed.
-Lemma plus_n_Sm : (n,m:nat) (S (plus n m))=(plus n (S m)).
+Lemma plus_n_Sm : forall n m:nat, S (n + m) = n + S m.
Proof.
- Intros n m; NewInduction n; Simpl; Auto.
+ intros n m; induction n; simpl in |- *; auto.
Qed.
-Hints Resolve plus_n_Sm : core v62.
+Hint Resolve plus_n_Sm: core v62.
-Lemma plus_Sn_m : (n,m:nat)(plus (S n) m)=(S (plus n m)).
+Lemma plus_Sn_m : forall n m:nat, S n + m = S (n + m).
Proof.
- Auto.
+ auto.
Qed.
(** Multiplication *)
-Fixpoint mult [n:nat] : nat -> nat :=
- [m:nat]Cases n of O => O
- | (S p) => (plus m (mult p m)) end.
-Hint eq_mult : core v62 := Resolve (f_equal2 nat nat nat mult).
+Fixpoint mult (n m:nat) {struct n} : nat :=
+ match n with
+ | O => 0
+ | S p => m + mult p m
+ end.
+Hint Resolve (f_equal2 mult): core v62.
-V8Infix "*" mult : nat_scope.
+Infix "*" := mult : nat_scope.
-Lemma mult_n_O : (n:nat) O=(mult n O).
+Lemma mult_n_O : forall n:nat, 0 = n * 0.
Proof.
- NewInduction n; Simpl; Auto.
+ induction n; simpl in |- *; auto.
Qed.
-Hints Resolve mult_n_O : core v62.
+Hint Resolve mult_n_O: core v62.
-Lemma mult_n_Sm : (n,m:nat) (plus (mult n m) n)=(mult n (S m)).
+Lemma mult_n_Sm : forall n m:nat, n * m + n = n * S m.
Proof.
- Intros; NewInduction n as [|p H]; Simpl; Auto.
- NewDestruct H; Rewrite <- plus_n_Sm; Apply (f_equal nat nat S).
- Pattern 1 3 m; Elim m; Simpl; Auto.
+ intros; induction n as [| p H]; simpl in |- *; auto.
+ destruct H; rewrite <- plus_n_Sm; apply (f_equal S).
+ pattern m at 1 3 in |- *; elim m; simpl in |- *; auto.
Qed.
-Hints Resolve mult_n_Sm : core v62.
+Hint Resolve mult_n_Sm: core v62.
(** Definition of subtraction on [nat] : [m-n] is [0] if [n>=m] *)
-Fixpoint minus [n:nat] : nat -> nat :=
- [m:nat]Cases n m of
- O _ => O
- | (S k) O => (S k)
- | (S k) (S l) => (minus k l)
- end.
+Fixpoint minus (n m:nat) {struct n} : nat :=
+ match n, m with
+ | O, _ => 0
+ | S k, O => S k
+ | S k, S l => minus k l
+ end.
-V8Infix "-" minus : nat_scope.
+Infix "-" := minus : nat_scope.
(** Definition of the usual orders, the basic properties of [le] and [lt]
can be found in files Le and Lt *)
(** An inductive definition to define the order *)
-Inductive le [n:nat] : nat -> Prop
- := le_n : (le n n)
- | le_S : (m:nat)(le n m)->(le n (S m)).
+Inductive le (n:nat) : nat -> Prop :=
+ | le_n : le n n
+ | le_S : forall m:nat, le n m -> le n (S m).
-V8Infix "<=" le : nat_scope.
+Infix "<=" := le : nat_scope.
-Hint constr_le : core v62 := Constructors le.
+Hint Constructors le: core v62.
(*i equivalent to : "Hints Resolve le_n le_S : core v62." i*)
-Definition lt := [n,m:nat](le (S n) m).
-Hints Unfold lt : core v62.
+Definition lt (n m:nat) := S n <= m.
+Hint Unfold lt: core v62.
-V8Infix "<" lt : nat_scope.
+Infix "<" := lt : nat_scope.
-Definition ge := [n,m:nat](le m n).
-Hints Unfold ge : core v62.
+Definition ge (n m:nat) := m <= n.
+Hint Unfold ge: core v62.
-V8Infix ">=" ge : nat_scope.
+Infix ">=" := ge : nat_scope.
-Definition gt := [n,m:nat](lt m n).
-Hints Unfold gt : core v62.
+Definition gt (n m:nat) := m < n.
+Hint Unfold gt: core v62.
-V8Infix ">" gt : nat_scope.
+Infix ">" := gt : nat_scope.
-V8Notation "x <= y <= z" := (le x y)/\(le y z) : nat_scope.
-V8Notation "x <= y < z" := (le x y)/\(lt y z) : nat_scope.
-V8Notation "x < y < z" := (lt x y)/\(lt y z) : nat_scope.
-V8Notation "x < y <= z" := (lt x y)/\(le y z) : nat_scope.
+Notation "x <= y <= z" := (x <= y /\ y <= z) : nat_scope.
+Notation "x <= y < z" := (x <= y /\ y < z) : nat_scope.
+Notation "x < y < z" := (x < y /\ y < z) : nat_scope.
+Notation "x < y <= z" := (x < y /\ y <= z) : nat_scope.
(** Pattern-Matching on natural numbers *)
-Theorem nat_case : (n:nat)(P:nat->Prop)(P O)->((m:nat)(P (S m)))->(P n).
+Theorem nat_case :
+ forall (n:nat) (P:nat -> Prop), P 0 -> (forall m:nat, P (S m)) -> P n.
Proof.
- NewInduction n ; Auto.
+ induction n; auto.
Qed.
(** Principle of double induction *)
-Theorem nat_double_ind : (R:nat->nat->Prop)
- ((n:nat)(R O n)) -> ((n:nat)(R (S n) O))
- -> ((n,m:nat)(R n m)->(R (S n) (S m)))
- -> (n,m:nat)(R n m).
+Theorem nat_double_ind :
+ forall R:nat -> nat -> Prop,
+ (forall n:nat, R 0 n) ->
+ (forall n:nat, R (S n) 0) ->
+ (forall n m:nat, R n m -> R (S n) (S m)) -> forall n m:nat, R n m.
Proof.
- NewInduction n; Auto.
- NewDestruct m; Auto.
+ induction n; auto.
+ destruct m as [| n0]; auto.
Qed.
(** Notations *)
-V7only[
-Syntax constr
- level 0:
- S [ (S $p) ] -> [$p:"nat_printer":9]
- | O [ O ] -> ["(0)"].
-].
-
-V7only [
-(* For parsing/printing based on scopes *)
-Module nat_scope.
-Infix 4 "+" plus : nat_scope.
-Infix 3 "*" mult : nat_scope.
-Infix 4 "-" minus : nat_scope.
-Infix NONA 5 "<=" le : nat_scope.
-Infix NONA 5 "<" lt : nat_scope.
-Infix NONA 5 ">=" ge : nat_scope.
-Infix NONA 5 ">" gt : nat_scope.
-End nat_scope.
-].
diff --git a/theories/Init/Prelude.v b/theories/Init/Prelude.v
index 7325cc771..f5be0d594 100755
--- a/theories/Init/Prelude.v
+++ b/theories/Init/Prelude.v
@@ -13,4 +13,4 @@ Require Export Logic.
Require Export Datatypes.
Require Export Specif.
Require Export Peano.
-Require Export Wf.
+Require Export Wf. \ No newline at end of file
diff --git a/theories/Init/Specif.v b/theories/Init/Specif.v
index 2e49fab04..eb775505f 100755
--- a/theories/Init/Specif.v
+++ b/theories/Init/Specif.v
@@ -9,13 +9,12 @@
(*i $Id$ i*)
Set Implicit Arguments.
-V7only [Unset Implicit Arguments.].
(** Basic specifications : Sets containing logical information *)
-Require Notations.
-Require Datatypes.
-Require Logic.
+Require Import Notations.
+Require Import Datatypes.
+Require Import Logic.
(** Subsets *)
@@ -24,31 +23,33 @@ Require Logic.
Similarly [(sig2 A P Q)], or [{x:A | (P x) & (Q x)}], denotes the subset
of elements of the Set [A] which satisfy both [P] and [Q]. *)
-Inductive sig [A:Set;P:A->Prop] : Set
- := exist : (x:A)(P x) -> (sig A P).
+Inductive sig (A:Set) (P:A -> Prop) : Set :=
+ exist : forall x:A, P x -> sig (A:=A) P.
-Inductive sig2 [A:Set;P,Q:A->Prop] : Set
- := exist2 : (x:A)(P x) -> (Q x) -> (sig2 A P Q).
+Inductive sig2 (A:Set) (P Q:A -> Prop) : Set :=
+ exist2 : forall x:A, P x -> Q x -> sig2 (A:=A) P Q.
(** [(sigS A P)], or more suggestively [{x:A & (P x)}], is a subtle variant
of subset where [P] is now of type [Set].
Similarly for [(sigS2 A P Q)], also written [{x:A & (P x) & (Q x)}]. *)
-Inductive sigS [A:Set;P:A->Set] : Set
- := existS : (x:A)(P x) -> (sigS A P).
+Inductive sigS (A:Set) (P:A -> Set) : Set :=
+ existS : forall x:A, P x -> sigS (A:=A) P.
-Inductive sigS2 [A:Set;P,Q:A->Set] : Set
- := existS2 : (x:A)(P x) -> (Q x) -> (sigS2 A P Q).
+Inductive sigS2 (A:Set) (P Q:A -> Set) : Set :=
+ existS2 : forall x:A, P x -> Q x -> sigS2 (A:=A) P Q.
Arguments Scope sig [type_scope type_scope].
Arguments Scope sig2 [type_scope type_scope type_scope].
Arguments Scope sigS [type_scope type_scope].
Arguments Scope sigS2 [type_scope type_scope type_scope].
-Notation "{ x : A | P }" := (sig A [x:A]P) : type_scope.
-Notation "{ x : A | P & Q }" := (sig2 A [x:A]P [x:A]Q) : type_scope.
-Notation "{ x : A & P }" := (sigS A [x:A]P) : type_scope.
-Notation "{ x : A & P & Q }" := (sigS2 A [x:A]P [x:A]Q) : type_scope.
+Notation "{ x : A | P }" := (sig (fun x:A => P)) : type_scope.
+Notation "{ x : A | P & Q }" := (sig2 (fun x:A => P) (fun x:A => Q)) :
+ type_scope.
+Notation "{ x : A & P }" := (sigS (fun x:A => P)) : type_scope.
+Notation "{ x : A & P & Q }" := (sigS2 (fun x:A => P) (fun x:A => Q)) :
+ type_scope.
Add Printing Let sig.
Add Printing Let sig2.
@@ -60,15 +61,17 @@ Add Printing Let sigS2.
Section Subset_projections.
- Variable A:Set.
- Variable P:A->Prop.
+ Variable A : Set.
+ Variable P : A -> Prop.
- Definition proj1_sig :=
- [e:(sig A P)]Cases e of (exist a b) => a end.
+ Definition proj1_sig (e:sig P) := match e with
+ | exist a b => a
+ end.
- Definition proj2_sig :=
- [e:(sig A P)]
- <[e:(sig A P)](P (proj1_sig e))>Cases e of (exist a b) => b end.
+ Definition proj2_sig (e:sig P) :=
+ match e return P (proj1_sig e) with
+ | exist a b => b
+ end.
End Subset_projections.
@@ -77,46 +80,46 @@ End Subset_projections.
Section Projections.
- Variable A:Set.
- Variable P:A->Set.
+ Variable A : Set.
+ Variable P : A -> Set.
(** An element [y] of a subset [{x:A & (P x)}] is the pair of an [a] of
type [A] and of a proof [h] that [a] satisfies [P].
Then [(projS1 y)] is the witness [a]
and [(projS2 y)] is the proof of [(P a)] *)
- Definition projS1 : (sigS A P) -> A
- := [x:(sigS A P)]Cases x of (existS a _) => a end.
- Definition projS2 : (x:(sigS A P))(P (projS1 x))
- := [x:(sigS A P)]<[x:(sigS A P)](P (projS1 x))>
- Cases x of (existS _ h) => h end.
+ Definition projS1 (x:sigS P) : A := match x with
+ | existS a _ => a
+ end.
+ Definition projS2 (x:sigS P) : P (projS1 x) :=
+ match x return P (projS1 x) with
+ | existS _ h => h
+ end.
End Projections.
(** Extended_booleans *)
-Inductive sumbool [A,B:Prop] : Set
- := left : A -> {A}+{B}
- | right : B -> {A}+{B}
+Inductive sumbool (A B:Prop) : Set :=
+ | left : A -> {A} + {B}
+ | right : B -> {A} + {B}
+ where "{ A } + { B }" := (sumbool A B) : type_scope.
-where "{ A } + { B }" := (sumbool A B) : type_scope.
-
-Inductive sumor [A:Set;B:Prop] : Set
- := inleft : A -> A+{B}
- | inright : B -> A+{B}
-
-where "A + { B }" := (sumor A B) : type_scope.
+Inductive sumor (A:Set) (B:Prop) : Set :=
+ | inleft : A -> A + {B}
+ | inright : B -> A + {B}
+ where "A + { B }" := (sumor A B) : type_scope.
(* Factorizing "sumor" at level 4 to parse B+{x:A|P} without parentheses *)
-Notation "B + { x : A | P }" := B + (sig A [x:A]P)
+Notation "B + { x : A | P }" := (B + sig (fun x:A => P))
(only parsing) : type_scope.
-Notation "B + { x : A | P & Q }" := B + (sig2 A [x:A]P [x:A]Q)
+Notation "B + { x : A | P & Q }" := (B + sig2 (fun x:A => P) (fun x:A => Q))
(only parsing) : type_scope.
-Notation "B + { x : A & P }" := B + (sigS A [x:A]P)
+Notation "B + { x : A & P }" := (B + sigS (fun x:A => P))
(only parsing) : type_scope.
-Notation "B + { x : A & P & Q }" := B + (sigS2 A [x:A]P [x:A]Q)
+Notation "B + { x : A & P & Q }" := (B + sigS2 (fun x:A => P) (fun x:A => Q))
(only parsing) : type_scope.
(** Choice *)
@@ -125,35 +128,46 @@ Section Choice_lemmas.
(** The following lemmas state various forms of the axiom of choice *)
- Variables S,S':Set.
- Variable R:S->S'->Prop.
- Variable R':S->S'->Set.
- Variables R1,R2 :S->Prop.
+ Variables S S' : Set.
+ Variable R : S -> S' -> Prop.
+ Variable R' : S -> S' -> Set.
+ Variables R1 R2 : S -> Prop.
- Lemma Choice : ((x:S)(sig ? [y:S'](R x y))) ->
- (sig ? [f:S->S'](z:S)(R z (f z))).
+ Lemma Choice :
+ (forall x:S, sig (fun y:S' => R x y)) ->
+ sig (fun f:S -> S' => forall z:S, R z (f z)).
Proof.
- Intro H.
- Exists [z:S]Cases (H z) of (exist y _) => y end.
- Intro z; NewDestruct (H z); Trivial.
+ intro H.
+ exists (fun z:S => match H z with
+ | exist y _ => y
+ end).
+ intro z; destruct (H z); trivial.
Qed.
- Lemma Choice2 : ((x:S)(sigS ? [y:S'](R' x y))) ->
- (sigS ? [f:S->S'](z:S)(R' z (f z))).
+ Lemma Choice2 :
+ (forall x:S, sigS (fun y:S' => R' x y)) ->
+ sigS (fun f:S -> S' => forall z:S, R' z (f z)).
Proof.
- Intro H.
- Exists [z:S]Cases (H z) of (existS y _) => y end.
- Intro z; NewDestruct (H z); Trivial.
+ intro H.
+ exists (fun z:S => match H z with
+ | existS y _ => y
+ end).
+ intro z; destruct (H z); trivial.
Qed.
- Lemma bool_choice :
- ((x:S)(sumbool (R1 x) (R2 x))) ->
- (sig ? [f:S->bool] (x:S)( ((f x)=true /\ (R1 x))
- \/ ((f x)=false /\ (R2 x)))).
+ Lemma bool_choice :
+ (forall x:S, {R1 x} + {R2 x}) ->
+ sig
+ (fun f:S -> bool =>
+ forall x:S, f x = true /\ R1 x \/ f x = false /\ R2 x).
Proof.
- Intro H.
- Exists [z:S]Cases (H z) of (left _) => true | (right _) => false end.
- Intro z; NewDestruct (H z); Auto.
+ intro H.
+ exists
+ (fun z:S => match H z with
+ | left _ => true
+ | right _ => false
+ end).
+ intro z; destruct (H z); auto.
Qed.
End Choice_lemmas.
@@ -165,51 +179,41 @@ End Choice_lemmas.
Definition Exc := option.
Definition value := Some.
-Definition error := !None.
+Definition error := @None.
-Implicits error [1].
+Implicit Arguments error [A].
Definition except := False_rec. (* for compatibility with previous versions *)
-Implicits except [1].
+Implicit Arguments except [P].
-V7only [
-Notation Except := (!except ?) (only parsing).
-Notation Error := (!error ?) (only parsing).
-V7only [Implicits error [].].
-V7only [Implicits except [].].
-].
-Theorem absurd_set : (A:Prop)(C:Set)A->(~A)->C.
+Theorem absurd_set : forall (A:Prop) (C:Set), A -> ~ A -> C.
Proof.
- Intros A C h1 h2.
- Apply False_rec.
- Apply (h2 h1).
+ intros A C h1 h2.
+ apply False_rec.
+ apply (h2 h1).
Qed.
-Hints Resolve left right inleft inright : core v62.
+Hint Resolve left right inleft inright: core v62.
(** Sigma Type at Type level [sigT] *)
-Inductive sigT [A:Type;P:A->Type] : Type
- := existT : (x:A)(P x) -> (sigT A P).
+Inductive sigT (A:Type) (P:A -> Type) : Type :=
+ existT : forall x:A, P x -> sigT (A:=A) P.
Section projections_sigT.
- Variable A:Type.
- Variable P:A->Type.
+ Variable A : Type.
+ Variable P : A -> Type.
- Definition projT1 : (sigT A P) -> A
- := [H:(sigT A P)]Cases H of (existT x _) => x end.
+ Definition projT1 (H:sigT P) : A := match H with
+ | existT x _ => x
+ end.
- Definition projT2 : (x:(sigT A P))(P (projT1 x))
- := [H:(sigT A P)]<[H:(sigT A P)](P (projT1 H))>
- Cases H of (existT x h) => h end.
+ Definition projT2 : forall x:sigT P, P (projT1 x) :=
+ fun H:sigT P => match H return P (projT1 H) with
+ | existT x h => h
+ end.
End projections_sigT.
-V7only [
-Notation ProjS1 := (projS1 ? ?).
-Notation ProjS2 := (projS2 ? ?).
-Notation Value := (value ?).
-].
-
diff --git a/theories/Init/Wf.v b/theories/Init/Wf.v
index ee7da4ba6..476ec4a54 100755
--- a/theories/Init/Wf.v
+++ b/theories/Init/Wf.v
@@ -7,7 +7,6 @@
(***********************************************************************)
Set Implicit Arguments.
-V7only [Unset Implicit Arguments.].
(*i $Id$ i*)
@@ -17,24 +16,24 @@ V7only [Unset Implicit Arguments.].
from a well-founded ordering on a given set *)
-Require Notations.
-Require Logic.
-Require Datatypes.
+Require Import Notations.
+Require Import Logic.
+Require Import Datatypes.
(** Well-founded induction principle on Prop *)
-Chapter Well_founded.
+Section Well_founded.
Variable A : Set.
Variable R : A -> A -> Prop.
(** The accessibility predicate is defined to be non-informative *)
- Inductive Acc : A -> Prop
- := Acc_intro : (x:A)((y:A)(R y x)->(Acc y))->(Acc x).
+ Inductive Acc : A -> Prop :=
+ Acc_intro : forall x:A, (forall y:A, R y x -> Acc y) -> Acc x.
- Lemma Acc_inv : (x:A)(Acc x) -> (y:A)(R y x) -> (Acc y).
- NewDestruct 1; Trivial.
+ Lemma Acc_inv : forall x:A, Acc x -> forall y:A, R y x -> Acc y.
+ destruct 1; trivial.
Defined.
(** the informative elimination :
@@ -42,50 +41,56 @@ Chapter Well_founded.
Section AccRecType.
Variable P : A -> Type.
- Variable F : (x:A)((y:A)(R y x)->(Acc y))->((y:A)(R y x)->(P y))->(P x).
+ 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)] : (P x)
- := (F x (Acc_inv x a) ([y:A][h:(R y x)](Acc_rect y (Acc_inv x a y h)))).
+ 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 (x:=y) (Acc_inv a h)).
End AccRecType.
- Definition Acc_rec [P:A->Set] := (Acc_rect P).
+ Definition Acc_rec (P:A -> Set) := Acc_rect P.
(** A simplified version of Acc_rec(t) *)
Section AccIter.
Variable P : A -> Type.
- Variable F : (x:A)((y:A)(R y x)-> (P y))->(P x).
+ Variable F : forall x:A, (forall y:A, R y x -> P y) -> P x.
- Fixpoint Acc_iter [x:A;a:(Acc x)] : (P x)
- := (F x ([y:A][h:(R y x)](Acc_iter y (Acc_inv x a y h)))).
+ Fixpoint Acc_iter (x:A) (a:Acc x) {struct a} : P x :=
+ F (fun (y:A) (h:R y x) => Acc_iter (x:=y) (Acc_inv a h)).
End AccIter.
(** A relation is well-founded if every element is accessible *)
- Definition well_founded := (a:A)(Acc a).
+ Definition well_founded := forall a:A, Acc a.
(** well-founded induction on Set and Prop *)
Hypothesis Rwf : well_founded.
- Theorem well_founded_induction_type :
- (P:A->Type)((x:A)((y:A)(R y x)->(P y))->(P x))->(a:A)(P a).
+ Theorem well_founded_induction_type :
+ forall P:A -> Type,
+ (forall x:A, (forall y:A, R y x -> P y) -> P x) -> forall a:A, P a.
Proof.
- Intros; Apply (Acc_iter P); Auto.
+ intros; apply (Acc_iter P); auto.
Defined.
Theorem well_founded_induction :
- (P:A->Set)((x:A)((y:A)(R y x)->(P y))->(P x))->(a:A)(P a).
+ forall P:A -> Set,
+ (forall x:A, (forall y:A, R y x -> P y) -> P x) -> forall a:A, P a.
Proof.
- Exact [P:A->Set](well_founded_induction_type P).
+ exact (fun P:A -> Set => well_founded_induction_type P).
Defined.
- Theorem well_founded_ind :
- (P:A->Prop)((x:A)((y:A)(R y x)->(P y))->(P x))->(a:A)(P a).
+ Theorem well_founded_ind :
+ forall P:A -> Prop,
+ (forall x:A, (forall y:A, R y x -> P y) -> P x) -> forall a:A, P a.
Proof.
- Exact [P:A->Prop](well_founded_induction_type P).
+ exact (fun P:A -> Prop => well_founded_induction_type P).
Defined.
(** Building fixpoints *)
@@ -93,40 +98,41 @@ Chapter Well_founded.
Section FixPoint.
Variable P : A -> Set.
-Variable F : (x:A)((y:A)(R y x)->(P y))->(P x).
+Variable F : forall x:A, (forall y:A, R y x -> P y) -> P x.
-Fixpoint Fix_F [x:A;r:(Acc x)] : (P x) :=
- (F x [y:A][p:(R y x)](Fix_F y (Acc_inv x r y p))).
+Fixpoint Fix_F (x:A) (r:Acc x) {struct r} : P x :=
+ F (fun (y:A) (p:R y x) => Fix_F (x:=y) (Acc_inv r p)).
-Definition fix := [x:A](Fix_F x (Rwf x)).
+Definition Fix (x:A) := Fix_F (Rwf x).
(** Proof that [well_founded_induction] satisfies the fixpoint equation.
It requires an extra property of the functional *)
-Hypothesis F_ext :
- (x:A)(f,g:(y:A)(R y x)->(P y))
- ((y:A)(p:(R y x))((f y p)=(g y p)))->(F x f)=(F x g).
+Hypothesis
+ F_ext :
+ forall (x:A) (f g:forall y:A, R y x -> P y),
+ (forall (y:A) (p:R y x), f y p = g y p) -> F f = F g.
Scheme Acc_inv_dep := Induction for Acc Sort Prop.
-Lemma Fix_F_eq
- : (x:A)(r:(Acc x))
- (F x [y:A][p:(R y x)](Fix_F y (Acc_inv x r y p)))=(Fix_F x r).
-NewDestruct r using Acc_inv_dep; Auto.
+Lemma Fix_F_eq :
+ forall (x:A) (r:Acc x),
+ F (fun (y:A) (p:R y x) => Fix_F (Acc_inv r p)) = Fix_F r.
+destruct r using Acc_inv_dep; auto.
Qed.
-Lemma Fix_F_inv : (x:A)(r,s:(Acc x))(Fix_F x r)=(Fix_F x s).
-Intro x; NewInduction (Rwf x); Intros.
-Rewrite <- (Fix_F_eq x r); Rewrite <- (Fix_F_eq x s); Intros.
-Apply F_ext; Auto.
+Lemma Fix_F_inv : forall (x:A) (r s:Acc x), Fix_F r = Fix_F s.
+intro x; induction (Rwf x); intros.
+rewrite <- (Fix_F_eq r); rewrite <- (Fix_F_eq s); intros.
+apply F_ext; auto.
Qed.
-Lemma Fix_eq : (x:A)(fix x)=(F x [y:A][p:(R y x)](fix y)).
-Intro x; Unfold fix.
-Rewrite <- (Fix_F_eq x).
-Apply F_ext; Intros.
-Apply Fix_F_inv.
+Lemma Fix_eq : forall x:A, Fix x = F (fun (y:A) (p:R y x) => Fix y).
+intro x; unfold Fix in |- *.
+rewrite <- (Fix_F_eq (x:=x)).
+apply F_ext; intros.
+apply Fix_F_inv.
Qed.
End FixPoint.
@@ -135,24 +141,31 @@ End Well_founded.
(** A recursor over pairs *)
-Chapter Well_founded_2.
+Section Well_founded_2.
- Variable A,B : Set.
+ Variables A B : Set.
Variable R : A * B -> A * B -> Prop.
Variable P : A -> B -> Type.
- Variable F : (x:A)(x':B)((y:A)(y':B)(R (y,y') (x,x'))-> (P y y'))->(P x x').
-
- Fixpoint Acc_iter_2 [x:A;x':B;a:(Acc ? R (x,x'))] : (P x x')
- := (F x x' ([y:A][y':B][h:(R (y,y') (x,x'))](Acc_iter_2 y y' (Acc_inv ? ? (x,x') a (y,y') h)))).
-
- Hypothesis Rwf : (well_founded ? R).
-
- Theorem well_founded_induction_type_2 :
- ((x:A)(x':B)((y:A)(y':B)(R (y,y') (x,x'))->(P y y'))->(P x x'))->(a:A)(b:B)(P a b).
+ Variable
+ F :
+ forall (x:A) (x':B),
+ (forall (y:A) (y':B), R (y, y') (x, x') -> P y y') -> P x x'.
+
+ Fixpoint Acc_iter_2 (x:A) (x':B) (a:Acc R (x, x')) {struct a} :
+ P x x' :=
+ F
+ (fun (y:A) (y':B) (h:R (y, y') (x, x')) =>
+ Acc_iter_2 (x:=y) (x':=y') (Acc_inv a (y, y') h)).
+
+ Hypothesis Rwf : well_founded R.
+
+ Theorem well_founded_induction_type_2 :
+ (forall (x:A) (x':B),
+ (forall (y:A) (y':B), R (y, y') (x, x') -> P y y') -> P x x') ->
+ forall (a:A) (b:B), P a b.
Proof.
- Intros; Apply Acc_iter_2; Auto.
+ intros; apply Acc_iter_2; auto.
Defined.
End Well_founded_2.
-
diff --git a/theories/IntMap/Adalloc.v b/theories/IntMap/Adalloc.v
index 5dcd41c84..550633a21 100644
--- a/theories/IntMap/Adalloc.v
+++ b/theories/IntMap/Adalloc.v
@@ -7,333 +7,359 @@
(***********************************************************************)
(*i $Id$ i*)
-Require Bool.
-Require Sumbool.
-Require ZArith.
-Require Arith.
-Require Addr.
-Require Adist.
-Require Addec.
-Require Map.
-Require Fset.
+Require Import Bool.
+Require Import Sumbool.
+Require Import ZArith.
+Require Import Arith.
+Require Import Addr.
+Require Import Adist.
+Require Import Addec.
+Require Import Map.
+Require Import Fset.
Section AdAlloc.
Variable A : Set.
- Definition nat_of_ad := [a:ad] Cases a of
- ad_z => O
- | (ad_x p) => (convert p)
- end.
-
- Fixpoint nat_le [m:nat] : nat -> bool :=
- Cases m of
- O => [_:nat] true
- | (S m') => [n:nat] Cases n of
- O => false
- | (S n') => (nat_le m' n')
- end
+ Definition nat_of_ad (a:ad) :=
+ match a with
+ | ad_z => 0
+ | ad_x p => nat_of_P p
end.
- Lemma nat_le_correct : (m,n:nat) (le m n) -> (nat_le m n)=true.
+ Fixpoint nat_le (m:nat) : nat -> bool :=
+ match m with
+ | O => fun _:nat => true
+ | S m' =>
+ fun n:nat => match n with
+ | O => false
+ | S n' => nat_le m' n'
+ end
+ end.
+
+ Lemma nat_le_correct : forall m n:nat, m <= n -> nat_le m n = true.
Proof.
- NewInduction m as [|m IHm]. Trivial.
- NewDestruct n. Intro H. Elim (le_Sn_O ? H).
- Intros. Simpl. Apply IHm. Apply le_S_n. Assumption.
+ induction m as [| m IHm]. trivial.
+ destruct n. intro H. elim (le_Sn_O _ H).
+ intros. simpl in |- *. apply IHm. apply le_S_n. assumption.
Qed.
- Lemma nat_le_complete : (m,n:nat) (nat_le m n)=true -> (le m n).
+ Lemma nat_le_complete : forall m n:nat, nat_le m n = true -> m <= n.
Proof.
- NewInduction m. Trivial with arith.
- NewDestruct n. Intro H. Discriminate H.
- Auto with arith.
+ induction m. trivial with arith.
+ destruct n. intro H. discriminate H.
+ auto with arith.
Qed.
- Lemma nat_le_correct_conv : (m,n:nat) (lt m n) -> (nat_le n m)=false.
+ Lemma nat_le_correct_conv : forall m n:nat, m < n -> nat_le n m = false.
Proof.
- Intros. Elim (sumbool_of_bool (nat_le n m)). Intro H0.
- Elim (lt_n_n ? (lt_le_trans ? ? ? H (nat_le_complete ? ? H0))).
- Trivial.
+ intros. elim (sumbool_of_bool (nat_le n m)). intro H0.
+ elim (lt_irrefl _ (lt_le_trans _ _ _ H (nat_le_complete _ _ H0))).
+ trivial.
Qed.
- Lemma nat_le_complete_conv : (m,n:nat) (nat_le n m)=false -> (lt m n).
+ Lemma nat_le_complete_conv : forall m n:nat, nat_le n m = false -> m < n.
Proof.
- Intros. Elim (le_or_lt n m). Intro. Conditional Trivial Rewrite nat_le_correct in H. Discriminate H.
- Trivial.
+ intros. elim (le_or_lt n m). intro. conditional trivial rewrite nat_le_correct in H. discriminate H.
+ trivial.
Qed.
- Definition ad_of_nat := [n:nat] Cases n of
- O => ad_z
- | (S n') => (ad_x (anti_convert n'))
- end.
+ Definition ad_of_nat (n:nat) :=
+ match n with
+ | O => ad_z
+ | S n' => ad_x (P_of_succ_nat n')
+ end.
- Lemma ad_of_nat_of_ad : (a:ad) (ad_of_nat (nat_of_ad a))=a.
+ Lemma ad_of_nat_of_ad : forall a:ad, ad_of_nat (nat_of_ad a) = a.
Proof.
- NewDestruct a as [|p]. Reflexivity.
- Simpl. Elim (ZL4 p). Intros n H. Rewrite H. Simpl. Rewrite <- bij1 in H.
- Rewrite convert_intro with 1:=H. Reflexivity.
+ destruct a as [| p]. reflexivity.
+ simpl in |- *. elim (ZL4 p). intros n H. rewrite H. simpl in |- *. rewrite <- nat_of_P_o_P_of_succ_nat_eq_succ in H.
+ rewrite nat_of_P_inj with (1 := H). reflexivity.
Qed.
- Lemma nat_of_ad_of_nat : (n:nat) (nat_of_ad (ad_of_nat n))=n.
+ Lemma nat_of_ad_of_nat : forall n:nat, nat_of_ad (ad_of_nat n) = n.
Proof.
- NewInduction n. Trivial.
- Intros. Simpl. Apply bij1.
+ induction n. trivial.
+ intros. simpl in |- *. apply nat_of_P_o_P_of_succ_nat_eq_succ.
Qed.
- Definition ad_le := [a,b:ad] (nat_le (nat_of_ad a) (nat_of_ad b)).
+ Definition ad_le (a b:ad) := nat_le (nat_of_ad a) (nat_of_ad b).
- Lemma ad_le_refl : (a:ad) (ad_le a a)=true.
+ Lemma ad_le_refl : forall a:ad, ad_le a a = true.
Proof.
- Intro. Unfold ad_le. Apply nat_le_correct. Apply le_n.
+ intro. unfold ad_le in |- *. apply nat_le_correct. apply le_n.
Qed.
- Lemma ad_le_antisym : (a,b:ad) (ad_le a b)=true -> (ad_le b a)=true -> a=b.
+ Lemma ad_le_antisym :
+ forall a b:ad, ad_le a b = true -> ad_le b a = true -> a = b.
Proof.
- Unfold ad_le. Intros. Rewrite <- (ad_of_nat_of_ad a). Rewrite <- (ad_of_nat_of_ad b).
- Rewrite (le_antisym ? ? (nat_le_complete ? ? H) (nat_le_complete ? ? H0)). Reflexivity.
+ unfold ad_le in |- *. intros. rewrite <- (ad_of_nat_of_ad a). rewrite <- (ad_of_nat_of_ad b).
+ rewrite (le_antisym _ _ (nat_le_complete _ _ H) (nat_le_complete _ _ H0)). reflexivity.
Qed.
- Lemma ad_le_trans : (a,b,c:ad) (ad_le a b)=true -> (ad_le b c)=true ->
- (ad_le a c)=true.
+ Lemma ad_le_trans :
+ forall a b c:ad, ad_le a b = true -> ad_le b c = true -> ad_le a c = true.
Proof.
- Unfold ad_le. Intros. Apply nat_le_correct. Apply le_trans with m:=(nat_of_ad b).
- Apply nat_le_complete. Assumption.
- Apply nat_le_complete. Assumption.
+ unfold ad_le in |- *. intros. apply nat_le_correct. apply le_trans with (m := nat_of_ad b).
+ apply nat_le_complete. assumption.
+ apply nat_le_complete. assumption.
Qed.
- Lemma ad_le_lt_trans : (a,b,c:ad) (ad_le a b)=true -> (ad_le c b)=false ->
- (ad_le c a)=false.
+ Lemma ad_le_lt_trans :
+ forall a b c:ad,
+ ad_le a b = true -> ad_le c b = false -> ad_le c a = false.
Proof.
- Unfold ad_le. Intros. Apply nat_le_correct_conv. Apply le_lt_trans with m:=(nat_of_ad b).
- Apply nat_le_complete. Assumption.
- Apply nat_le_complete_conv. Assumption.
+ unfold ad_le in |- *. intros. apply nat_le_correct_conv. apply le_lt_trans with (m := nat_of_ad b).
+ apply nat_le_complete. assumption.
+ apply nat_le_complete_conv. assumption.
Qed.
- Lemma ad_lt_le_trans : (a,b,c:ad) (ad_le b a)=false -> (ad_le b c)=true ->
- (ad_le c a)=false.
+ Lemma ad_lt_le_trans :
+ forall a b c:ad,
+ ad_le b a = false -> ad_le b c = true -> ad_le c a = false.
Proof.
- Unfold ad_le. Intros. Apply nat_le_correct_conv. Apply lt_le_trans with m:=(nat_of_ad b).
- Apply nat_le_complete_conv. Assumption.
- Apply nat_le_complete. Assumption.
+ unfold ad_le in |- *. intros. apply nat_le_correct_conv. apply lt_le_trans with (m := nat_of_ad b).
+ apply nat_le_complete_conv. assumption.
+ apply nat_le_complete. assumption.
Qed.
- Lemma ad_lt_trans : (a,b,c:ad) (ad_le b a)=false -> (ad_le c b)=false ->
- (ad_le c a)=false.
+ Lemma ad_lt_trans :
+ forall a b c:ad,
+ ad_le b a = false -> ad_le c b = false -> ad_le c a = false.
Proof.
- Unfold ad_le. Intros. Apply nat_le_correct_conv. Apply lt_trans with m:=(nat_of_ad b).
- Apply nat_le_complete_conv. Assumption.
- Apply nat_le_complete_conv. Assumption.
+ unfold ad_le in |- *. intros. apply nat_le_correct_conv. apply lt_trans with (m := nat_of_ad b).
+ apply nat_le_complete_conv. assumption.
+ apply nat_le_complete_conv. assumption.
Qed.
- Lemma ad_lt_le_weak : (a,b:ad) (ad_le b a)=false -> (ad_le a b)=true.
+ Lemma ad_lt_le_weak : forall a b:ad, ad_le b a = false -> ad_le a b = true.
Proof.
- Unfold ad_le. Intros. Apply nat_le_correct. Apply lt_le_weak.
- Apply nat_le_complete_conv. Assumption.
+ unfold ad_le in |- *. intros. apply nat_le_correct. apply lt_le_weak.
+ apply nat_le_complete_conv. assumption.
Qed.
- Definition ad_min := [a,b:ad] if (ad_le a b) then a else b.
+ Definition ad_min (a b:ad) := if ad_le a b then a else b.
- Lemma ad_min_choice : (a,b:ad) {(ad_min a b)=a}+{(ad_min a b)=b}.
+ Lemma ad_min_choice : forall a b:ad, {ad_min a b = a} + {ad_min a b = b}.
Proof.
- Unfold ad_min. Intros. Elim (sumbool_of_bool (ad_le a b)). Intro H. Left . Rewrite H.
- Reflexivity.
- Intro H. Right . Rewrite H. Reflexivity.
+ unfold ad_min in |- *. intros. elim (sumbool_of_bool (ad_le a b)). intro H. left. rewrite H.
+ reflexivity.
+ intro H. right. rewrite H. reflexivity.
Qed.
- Lemma ad_min_le_1 : (a,b:ad) (ad_le (ad_min a b) a)=true.
+ Lemma ad_min_le_1 : forall a b:ad, ad_le (ad_min a b) a = true.
Proof.
- Unfold ad_min. Intros. Elim (sumbool_of_bool (ad_le a b)). Intro H. Rewrite H.
- Apply ad_le_refl.
- Intro H. Rewrite H. Apply ad_lt_le_weak. Assumption.
+ unfold ad_min in |- *. intros. elim (sumbool_of_bool (ad_le a b)). intro H. rewrite H.
+ apply ad_le_refl.
+ intro H. rewrite H. apply ad_lt_le_weak. assumption.
Qed.
- Lemma ad_min_le_2 : (a,b:ad) (ad_le (ad_min a b) b)=true.
+ Lemma ad_min_le_2 : forall a b:ad, ad_le (ad_min a b) b = true.
Proof.
- Unfold ad_min. Intros. Elim (sumbool_of_bool (ad_le a b)). Intro H. Rewrite H. Assumption.
- Intro H. Rewrite H. Apply ad_le_refl.
+ unfold ad_min in |- *. intros. elim (sumbool_of_bool (ad_le a b)). intro H. rewrite H. assumption.
+ intro H. rewrite H. apply ad_le_refl.
Qed.
- Lemma ad_min_le_3 : (a,b,c:ad) (ad_le a (ad_min b c))=true -> (ad_le a b)=true.
+ Lemma ad_min_le_3 :
+ forall a b c:ad, ad_le a (ad_min b c) = true -> ad_le a b = true.
Proof.
- Unfold ad_min. Intros. Elim (sumbool_of_bool (ad_le b c)). Intro H0. Rewrite H0 in H.
- Assumption.
- Intro H0. Rewrite H0 in H. Apply ad_lt_le_weak. Apply ad_le_lt_trans with b:=c; Assumption.
+ unfold ad_min in |- *. intros. elim (sumbool_of_bool (ad_le b c)). intro H0. rewrite H0 in H.
+ assumption.
+ intro H0. rewrite H0 in H. apply ad_lt_le_weak. apply ad_le_lt_trans with (b := c); assumption.
Qed.
- Lemma ad_min_le_4 : (a,b,c:ad) (ad_le a (ad_min b c))=true -> (ad_le a c)=true.
+ Lemma ad_min_le_4 :
+ forall a b c:ad, ad_le a (ad_min b c) = true -> ad_le a c = true.
Proof.
- Unfold ad_min. Intros. Elim (sumbool_of_bool (ad_le b c)). Intro H0. Rewrite H0 in H.
- Apply ad_le_trans with b:=b; Assumption.
- Intro H0. Rewrite H0 in H. Assumption.
+ unfold ad_min in |- *. intros. elim (sumbool_of_bool (ad_le b c)). intro H0. rewrite H0 in H.
+ apply ad_le_trans with (b := b); assumption.
+ intro H0. rewrite H0 in H. assumption.
Qed.
- Lemma ad_min_le_5 : (a,b,c:ad) (ad_le a b)=true -> (ad_le a c)=true ->
- (ad_le a (ad_min b c))=true.
+ Lemma ad_min_le_5 :
+ forall a b c:ad,
+ ad_le a b = true -> ad_le a c = true -> ad_le a (ad_min b c) = true.
Proof.
- Intros. Elim (ad_min_choice b c). Intro H1. Rewrite H1. Assumption.
- Intro H1. Rewrite H1. Assumption.
+ intros. elim (ad_min_choice b c). intro H1. rewrite H1. assumption.
+ intro H1. rewrite H1. assumption.
Qed.
- Lemma ad_min_lt_3 : (a,b,c:ad) (ad_le (ad_min b c) a)=false -> (ad_le b a)=false.
+ Lemma ad_min_lt_3 :
+ forall a b c:ad, ad_le (ad_min b c) a = false -> ad_le b a = false.
Proof.
- Unfold ad_min. Intros. Elim (sumbool_of_bool (ad_le b c)). Intro H0. Rewrite H0 in H.
- Assumption.
- Intro H0. Rewrite H0 in H. Apply ad_lt_trans with b:=c; Assumption.
+ unfold ad_min in |- *. intros. elim (sumbool_of_bool (ad_le b c)). intro H0. rewrite H0 in H.
+ assumption.
+ intro H0. rewrite H0 in H. apply ad_lt_trans with (b := c); assumption.
Qed.
- Lemma ad_min_lt_4 : (a,b,c:ad) (ad_le (ad_min b c) a)=false -> (ad_le c a)=false.
+ Lemma ad_min_lt_4 :
+ forall a b c:ad, ad_le (ad_min b c) a = false -> ad_le c a = false.
Proof.
- Unfold ad_min. Intros. Elim (sumbool_of_bool (ad_le b c)). Intro H0. Rewrite H0 in H.
- Apply ad_lt_le_trans with b:=b; Assumption.
- Intro H0. Rewrite H0 in H. Assumption.
+ unfold ad_min in |- *. intros. elim (sumbool_of_bool (ad_le b c)). intro H0. rewrite H0 in H.
+ apply ad_lt_le_trans with (b := b); assumption.
+ intro H0. rewrite H0 in H. assumption.
Qed.
(** Allocator: returns an address not in the domain of [m].
This allocator is optimal in that it returns the lowest possible address,
in the usual ordering on integers. It is not the most efficient, however. *)
- Fixpoint ad_alloc_opt [m:(Map A)] : ad :=
- Cases m of
- M0 => ad_z
- | (M1 a _) => if (ad_eq a ad_z)
- then (ad_x xH)
- else ad_z
- | (M2 m1 m2) => (ad_min (ad_double (ad_alloc_opt m1))
- (ad_double_plus_un (ad_alloc_opt m2)))
+ Fixpoint ad_alloc_opt (m:Map A) : ad :=
+ match m with
+ | M0 => ad_z
+ | M1 a _ => if ad_eq a ad_z then ad_x 1 else ad_z
+ | M2 m1 m2 =>
+ ad_min (ad_double (ad_alloc_opt m1))
+ (ad_double_plus_un (ad_alloc_opt m2))
end.
- Lemma ad_alloc_opt_allocates_1 : (m:(Map A)) (MapGet A m (ad_alloc_opt m))=(NONE A).
+ Lemma ad_alloc_opt_allocates_1 :
+ forall m:Map A, MapGet A m (ad_alloc_opt m) = NONE A.
Proof.
- NewInduction m as [|a|m0 H m1 H0]. Reflexivity.
- Simpl. Elim (sumbool_of_bool (ad_eq a ad_z)). Intro H. Rewrite H.
- Rewrite (ad_eq_complete ? ? H). Reflexivity.
- Intro H. Rewrite H. Rewrite H. Reflexivity.
- Intros. Change (ad_alloc_opt (M2 A m0 m1)) with
- (ad_min (ad_double (ad_alloc_opt m0)) (ad_double_plus_un (ad_alloc_opt m1))).
- Elim (ad_min_choice (ad_double (ad_alloc_opt m0)) (ad_double_plus_un (ad_alloc_opt m1))).
- Intro H1. Rewrite H1. Rewrite MapGet_M2_bit_0_0. Rewrite ad_double_div_2. Assumption.
- Apply ad_double_bit_0.
- Intro H1. Rewrite H1. Rewrite MapGet_M2_bit_0_1. Rewrite ad_double_plus_un_div_2. Assumption.
- Apply ad_double_plus_un_bit_0.
+ induction m as [| a| m0 H m1 H0]. reflexivity.
+ simpl in |- *. elim (sumbool_of_bool (ad_eq a ad_z)). intro H. rewrite H.
+ rewrite (ad_eq_complete _ _ H). reflexivity.
+ intro H. rewrite H. rewrite H. reflexivity.
+ intros. change
+ (ad_alloc_opt (M2 A m0 m1)) with (ad_min (ad_double (ad_alloc_opt m0))
+ (ad_double_plus_un (ad_alloc_opt m1)))
+ in |- *.
+ elim
+ (ad_min_choice (ad_double (ad_alloc_opt m0))
+ (ad_double_plus_un (ad_alloc_opt m1))).
+ intro H1. rewrite H1. rewrite MapGet_M2_bit_0_0. rewrite ad_double_div_2. assumption.
+ apply ad_double_bit_0.
+ intro H1. rewrite H1. rewrite MapGet_M2_bit_0_1. rewrite ad_double_plus_un_div_2. assumption.
+ apply ad_double_plus_un_bit_0.
Qed.
- Lemma ad_alloc_opt_allocates : (m:(Map A)) (in_dom A (ad_alloc_opt m) m)=false.
+ Lemma ad_alloc_opt_allocates :
+ forall m:Map A, in_dom A (ad_alloc_opt m) m = false.
Proof.
- Unfold in_dom. Intro. Rewrite (ad_alloc_opt_allocates_1 m). Reflexivity.
+ unfold in_dom in |- *. intro. rewrite (ad_alloc_opt_allocates_1 m). reflexivity.
Qed.
(** Moreover, this is optimal: all addresses below [(ad_alloc_opt m)]
are in [dom m]: *)
- Lemma nat_of_ad_double : (a:ad) (nat_of_ad (ad_double a))=(mult (2) (nat_of_ad a)).
+ Lemma nat_of_ad_double :
+ forall a:ad, nat_of_ad (ad_double a) = 2 * nat_of_ad a.
Proof.
- NewDestruct a as [|p]. Trivial.
- Exact (convert_xO p).
+ destruct a as [| p]. trivial.
+ exact (nat_of_P_xO p).
Qed.
- Lemma nat_of_ad_double_plus_un : (a:ad)
- (nat_of_ad (ad_double_plus_un a))=(S (mult (2) (nat_of_ad a))).
+ Lemma nat_of_ad_double_plus_un :
+ forall a:ad, nat_of_ad (ad_double_plus_un a) = S (2 * nat_of_ad a).
Proof.
- NewDestruct a as [|p]. Trivial.
- Exact (convert_xI p).
+ destruct a as [| p]. trivial.
+ exact (nat_of_P_xI p).
Qed.
- Lemma ad_le_double_mono : (a,b:ad) (ad_le a b)=true ->
- (ad_le (ad_double a) (ad_double b))=true.
+ Lemma ad_le_double_mono :
+ forall a b:ad,
+ ad_le a b = true -> ad_le (ad_double a) (ad_double b) = true.
Proof.
- Unfold ad_le. Intros. Rewrite nat_of_ad_double. Rewrite nat_of_ad_double. Apply nat_le_correct.
- Simpl. Apply le_plus_plus. Apply nat_le_complete. Assumption.
- Apply le_plus_plus. Apply nat_le_complete. Assumption.
- Apply le_n.
+ unfold ad_le in |- *. intros. rewrite nat_of_ad_double. rewrite nat_of_ad_double. apply nat_le_correct.
+ simpl in |- *. apply plus_le_compat. apply nat_le_complete. assumption.
+ apply plus_le_compat. apply nat_le_complete. assumption.
+ apply le_n.
Qed.
- Lemma ad_le_double_plus_un_mono : (a,b:ad) (ad_le a b)=true ->
- (ad_le (ad_double_plus_un a) (ad_double_plus_un b))=true.
+ Lemma ad_le_double_plus_un_mono :
+ forall a b:ad,
+ ad_le a b = true ->
+ ad_le (ad_double_plus_un a) (ad_double_plus_un b) = true.
Proof.
- Unfold ad_le. Intros. Rewrite nat_of_ad_double_plus_un. Rewrite nat_of_ad_double_plus_un.
- Apply nat_le_correct. Apply le_n_S. Simpl. Apply le_plus_plus. Apply nat_le_complete.
- Assumption.
- Apply le_plus_plus. Apply nat_le_complete. Assumption.
- Apply le_n.
+ unfold ad_le in |- *. intros. rewrite nat_of_ad_double_plus_un. rewrite nat_of_ad_double_plus_un.
+ apply nat_le_correct. apply le_n_S. simpl in |- *. apply plus_le_compat. apply nat_le_complete.
+ assumption.
+ apply plus_le_compat. apply nat_le_complete. assumption.
+ apply le_n.
Qed.
- Lemma ad_le_double_mono_conv : (a,b:ad) (ad_le (ad_double a) (ad_double b))=true ->
- (ad_le a b)=true.
+ Lemma ad_le_double_mono_conv :
+ forall a b:ad,
+ ad_le (ad_double a) (ad_double b) = true -> ad_le a b = true.
Proof.
- Unfold ad_le. Intros a b. Rewrite nat_of_ad_double. Rewrite nat_of_ad_double. Intro.
- Apply nat_le_correct. Apply (mult_le_conv_1 (1)). Apply nat_le_complete. Assumption.
+ unfold ad_le in |- *. intros a b. rewrite nat_of_ad_double. rewrite nat_of_ad_double. intro.
+ apply nat_le_correct. apply (mult_S_le_reg_l 1). apply nat_le_complete. assumption.
Qed.
- Lemma ad_le_double_plus_un_mono_conv : (a,b:ad)
- (ad_le (ad_double_plus_un a) (ad_double_plus_un b))=true -> (ad_le a b)=true.
+ Lemma ad_le_double_plus_un_mono_conv :
+ forall a b:ad,
+ ad_le (ad_double_plus_un a) (ad_double_plus_un b) = true ->
+ ad_le a b = true.
Proof.
- Unfold ad_le. Intros a b. Rewrite nat_of_ad_double_plus_un. Rewrite nat_of_ad_double_plus_un.
- Intro. Apply nat_le_correct. Apply (mult_le_conv_1 (1)). Apply le_S_n. Apply nat_le_complete.
- Assumption.
+ unfold ad_le in |- *. intros a b. rewrite nat_of_ad_double_plus_un. rewrite nat_of_ad_double_plus_un.
+ intro. apply nat_le_correct. apply (mult_S_le_reg_l 1). apply le_S_n. apply nat_le_complete.
+ assumption.
Qed.
- Lemma ad_lt_double_mono : (a,b:ad) (ad_le a b)=false ->
- (ad_le (ad_double a) (ad_double b))=false.
+ Lemma ad_lt_double_mono :
+ forall a b:ad,
+ ad_le a b = false -> ad_le (ad_double a) (ad_double b) = false.
Proof.
- Intros. Elim (sumbool_of_bool (ad_le (ad_double a) (ad_double b))). Intro H0.
- Rewrite (ad_le_double_mono_conv ? ? H0) in H. Discriminate H.
- Trivial.
+ intros. elim (sumbool_of_bool (ad_le (ad_double a) (ad_double b))). intro H0.
+ rewrite (ad_le_double_mono_conv _ _ H0) in H. discriminate H.
+ trivial.
Qed.
- Lemma ad_lt_double_plus_un_mono : (a,b:ad) (ad_le a b)=false ->
- (ad_le (ad_double_plus_un a) (ad_double_plus_un b))=false.
+ Lemma ad_lt_double_plus_un_mono :
+ forall a b:ad,
+ ad_le a b = false ->
+ ad_le (ad_double_plus_un a) (ad_double_plus_un b) = false.
Proof.
- Intros. Elim (sumbool_of_bool (ad_le (ad_double_plus_un a) (ad_double_plus_un b))). Intro H0.
- Rewrite (ad_le_double_plus_un_mono_conv ? ? H0) in H. Discriminate H.
- Trivial.
+ intros. elim (sumbool_of_bool (ad_le (ad_double_plus_un a) (ad_double_plus_un b))). intro H0.
+ rewrite (ad_le_double_plus_un_mono_conv _ _ H0) in H. discriminate H.
+ trivial.
Qed.
- Lemma ad_lt_double_mono_conv : (a,b:ad) (ad_le (ad_double a) (ad_double b))=false ->
- (ad_le a b)=false.
+ Lemma ad_lt_double_mono_conv :
+ forall a b:ad,
+ ad_le (ad_double a) (ad_double b) = false -> ad_le a b = false.
Proof.
- Intros. Elim (sumbool_of_bool (ad_le a b)). Intro H0. Rewrite (ad_le_double_mono ? ? H0) in H.
- Discriminate H.
- Trivial.
+ intros. elim (sumbool_of_bool (ad_le a b)). intro H0. rewrite (ad_le_double_mono _ _ H0) in H.
+ discriminate H.
+ trivial.
Qed.
- Lemma ad_lt_double_plus_un_mono_conv : (a,b:ad)
- (ad_le (ad_double_plus_un a) (ad_double_plus_un b))=false -> (ad_le a b)=false.
+ Lemma ad_lt_double_plus_un_mono_conv :
+ forall a b:ad,
+ ad_le (ad_double_plus_un a) (ad_double_plus_un b) = false ->
+ ad_le a b = false.
Proof.
- Intros. Elim (sumbool_of_bool (ad_le a b)). Intro H0.
- Rewrite (ad_le_double_plus_un_mono ? ? H0) in H. Discriminate H.
- Trivial.
+ intros. elim (sumbool_of_bool (ad_le a b)). intro H0.
+ rewrite (ad_le_double_plus_un_mono _ _ H0) in H. discriminate H.
+ trivial.
Qed.
- Lemma ad_alloc_opt_optimal_1 : (m:(Map A)) (a:ad) (ad_le (ad_alloc_opt m) a)=false ->
- {y:A | (MapGet A m a)=(SOME A y)}.
+ Lemma ad_alloc_opt_optimal_1 :
+ forall (m:Map A) (a:ad),
+ ad_le (ad_alloc_opt m) a = false -> {y : A | MapGet A m a = SOME A y}.
Proof.
- NewInduction m as [|a y|m0 H m1 H0]. Simpl. Unfold ad_le. Simpl. Intros. Discriminate H.
- Simpl. Intros b H. Elim (sumbool_of_bool (ad_eq a ad_z)). Intro H0. Rewrite H0 in H.
- Unfold ad_le in H. Cut ad_z=b. Intro. Split with y. Rewrite <- H1. Rewrite H0. Reflexivity.
- Rewrite <- (ad_of_nat_of_ad b).
- Rewrite <- (le_n_O_eq ? (le_S_n ? ? (nat_le_complete_conv ? ? H))). Reflexivity.
- Intro H0. Rewrite H0 in H. Discriminate H.
- Intros. Simpl in H1. Elim (ad_double_or_double_plus_un a). Intro H2. Elim H2. Intros a0 H3.
- Rewrite H3 in H1. Elim (H ? (ad_lt_double_mono_conv ? ? (ad_min_lt_3 ? ? ? H1))). Intros y H4.
- Split with y. Rewrite H3. Rewrite MapGet_M2_bit_0_0. Rewrite ad_double_div_2. Assumption.
- Apply ad_double_bit_0.
- Intro H2. Elim H2. Intros a0 H3. Rewrite H3 in H1.
- Elim (H0 ? (ad_lt_double_plus_un_mono_conv ? ? (ad_min_lt_4 ? ? ? H1))). Intros y H4.
- Split with y. Rewrite H3. Rewrite MapGet_M2_bit_0_1. Rewrite ad_double_plus_un_div_2.
- Assumption.
- Apply ad_double_plus_un_bit_0.
+ induction m as [| a y| m0 H m1 H0]. simpl in |- *. unfold ad_le in |- *. simpl in |- *. intros. discriminate H.
+ simpl in |- *. intros b H. elim (sumbool_of_bool (ad_eq a ad_z)). intro H0. rewrite H0 in H.
+ unfold ad_le in H. cut (ad_z = b). intro. split with y. rewrite <- H1. rewrite H0. reflexivity.
+ rewrite <- (ad_of_nat_of_ad b).
+ rewrite <- (le_n_O_eq _ (le_S_n _ _ (nat_le_complete_conv _ _ H))). reflexivity.
+ intro H0. rewrite H0 in H. discriminate H.
+ intros. simpl in H1. elim (ad_double_or_double_plus_un a). intro H2. elim H2. intros a0 H3.
+ rewrite H3 in H1. elim (H _ (ad_lt_double_mono_conv _ _ (ad_min_lt_3 _ _ _ H1))). intros y H4.
+ split with y. rewrite H3. rewrite MapGet_M2_bit_0_0. rewrite ad_double_div_2. assumption.
+ apply ad_double_bit_0.
+ intro H2. elim H2. intros a0 H3. rewrite H3 in H1.
+ elim (H0 _ (ad_lt_double_plus_un_mono_conv _ _ (ad_min_lt_4 _ _ _ H1))). intros y H4.
+ split with y. rewrite H3. rewrite MapGet_M2_bit_0_1. rewrite ad_double_plus_un_div_2.
+ assumption.
+ apply ad_double_plus_un_bit_0.
Qed.
- Lemma ad_alloc_opt_optimal : (m:(Map A)) (a:ad) (ad_le (ad_alloc_opt m) a)=false ->
- (in_dom A a m)=true.
+ Lemma ad_alloc_opt_optimal :
+ forall (m:Map A) (a:ad),
+ ad_le (ad_alloc_opt m) a = false -> in_dom A a m = true.
Proof.
- Intros. Unfold in_dom. Elim (ad_alloc_opt_optimal_1 m a H). Intros y H0. Rewrite H0.
- Reflexivity.
+ intros. unfold in_dom in |- *. elim (ad_alloc_opt_optimal_1 m a H). intros y H0. rewrite H0.
+ reflexivity.
Qed.
End AdAlloc.
-
-V7only [
-(* Moved to NArith *)
-Notation positive_to_nat_2 := positive_to_nat_2.
-Notation positive_to_nat_4 := positive_to_nat_4.
-].
diff --git a/theories/IntMap/Addec.v b/theories/IntMap/Addec.v
index f0ec7b37d..5ad2ea852 100644
--- a/theories/IntMap/Addec.v
+++ b/theories/IntMap/Addec.v
@@ -9,171 +9,185 @@
(** Equality on adresses *)
-Require Bool.
-Require Sumbool.
-Require ZArith.
-Require Addr.
-
-Fixpoint ad_eq_1 [p1,p2:positive] : bool :=
- Cases p1 p2 of
- xH xH => true
- | (xO p'1) (xO p'2) => (ad_eq_1 p'1 p'2)
- | (xI p'1) (xI p'2) => (ad_eq_1 p'1 p'2)
- | _ _ => false
+Require Import Bool.
+Require Import Sumbool.
+Require Import ZArith.
+Require Import Addr.
+
+Fixpoint ad_eq_1 (p1 p2:positive) {struct p2} : bool :=
+ match p1, p2 with
+ | xH, xH => true
+ | xO p'1, xO p'2 => ad_eq_1 p'1 p'2
+ | xI p'1, xI p'2 => ad_eq_1 p'1 p'2
+ | _, _ => false
end.
-Definition ad_eq := [a,a':ad]
- Cases a a' of
- ad_z ad_z => true
- | (ad_x p) (ad_x p') => (ad_eq_1 p p')
- | _ _ => false
+Definition ad_eq (a a':ad) :=
+ match a, a' with
+ | ad_z, ad_z => true
+ | ad_x p, ad_x p' => ad_eq_1 p p'
+ | _, _ => false
end.
-Lemma ad_eq_correct : (a:ad) (ad_eq a a)=true.
+Lemma ad_eq_correct : forall a:ad, ad_eq a a = true.
Proof.
- NewDestruct a; Trivial.
- NewInduction p; Trivial.
+ destruct a; trivial.
+ induction p; trivial.
Qed.
-Lemma ad_eq_complete : (a,a':ad) (ad_eq a a')=true -> a=a'.
-Proof.
- NewDestruct a. NewDestruct a'; Trivial. NewDestruct p.
- Discriminate 1.
- Discriminate 1.
- Discriminate 1.
- NewDestruct a'. Intros. Discriminate H.
- Unfold ad_eq. Intros. Cut p=p0. Intros. Rewrite H0. Reflexivity.
- Generalize Dependent p0.
- NewInduction p as [p IHp|p IHp|]. NewDestruct p0; Intro H.
- Rewrite (IHp p0). Reflexivity.
- Exact H.
- Discriminate H.
- Discriminate H.
- NewDestruct p0; Intro H. Discriminate H.
- Rewrite (IHp p0 H). Reflexivity.
- Discriminate H.
- NewDestruct p0; Intro H. Discriminate H.
- Discriminate H.
- Trivial.
+Lemma ad_eq_complete : forall a a':ad, ad_eq a a' = true -> a = a'.
+Proof.
+ destruct a. destruct a'; trivial. destruct p.
+ discriminate 1.
+ discriminate 1.
+ discriminate 1.
+ destruct a'. intros. discriminate H.
+ unfold ad_eq in |- *. intros. cut (p = p0). intros. rewrite H0. reflexivity.
+ generalize dependent p0.
+ induction p as [p IHp| p IHp| ]. destruct p0; intro H.
+ rewrite (IHp p0). reflexivity.
+ exact H.
+ discriminate H.
+ discriminate H.
+ destruct p0; intro H. discriminate H.
+ rewrite (IHp p0 H). reflexivity.
+ discriminate H.
+ destruct p0 as [p| p| ]; intro H. discriminate H.
+ discriminate H.
+ trivial.
Qed.
-Lemma ad_eq_comm : (a,a':ad) (ad_eq a a')=(ad_eq a' a).
-Proof.
- Intros. Cut (b,b':bool)(ad_eq a a')=b->(ad_eq a' a)=b'->b=b'.
- Intros. Apply H. Reflexivity.
- Reflexivity.
- NewDestruct b. Intros. Cut a=a'.
- Intro. Rewrite H1 in H0. Rewrite (ad_eq_correct a') in H0. Exact H0.
- Apply ad_eq_complete. Exact H.
- NewDestruct b'. Intros. Cut a'=a.
- Intro. Rewrite H1 in H. Rewrite H1 in H0. Rewrite <- H. Exact H0.
- Apply ad_eq_complete. Exact H0.
- Trivial.
+Lemma ad_eq_comm : forall a a':ad, ad_eq a a' = ad_eq a' a.
+Proof.
+ intros. cut (forall b b':bool, ad_eq a a' = b -> ad_eq a' a = b' -> b = b').
+ intros. apply H. reflexivity.
+ reflexivity.
+ destruct b. intros. cut (a = a').
+ intro. rewrite H1 in H0. rewrite (ad_eq_correct a') in H0. exact H0.
+ apply ad_eq_complete. exact H.
+ destruct b'. intros. cut (a' = a).
+ intro. rewrite H1 in H. rewrite H1 in H0. rewrite <- H. exact H0.
+ apply ad_eq_complete. exact H0.
+ trivial.
Qed.
-Lemma ad_xor_eq_true : (a,a':ad) (ad_xor a a')=ad_z -> (ad_eq a a')=true.
+Lemma ad_xor_eq_true :
+ forall a a':ad, ad_xor a a' = ad_z -> ad_eq a a' = true.
Proof.
- Intros. Rewrite (ad_xor_eq a a' H). Apply ad_eq_correct.
+ intros. rewrite (ad_xor_eq a a' H). apply ad_eq_correct.
Qed.
Lemma ad_xor_eq_false :
- (a,a':ad) (p:positive) (ad_xor a a')=(ad_x p) -> (ad_eq a a')=false.
+ forall (a a':ad) (p:positive), ad_xor a a' = ad_x p -> ad_eq a a' = false.
Proof.
- Intros. Elim (sumbool_of_bool (ad_eq a a')). Intro H0.
- Rewrite (ad_eq_complete a a' H0) in H. Rewrite (ad_xor_nilpotent a') in H. Discriminate H.
- Trivial.
+ intros. elim (sumbool_of_bool (ad_eq a a')). intro H0.
+ rewrite (ad_eq_complete a a' H0) in H. rewrite (ad_xor_nilpotent a') in H. discriminate H.
+ trivial.
Qed.
-Lemma ad_bit_0_1_not_double : (a:ad) (ad_bit_0 a)=true ->
- (a0:ad) (ad_eq (ad_double a0) a)=false.
+Lemma ad_bit_0_1_not_double :
+ forall a:ad,
+ ad_bit_0 a = true -> forall a0:ad, ad_eq (ad_double a0) a = false.
Proof.
- Intros. Elim (sumbool_of_bool (ad_eq (ad_double a0) a)). Intro H0.
- Rewrite <- (ad_eq_complete ? ? H0) in H. Rewrite (ad_double_bit_0 a0) in H. Discriminate H.
- Trivial.
+ intros. elim (sumbool_of_bool (ad_eq (ad_double a0) a)). intro H0.
+ rewrite <- (ad_eq_complete _ _ H0) in H. rewrite (ad_double_bit_0 a0) in H. discriminate H.
+ trivial.
Qed.
-Lemma ad_not_div_2_not_double : (a,a0:ad) (ad_eq (ad_div_2 a) a0)=false ->
- (ad_eq a (ad_double a0))=false.
+Lemma ad_not_div_2_not_double :
+ forall a a0:ad,
+ ad_eq (ad_div_2 a) a0 = false -> ad_eq a (ad_double a0) = false.
Proof.
- Intros. Elim (sumbool_of_bool (ad_eq (ad_double a0) a)). Intro H0.
- Rewrite <- (ad_eq_complete ? ? H0) in H. Rewrite (ad_double_div_2 a0) in H.
- Rewrite (ad_eq_correct a0) in H. Discriminate H.
- Intro. Rewrite ad_eq_comm. Assumption.
+ intros. elim (sumbool_of_bool (ad_eq (ad_double a0) a)). intro H0.
+ rewrite <- (ad_eq_complete _ _ H0) in H. rewrite (ad_double_div_2 a0) in H.
+ rewrite (ad_eq_correct a0) in H. discriminate H.
+ intro. rewrite ad_eq_comm. assumption.
Qed.
-Lemma ad_bit_0_0_not_double_plus_un : (a:ad) (ad_bit_0 a)=false ->
- (a0:ad) (ad_eq (ad_double_plus_un a0) a)=false.
+Lemma ad_bit_0_0_not_double_plus_un :
+ forall a:ad,
+ ad_bit_0 a = false -> forall a0:ad, ad_eq (ad_double_plus_un a0) a = false.
Proof.
- Intros. Elim (sumbool_of_bool (ad_eq (ad_double_plus_un a0) a)). Intro H0.
- Rewrite <- (ad_eq_complete ? ? H0) in H. Rewrite (ad_double_plus_un_bit_0 a0) in H.
- Discriminate H.
- Trivial.
+ intros. elim (sumbool_of_bool (ad_eq (ad_double_plus_un a0) a)). intro H0.
+ rewrite <- (ad_eq_complete _ _ H0) in H. rewrite (ad_double_plus_un_bit_0 a0) in H.
+ discriminate H.
+ trivial.
Qed.
-Lemma ad_not_div_2_not_double_plus_un : (a,a0:ad) (ad_eq (ad_div_2 a) a0)=false ->
- (ad_eq (ad_double_plus_un a0) a)=false.
+Lemma ad_not_div_2_not_double_plus_un :
+ forall a a0:ad,
+ ad_eq (ad_div_2 a) a0 = false -> ad_eq (ad_double_plus_un a0) a = false.
Proof.
- Intros. Elim (sumbool_of_bool (ad_eq a (ad_double_plus_un a0))). Intro H0.
- Rewrite (ad_eq_complete ? ? H0) in H. Rewrite (ad_double_plus_un_div_2 a0) in H.
- Rewrite (ad_eq_correct a0) in H. Discriminate H.
- Intro H0. Rewrite ad_eq_comm. Assumption.
+ intros. elim (sumbool_of_bool (ad_eq a (ad_double_plus_un a0))). intro H0.
+ rewrite (ad_eq_complete _ _ H0) in H. rewrite (ad_double_plus_un_div_2 a0) in H.
+ rewrite (ad_eq_correct a0) in H. discriminate H.
+ intro H0. rewrite ad_eq_comm. assumption.
Qed.
Lemma ad_bit_0_neq :
- (a,a':ad) (ad_bit_0 a)=false -> (ad_bit_0 a')=true -> (ad_eq a a')=false.
+ forall a a':ad,
+ ad_bit_0 a = false -> ad_bit_0 a' = true -> ad_eq a a' = false.
Proof.
- Intros. Elim (sumbool_of_bool (ad_eq a a')). Intro H1. Rewrite (ad_eq_complete ? ? H1) in H.
- Rewrite H in H0. Discriminate H0.
- Trivial.
+ intros. elim (sumbool_of_bool (ad_eq a a')). intro H1. rewrite (ad_eq_complete _ _ H1) in H.
+ rewrite H in H0. discriminate H0.
+ trivial.
Qed.
Lemma ad_div_eq :
- (a,a':ad) (ad_eq a a')=true -> (ad_eq (ad_div_2 a) (ad_div_2 a'))=true.
+ forall a a':ad, ad_eq a a' = true -> ad_eq (ad_div_2 a) (ad_div_2 a') = true.
Proof.
- Intros. Cut a=a'. Intros. Rewrite H0. Apply ad_eq_correct.
- Apply ad_eq_complete. Exact H.
+ intros. cut (a = a'). intros. rewrite H0. apply ad_eq_correct.
+ apply ad_eq_complete. exact H.
Qed.
-Lemma ad_div_neq : (a,a':ad) (ad_eq (ad_div_2 a) (ad_div_2 a'))=false ->
- (ad_eq a a')=false.
+Lemma ad_div_neq :
+ forall a a':ad,
+ ad_eq (ad_div_2 a) (ad_div_2 a') = false -> ad_eq a a' = false.
Proof.
- Intros. Elim (sumbool_of_bool (ad_eq a a')). Intro H0.
- Rewrite (ad_eq_complete ? ? H0) in H. Rewrite (ad_eq_correct (ad_div_2 a')) in H. Discriminate H.
- Trivial.
+ intros. elim (sumbool_of_bool (ad_eq a a')). intro H0.
+ rewrite (ad_eq_complete _ _ H0) in H. rewrite (ad_eq_correct (ad_div_2 a')) in H. discriminate H.
+ trivial.
Qed.
-Lemma ad_div_bit_eq : (a,a':ad) (ad_bit_0 a)=(ad_bit_0 a') ->
- (ad_div_2 a)=(ad_div_2 a') -> a=a'.
+Lemma ad_div_bit_eq :
+ forall a a':ad,
+ ad_bit_0 a = ad_bit_0 a' -> ad_div_2 a = ad_div_2 a' -> a = a'.
Proof.
- Intros. Apply ad_faithful. Unfold eqf. NewDestruct n.
- Rewrite ad_bit_0_correct. Rewrite ad_bit_0_correct. Assumption.
- Rewrite <- ad_div_2_correct. Rewrite <- ad_div_2_correct.
- Rewrite H0. Reflexivity.
+ intros. apply ad_faithful. unfold eqf in |- *. destruct n.
+ rewrite ad_bit_0_correct. rewrite ad_bit_0_correct. assumption.
+ rewrite <- ad_div_2_correct. rewrite <- ad_div_2_correct.
+ rewrite H0. reflexivity.
Qed.
-Lemma ad_div_bit_neq : (a,a':ad) (ad_eq a a')=false -> (ad_bit_0 a)=(ad_bit_0 a') ->
- (ad_eq (ad_div_2 a) (ad_div_2 a'))=false.
+Lemma ad_div_bit_neq :
+ forall a a':ad,
+ ad_eq a a' = false ->
+ ad_bit_0 a = ad_bit_0 a' -> ad_eq (ad_div_2 a) (ad_div_2 a') = false.
Proof.
- Intros. Elim (sumbool_of_bool (ad_eq (ad_div_2 a) (ad_div_2 a'))). Intro H1.
- Rewrite (ad_div_bit_eq ? ? H0 (ad_eq_complete ? ? H1)) in H.
- Rewrite (ad_eq_correct a') in H. Discriminate H.
- Trivial.
+ intros. elim (sumbool_of_bool (ad_eq (ad_div_2 a) (ad_div_2 a'))). intro H1.
+ rewrite (ad_div_bit_eq _ _ H0 (ad_eq_complete _ _ H1)) in H.
+ rewrite (ad_eq_correct a') in H. discriminate H.
+ trivial.
Qed.
-Lemma ad_neq : (a,a':ad) (ad_eq a a')=false ->
- (ad_bit_0 a)=(negb (ad_bit_0 a')) \/ (ad_eq (ad_div_2 a) (ad_div_2 a'))=false.
+Lemma ad_neq :
+ forall a a':ad,
+ ad_eq a a' = false ->
+ ad_bit_0 a = negb (ad_bit_0 a') \/
+ ad_eq (ad_div_2 a) (ad_div_2 a') = false.
Proof.
- Intros. Cut (ad_bit_0 a)=(ad_bit_0 a')\/(ad_bit_0 a)=(negb (ad_bit_0 a')).
- Intros. Elim H0. Intro. Right . Apply ad_div_bit_neq. Assumption.
- Assumption.
- Intro. Left . Assumption.
- Case (ad_bit_0 a); Case (ad_bit_0 a'); Auto.
+ intros. cut (ad_bit_0 a = ad_bit_0 a' \/ ad_bit_0 a = negb (ad_bit_0 a')).
+ intros. elim H0. intro. right. apply ad_div_bit_neq. assumption.
+ assumption.
+ intro. left. assumption.
+ case (ad_bit_0 a); case (ad_bit_0 a'); auto.
Qed.
-Lemma ad_double_or_double_plus_un : (a:ad)
- {a0:ad | a=(ad_double a0)}+{a1:ad | a=(ad_double_plus_un a1)}.
+Lemma ad_double_or_double_plus_un :
+ forall a:ad,
+ {a0 : ad | a = ad_double a0} + {a1 : ad | a = ad_double_plus_un a1}.
Proof.
- Intro. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H. Right . Split with (ad_div_2 a).
- Rewrite (ad_div_2_double_plus_un a H). Reflexivity.
- Intro H. Left . Split with (ad_div_2 a). Rewrite (ad_div_2_double a H). Reflexivity.
-Qed.
+ intro. elim (sumbool_of_bool (ad_bit_0 a)). intro H. right. split with (ad_div_2 a).
+ rewrite (ad_div_2_double_plus_un a H). reflexivity.
+ intro H. left. split with (ad_div_2 a). rewrite (ad_div_2_double a H). reflexivity.
+Qed. \ No newline at end of file
diff --git a/theories/IntMap/Addr.v b/theories/IntMap/Addr.v
index cff8936b6..fcab8b565 100644
--- a/theories/IntMap/Addr.v
+++ b/theories/IntMap/Addr.v
@@ -9,448 +9,483 @@
(** Representation of adresses by the [positive] type of binary numbers *)
-Require Bool.
-Require ZArith.
+Require Import Bool.
+Require Import ZArith.
Inductive ad : Set :=
- ad_z : ad
+ | ad_z : ad
| ad_x : positive -> ad.
-Lemma ad_sum : (a:ad) {p:positive | a=(ad_x p)}+{a=ad_z}.
-Proof.
- NewDestruct a; Auto.
- Left; Exists p; Trivial.
-Qed.
-
-Fixpoint p_xor [p:positive] : positive -> ad :=
- [p2] Cases p of
- xH => Cases p2 of
- xH => ad_z
- | (xO p'2) => (ad_x (xI p'2))
- | (xI p'2) => (ad_x (xO p'2))
- end
- | (xO p') => Cases p2 of
- xH => (ad_x (xI p'))
- | (xO p'2) => Cases (p_xor p' p'2) of
- ad_z => ad_z
- | (ad_x p'') => (ad_x (xO p''))
- end
- | (xI p'2) => Cases (p_xor p' p'2) of
- ad_z => (ad_x xH)
- | (ad_x p'') => (ad_x (xI p''))
- end
- end
- | (xI p') => Cases p2 of
- xH => (ad_x (xO p'))
- | (xO p'2) => Cases (p_xor p' p'2) of
- ad_z => (ad_x xH)
- | (ad_x p'') => (ad_x (xI p''))
- end
- | (xI p'2) => Cases (p_xor p' p'2) of
- ad_z => ad_z
- | (ad_x p'') => (ad_x (xO p''))
- end
- end
+Lemma ad_sum : forall a:ad, {p : positive | a = ad_x p} + {a = ad_z}.
+Proof.
+ destruct a; auto.
+ left; exists p; trivial.
+Qed.
+
+Fixpoint p_xor (p p2:positive) {struct p} : ad :=
+ match p with
+ | xH =>
+ match p2 with
+ | xH => ad_z
+ | xO p'2 => ad_x (xI p'2)
+ | xI p'2 => ad_x (xO p'2)
+ end
+ | xO p' =>
+ match p2 with
+ | xH => ad_x (xI p')
+ | xO p'2 =>
+ match p_xor p' p'2 with
+ | ad_z => ad_z
+ | ad_x p'' => ad_x (xO p'')
+ end
+ | xI p'2 =>
+ match p_xor p' p'2 with
+ | ad_z => ad_x 1
+ | ad_x p'' => ad_x (xI p'')
+ end
+ end
+ | xI p' =>
+ match p2 with
+ | xH => ad_x (xO p')
+ | xO p'2 =>
+ match p_xor p' p'2 with
+ | ad_z => ad_x 1
+ | ad_x p'' => ad_x (xI p'')
+ end
+ | xI p'2 =>
+ match p_xor p' p'2 with
+ | ad_z => ad_z
+ | ad_x p'' => ad_x (xO p'')
+ end
+ end
end.
-Definition ad_xor := [a,a':ad]
- Cases a of
- ad_z => a'
- | (ad_x p) => Cases a' of
- ad_z => a
- | (ad_x p') => (p_xor p p')
- end
+Definition ad_xor (a a':ad) :=
+ match a with
+ | ad_z => a'
+ | ad_x p => match a' with
+ | ad_z => a
+ | ad_x p' => p_xor p p'
+ end
end.
-Lemma ad_xor_neutral_left : (a:ad) (ad_xor ad_z a)=a.
+Lemma ad_xor_neutral_left : forall a:ad, ad_xor ad_z a = a.
Proof.
- Trivial.
+ trivial.
Qed.
-Lemma ad_xor_neutral_right : (a:ad) (ad_xor a ad_z)=a.
+Lemma ad_xor_neutral_right : forall a:ad, ad_xor a ad_z = a.
Proof.
- NewDestruct a; Trivial.
+ destruct a; trivial.
Qed.
-Lemma ad_xor_comm : (a,a':ad) (ad_xor a a')=(ad_xor a' a).
+Lemma ad_xor_comm : forall a a':ad, ad_xor a a' = ad_xor a' a.
Proof.
- NewDestruct a; NewDestruct a'; Simpl; Auto.
- Generalize p0; Clear p0; NewInduction p as [p Hrecp|p Hrecp|]; Simpl; Auto.
- NewDestruct p0; Simpl; Trivial; Intros.
- Rewrite Hrecp; Trivial.
- Rewrite Hrecp; Trivial.
- NewDestruct p0; Simpl; Trivial; Intros.
- Rewrite Hrecp; Trivial.
- Rewrite Hrecp; Trivial.
- NewDestruct p0; Simpl; Auto.
+ destruct a; destruct a'; simpl in |- *; auto.
+ generalize p0; clear p0; induction p as [p Hrecp| p Hrecp| ]; simpl in |- *;
+ auto.
+ destruct p0; simpl in |- *; trivial; intros.
+ rewrite Hrecp; trivial.
+ rewrite Hrecp; trivial.
+ destruct p0; simpl in |- *; trivial; intros.
+ rewrite Hrecp; trivial.
+ rewrite Hrecp; trivial.
+ destruct p0 as [p| p| ]; simpl in |- *; auto.
Qed.
-Lemma ad_xor_nilpotent : (a:ad) (ad_xor a a)=ad_z.
+Lemma ad_xor_nilpotent : forall a:ad, ad_xor a a = ad_z.
Proof.
- NewDestruct a; Trivial.
- Simpl. NewInduction p as [p IHp|p IHp|]; Trivial.
- Simpl. Rewrite IHp; Reflexivity.
- Simpl. Rewrite IHp; Reflexivity.
+ destruct a; trivial.
+ simpl in |- *. induction p as [p IHp| p IHp| ]; trivial.
+ simpl in |- *. rewrite IHp; reflexivity.
+ simpl in |- *. rewrite IHp; reflexivity.
Qed.
-Fixpoint ad_bit_1 [p:positive] : nat -> bool :=
- Cases p of
- xH => [n:nat] Cases n of
- O => true
- | (S _) => false
- end
- | (xO p) => [n:nat] Cases n of
- O => false
- | (S n') => (ad_bit_1 p n')
- end
- | (xI p) => [n:nat] Cases n of
- O => true
- | (S n') => (ad_bit_1 p n')
- end
+Fixpoint ad_bit_1 (p:positive) : nat -> bool :=
+ match p with
+ | xH => fun n:nat => match n with
+ | O => true
+ | S _ => false
+ end
+ | xO p =>
+ fun n:nat => match n with
+ | O => false
+ | S n' => ad_bit_1 p n'
+ end
+ | xI p => fun n:nat => match n with
+ | O => true
+ | S n' => ad_bit_1 p n'
+ end
end.
-Definition ad_bit := [a:ad]
- Cases a of
- ad_z => [_:nat] false
- | (ad_x p) => (ad_bit_1 p)
+Definition ad_bit (a:ad) :=
+ match a with
+ | ad_z => fun _:nat => false
+ | ad_x p => ad_bit_1 p
end.
-Definition eqf := [f,g:nat->bool] (n:nat) (f n)=(g n).
+Definition eqf (f g:nat -> bool) := forall n:nat, f n = g n.
-Lemma ad_faithful_1 : (a:ad) (eqf (ad_bit ad_z) (ad_bit a)) -> ad_z=a.
+Lemma ad_faithful_1 : forall a:ad, eqf (ad_bit ad_z) (ad_bit a) -> ad_z = a.
Proof.
- NewDestruct a. Trivial.
- NewInduction p as [p IHp|p IHp|];Intro H. Absurd ad_z=(ad_x p). Discriminate.
- Exact (IHp [n:nat](H (S n))).
- Absurd ad_z=(ad_x p). Discriminate.
- Exact (IHp [n:nat](H (S n))).
- Absurd false=true. Discriminate.
- Exact (H O).
+ destruct a. trivial.
+ induction p as [p IHp| p IHp| ]; intro H. absurd (ad_z = ad_x p). discriminate.
+ exact (IHp (fun n:nat => H (S n))).
+ absurd (ad_z = ad_x p). discriminate.
+ exact (IHp (fun n:nat => H (S n))).
+ absurd (false = true). discriminate.
+ exact (H 0).
Qed.
-Lemma ad_faithful_2 : (a:ad) (eqf (ad_bit (ad_x xH)) (ad_bit a)) -> (ad_x xH)=a.
+Lemma ad_faithful_2 :
+ forall a:ad, eqf (ad_bit (ad_x 1)) (ad_bit a) -> ad_x 1 = a.
Proof.
- NewDestruct a. Intros. Absurd true=false. Discriminate.
- Exact (H O).
- NewDestruct p. Intro H. Absurd ad_z=(ad_x p). Discriminate.
- Exact (ad_faithful_1 (ad_x p) [n:nat](H (S n))).
- Intros. Absurd true=false. Discriminate.
- Exact (H O).
- Trivial.
+ destruct a. intros. absurd (true = false). discriminate.
+ exact (H 0).
+ destruct p. intro H. absurd (ad_z = ad_x p). discriminate.
+ exact (ad_faithful_1 (ad_x p) (fun n:nat => H (S n))).
+ intros. absurd (true = false). discriminate.
+ exact (H 0).
+ trivial.
Qed.
Lemma ad_faithful_3 :
- (a:ad) (p:positive)
- ((p':positive) (eqf (ad_bit (ad_x p)) (ad_bit (ad_x p'))) -> p=p') ->
- (eqf (ad_bit (ad_x (xO p))) (ad_bit a)) ->
- (ad_x (xO p))=a.
+ forall (a:ad) (p:positive),
+ (forall p':positive, eqf (ad_bit (ad_x p)) (ad_bit (ad_x p')) -> p = p') ->
+ eqf (ad_bit (ad_x (xO p))) (ad_bit a) -> ad_x (xO p) = a.
Proof.
- NewDestruct a. Intros. Cut (eqf (ad_bit ad_z) (ad_bit (ad_x (xO p)))).
- Intro. Rewrite (ad_faithful_1 (ad_x (xO p)) H1). Reflexivity.
- Unfold eqf. Intro. Unfold eqf in H0. Rewrite H0. Reflexivity.
- Case p. Intros. Absurd false=true. Discriminate.
- Exact (H0 O).
- Intros. Rewrite (H p0 [n:nat](H0 (S n))). Reflexivity.
- Intros. Absurd false=true. Discriminate.
- Exact (H0 O).
+ destruct a. intros. cut (eqf (ad_bit ad_z) (ad_bit (ad_x (xO p)))).
+ intro. rewrite (ad_faithful_1 (ad_x (xO p)) H1). reflexivity.
+ unfold eqf in |- *. intro. unfold eqf in H0. rewrite H0. reflexivity.
+ case p. intros. absurd (false = true). discriminate.
+ exact (H0 0).
+ intros. rewrite (H p0 (fun n:nat => H0 (S n))). reflexivity.
+ intros. absurd (false = true). discriminate.
+ exact (H0 0).
Qed.
Lemma ad_faithful_4 :
- (a:ad) (p:positive)
- ((p':positive) (eqf (ad_bit (ad_x p)) (ad_bit (ad_x p'))) -> p=p') ->
- (eqf (ad_bit (ad_x (xI p))) (ad_bit a)) ->
- (ad_x (xI p))=a.
+ forall (a:ad) (p:positive),
+ (forall p':positive, eqf (ad_bit (ad_x p)) (ad_bit (ad_x p')) -> p = p') ->
+ eqf (ad_bit (ad_x (xI p))) (ad_bit a) -> ad_x (xI p) = a.
Proof.
- NewDestruct a. Intros. Cut (eqf (ad_bit ad_z) (ad_bit (ad_x (xI p)))).
- Intro. Rewrite (ad_faithful_1 (ad_x (xI p)) H1). Reflexivity.
- Unfold eqf. Intro. Unfold eqf in H0. Rewrite H0. Reflexivity.
- Case p. Intros. Rewrite (H p0 [n:nat](H0 (S n))). Reflexivity.
- Intros. Absurd true=false. Discriminate.
- Exact (H0 O).
- Intros. Absurd ad_z=(ad_x p0). Discriminate.
- Cut (eqf (ad_bit (ad_x xH)) (ad_bit (ad_x (xI p0)))).
- Intro. Exact (ad_faithful_1 (ad_x p0) [n:nat](H1 (S n))).
- Unfold eqf. Unfold eqf in H0. Intro. Rewrite H0. Reflexivity.
+ destruct a. intros. cut (eqf (ad_bit ad_z) (ad_bit (ad_x (xI p)))).
+ intro. rewrite (ad_faithful_1 (ad_x (xI p)) H1). reflexivity.
+ unfold eqf in |- *. intro. unfold eqf in H0. rewrite H0. reflexivity.
+ case p. intros. rewrite (H p0 (fun n:nat => H0 (S n))). reflexivity.
+ intros. absurd (true = false). discriminate.
+ exact (H0 0).
+ intros. absurd (ad_z = ad_x p0). discriminate.
+ cut (eqf (ad_bit (ad_x 1)) (ad_bit (ad_x (xI p0)))).
+ intro. exact (ad_faithful_1 (ad_x p0) (fun n:nat => H1 (S n))).
+ unfold eqf in |- *. unfold eqf in H0. intro. rewrite H0. reflexivity.
Qed.
-Lemma ad_faithful : (a,a':ad) (eqf (ad_bit a) (ad_bit a')) -> a=a'.
+Lemma ad_faithful : forall a a':ad, eqf (ad_bit a) (ad_bit a') -> a = a'.
Proof.
- NewDestruct a. Exact ad_faithful_1.
- NewInduction p. Intros a' H. Apply ad_faithful_4. Intros. Cut (ad_x p)=(ad_x p').
- Intro. Inversion H1. Reflexivity.
- Exact (IHp (ad_x p') H0).
- Assumption.
- Intros. Apply ad_faithful_3. Intros. Cut (ad_x p)=(ad_x p'). Intro. Inversion H1. Reflexivity.
- Exact (IHp (ad_x p') H0).
- Assumption.
- Exact ad_faithful_2.
+ destruct a. exact ad_faithful_1.
+ induction p. intros a' H. apply ad_faithful_4. intros. cut (ad_x p = ad_x p').
+ intro. inversion H1. reflexivity.
+ exact (IHp (ad_x p') H0).
+ assumption.
+ intros. apply ad_faithful_3. intros. cut (ad_x p = ad_x p'). intro. inversion H1. reflexivity.
+ exact (IHp (ad_x p') H0).
+ assumption.
+ exact ad_faithful_2.
Qed.
-Definition adf_xor := [f,g:nat->bool; n:nat] (xorb (f n) (g n)).
+Definition adf_xor (f g:nat -> bool) (n:nat) := xorb (f n) (g n).
-Lemma ad_xor_sem_1 : (a':ad) (ad_bit (ad_xor ad_z a') O)=(ad_bit a' O).
+Lemma ad_xor_sem_1 : forall a':ad, ad_bit (ad_xor ad_z a') 0 = ad_bit a' 0.
Proof.
- Trivial.
+ trivial.
Qed.
-Lemma ad_xor_sem_2 : (a':ad) (ad_bit (ad_xor (ad_x xH) a') O)=(negb (ad_bit a' O)).
+Lemma ad_xor_sem_2 :
+ forall a':ad, ad_bit (ad_xor (ad_x 1) a') 0 = negb (ad_bit a' 0).
Proof.
- Intro. Case a'. Trivial.
- Simpl. Intro.
- Case p; Trivial.
+ intro. case a'. trivial.
+ simpl in |- *. intro.
+ case p; trivial.
Qed.
Lemma ad_xor_sem_3 :
- (p:positive) (a':ad) (ad_bit (ad_xor (ad_x (xO p)) a') O)=(ad_bit a' O).
+ forall (p:positive) (a':ad),
+ ad_bit (ad_xor (ad_x (xO p)) a') 0 = ad_bit a' 0.
Proof.
- Intros. Case a'. Trivial.
- Simpl. Intro.
- Case p0; Trivial. Intro.
- Case (p_xor p p1); Trivial.
- Intro. Case (p_xor p p1); Trivial.
+ intros. case a'. trivial.
+ simpl in |- *. intro.
+ case p0; trivial. intro.
+ case (p_xor p p1); trivial.
+ intro. case (p_xor p p1); trivial.
Qed.
-Lemma ad_xor_sem_4 : (p:positive) (a':ad)
- (ad_bit (ad_xor (ad_x (xI p)) a') O)=(negb (ad_bit a' O)).
+Lemma ad_xor_sem_4 :
+ forall (p:positive) (a':ad),
+ ad_bit (ad_xor (ad_x (xI p)) a') 0 = negb (ad_bit a' 0).
Proof.
- Intros. Case a'. Trivial.
- Simpl. Intro. Case p0; Trivial. Intro.
- Case (p_xor p p1); Trivial.
- Intro.
- Case (p_xor p p1); Trivial.
+ intros. case a'. trivial.
+ simpl in |- *. intro. case p0; trivial. intro.
+ case (p_xor p p1); trivial.
+ intro.
+ case (p_xor p p1); trivial.
Qed.
Lemma ad_xor_sem_5 :
- (a,a':ad) (ad_bit (ad_xor a a') O)=(adf_xor (ad_bit a) (ad_bit a') O).
-Proof.
- NewDestruct a. Intro. Change (ad_bit a' O)=(xorb false (ad_bit a' O)). Rewrite false_xorb. Trivial.
- Case p. Exact ad_xor_sem_4.
- Intros. Change (ad_bit (ad_xor (ad_x (xO p0)) a') O)=(xorb false (ad_bit a' O)).
- Rewrite false_xorb. Apply ad_xor_sem_3. Exact ad_xor_sem_2.
-Qed.
-
-Lemma ad_xor_sem_6 : (n:nat)
- ((a,a':ad) (ad_bit (ad_xor a a') n)=(adf_xor (ad_bit a) (ad_bit a') n)) ->
- (a,a':ad) (ad_bit (ad_xor a a') (S n))=(adf_xor (ad_bit a) (ad_bit a') (S n)).
-Proof.
- Intros. Case a. Unfold adf_xor. Unfold 2 ad_bit. Rewrite false_xorb. Reflexivity.
- Case a'. Unfold adf_xor. Unfold 3 ad_bit. Intro. Rewrite xorb_false. Reflexivity.
- Intros. Case p0. Case p. Intros.
- Change (ad_bit (ad_xor (ad_x (xI p2)) (ad_x (xI p1))) (S n))
- =(adf_xor (ad_bit (ad_x p2)) (ad_bit (ad_x p1)) n).
- Rewrite <- H. Simpl.
- Case (p_xor p2 p1); Trivial.
- Intros.
- Change (ad_bit (ad_xor (ad_x (xI p2)) (ad_x (xO p1))) (S n))
- =(adf_xor (ad_bit (ad_x p2)) (ad_bit (ad_x p1)) n).
- Rewrite <- H. Simpl.
- Case (p_xor p2 p1); Trivial.
- Intro. Unfold adf_xor. Unfold 3 ad_bit. Unfold ad_bit_1. Rewrite xorb_false. Reflexivity.
- Case p. Intros.
- Change (ad_bit (ad_xor (ad_x (xO p2)) (ad_x (xI p1))) (S n))
- =(adf_xor (ad_bit (ad_x p2)) (ad_bit (ad_x p1)) n).
- Rewrite <- H. Simpl.
- Case (p_xor p2 p1); Trivial.
- Intros.
- Change (ad_bit (ad_xor (ad_x (xO p2)) (ad_x (xO p1))) (S n))
- =(adf_xor (ad_bit (ad_x p2)) (ad_bit (ad_x p1)) n).
- Rewrite <- H. Simpl.
- Case (p_xor p2 p1); Trivial.
- Intro. Unfold adf_xor. Unfold 3 ad_bit. Unfold ad_bit_1. Rewrite xorb_false. Reflexivity.
- Unfold adf_xor. Unfold 2 ad_bit. Unfold ad_bit_1. Rewrite false_xorb. Simpl. Case p; Trivial.
+ forall a a':ad, ad_bit (ad_xor a a') 0 = adf_xor (ad_bit a) (ad_bit a') 0.
+Proof.
+ destruct a. intro. change (ad_bit a' 0 = xorb false (ad_bit a' 0)) in |- *. rewrite false_xorb. trivial.
+ case p. exact ad_xor_sem_4.
+ intros. change (ad_bit (ad_xor (ad_x (xO p0)) a') 0 = xorb false (ad_bit a' 0))
+ in |- *.
+ rewrite false_xorb. apply ad_xor_sem_3. exact ad_xor_sem_2.
+Qed.
+
+Lemma ad_xor_sem_6 :
+ forall n:nat,
+ (forall a a':ad, ad_bit (ad_xor a a') n = adf_xor (ad_bit a) (ad_bit a') n) ->
+ forall a a':ad,
+ ad_bit (ad_xor a a') (S n) = adf_xor (ad_bit a) (ad_bit a') (S n).
+Proof.
+ intros. case a. unfold adf_xor in |- *. unfold ad_bit at 2 in |- *. rewrite false_xorb. reflexivity.
+ case a'. unfold adf_xor in |- *. unfold ad_bit at 3 in |- *. intro. rewrite xorb_false. reflexivity.
+ intros. case p0. case p. intros.
+ change
+ (ad_bit (ad_xor (ad_x (xI p2)) (ad_x (xI p1))) (S n) =
+ adf_xor (ad_bit (ad_x p2)) (ad_bit (ad_x p1)) n)
+ in |- *.
+ rewrite <- H. simpl in |- *.
+ case (p_xor p2 p1); trivial.
+ intros.
+ change
+ (ad_bit (ad_xor (ad_x (xI p2)) (ad_x (xO p1))) (S n) =
+ adf_xor (ad_bit (ad_x p2)) (ad_bit (ad_x p1)) n)
+ in |- *.
+ rewrite <- H. simpl in |- *.
+ case (p_xor p2 p1); trivial.
+ intro. unfold adf_xor in |- *. unfold ad_bit at 3 in |- *. unfold ad_bit_1 in |- *. rewrite xorb_false. reflexivity.
+ case p. intros.
+ change
+ (ad_bit (ad_xor (ad_x (xO p2)) (ad_x (xI p1))) (S n) =
+ adf_xor (ad_bit (ad_x p2)) (ad_bit (ad_x p1)) n)
+ in |- *.
+ rewrite <- H. simpl in |- *.
+ case (p_xor p2 p1); trivial.
+ intros.
+ change
+ (ad_bit (ad_xor (ad_x (xO p2)) (ad_x (xO p1))) (S n) =
+ adf_xor (ad_bit (ad_x p2)) (ad_bit (ad_x p1)) n)
+ in |- *.
+ rewrite <- H. simpl in |- *.
+ case (p_xor p2 p1); trivial.
+ intro. unfold adf_xor in |- *. unfold ad_bit at 3 in |- *. unfold ad_bit_1 in |- *. rewrite xorb_false. reflexivity.
+ unfold adf_xor in |- *. unfold ad_bit at 2 in |- *. unfold ad_bit_1 in |- *. rewrite false_xorb. simpl in |- *. case p; trivial.
Qed.
Lemma ad_xor_semantics :
- (a,a':ad) (eqf (ad_bit (ad_xor a a')) (adf_xor (ad_bit a) (ad_bit a'))).
+ forall a a':ad, eqf (ad_bit (ad_xor a a')) (adf_xor (ad_bit a) (ad_bit a')).
Proof.
- Unfold eqf. Intros. Generalize a a'. Elim n. Exact ad_xor_sem_5.
- Exact ad_xor_sem_6.
+ unfold eqf in |- *. intros. generalize a a'. elim n. exact ad_xor_sem_5.
+ exact ad_xor_sem_6.
Qed.
-Lemma eqf_sym : (f,f':nat->bool) (eqf f f') -> (eqf f' f).
+Lemma eqf_sym : forall f f':nat -> bool, eqf f f' -> eqf f' f.
Proof.
- Unfold eqf. Intros. Rewrite H. Reflexivity.
+ unfold eqf in |- *. intros. rewrite H. reflexivity.
Qed.
-Lemma eqf_refl : (f:nat->bool) (eqf f f).
+Lemma eqf_refl : forall f:nat -> bool, eqf f f.
Proof.
- Unfold eqf. Trivial.
+ unfold eqf in |- *. trivial.
Qed.
-Lemma eqf_trans : (f,f',f'':nat->bool) (eqf f f') -> (eqf f' f'') -> (eqf f f'').
+Lemma eqf_trans :
+ forall f f' f'':nat -> bool, eqf f f' -> eqf f' f'' -> eqf f f''.
Proof.
- Unfold eqf. Intros. Rewrite H. Exact (H0 n).
+ unfold eqf in |- *. intros. rewrite H. exact (H0 n).
Qed.
-Lemma adf_xor_eq : (f,f':nat->bool) (eqf (adf_xor f f') [n:nat] false) -> (eqf f f').
+Lemma adf_xor_eq :
+ forall f f':nat -> bool, eqf (adf_xor f f') (fun n:nat => false) -> eqf f f'.
Proof.
- Unfold eqf. Unfold adf_xor. Intros. Apply xorb_eq. Apply H.
+ unfold eqf in |- *. unfold adf_xor in |- *. intros. apply xorb_eq. apply H.
Qed.
-Lemma ad_xor_eq : (a,a':ad) (ad_xor a a')=ad_z -> a=a'.
+Lemma ad_xor_eq : forall a a':ad, ad_xor a a' = ad_z -> a = a'.
Proof.
- Intros. Apply ad_faithful. Apply adf_xor_eq. Apply eqf_trans with f':=(ad_bit (ad_xor a a')).
- Apply eqf_sym. Apply ad_xor_semantics.
- Rewrite H. Unfold eqf. Trivial.
+ intros. apply ad_faithful. apply adf_xor_eq. apply eqf_trans with (f' := ad_bit (ad_xor a a')).
+ apply eqf_sym. apply ad_xor_semantics.
+ rewrite H. unfold eqf in |- *. trivial.
Qed.
-Lemma adf_xor_assoc : (f,f',f'':nat->bool)
- (eqf (adf_xor (adf_xor f f') f'') (adf_xor f (adf_xor f' f''))).
+Lemma adf_xor_assoc :
+ forall f f' f'':nat -> bool,
+ eqf (adf_xor (adf_xor f f') f'') (adf_xor f (adf_xor f' f'')).
Proof.
- Unfold eqf. Unfold adf_xor. Intros. Apply xorb_assoc.
+ unfold eqf in |- *. unfold adf_xor in |- *. intros. apply xorb_assoc.
Qed.
-Lemma eqf_xor_1 : (f,f',f'',f''':nat->bool) (eqf f f') -> (eqf f'' f''') ->
- (eqf (adf_xor f f'') (adf_xor f' f''')).
+Lemma eqf_xor_1 :
+ forall f f' f'' f''':nat -> bool,
+ eqf f f' -> eqf f'' f''' -> eqf (adf_xor f f'') (adf_xor f' f''').
Proof.
- Unfold eqf. Intros. Unfold adf_xor. Rewrite H. Rewrite H0. Reflexivity.
+ unfold eqf in |- *. intros. unfold adf_xor in |- *. rewrite H. rewrite H0. reflexivity.
Qed.
Lemma ad_xor_assoc :
- (a,a',a'':ad) (ad_xor (ad_xor a a') a'')=(ad_xor a (ad_xor a' a'')).
-Proof.
- Intros. Apply ad_faithful.
- Apply eqf_trans with f':=(adf_xor (adf_xor (ad_bit a) (ad_bit a')) (ad_bit a'')).
- Apply eqf_trans with f':=(adf_xor (ad_bit (ad_xor a a')) (ad_bit a'')).
- Apply ad_xor_semantics.
- Apply eqf_xor_1. Apply ad_xor_semantics.
- Apply eqf_refl.
- Apply eqf_trans with f':=(adf_xor (ad_bit a) (adf_xor (ad_bit a') (ad_bit a''))).
- Apply adf_xor_assoc.
- Apply eqf_trans with f':=(adf_xor (ad_bit a) (ad_bit (ad_xor a' a''))).
- Apply eqf_xor_1. Apply eqf_refl.
- Apply eqf_sym. Apply ad_xor_semantics.
- Apply eqf_sym. Apply ad_xor_semantics.
-Qed.
-
-Definition ad_double := [a:ad]
- Cases a of
- ad_z => ad_z
- | (ad_x p) => (ad_x (xO p))
+ forall a a' a'':ad, ad_xor (ad_xor a a') a'' = ad_xor a (ad_xor a' a'').
+Proof.
+ intros. apply ad_faithful.
+ apply eqf_trans with
+ (f' := adf_xor (adf_xor (ad_bit a) (ad_bit a')) (ad_bit a'')).
+ apply eqf_trans with (f' := adf_xor (ad_bit (ad_xor a a')) (ad_bit a'')).
+ apply ad_xor_semantics.
+ apply eqf_xor_1. apply ad_xor_semantics.
+ apply eqf_refl.
+ apply eqf_trans with
+ (f' := adf_xor (ad_bit a) (adf_xor (ad_bit a') (ad_bit a''))).
+ apply adf_xor_assoc.
+ apply eqf_trans with (f' := adf_xor (ad_bit a) (ad_bit (ad_xor a' a''))).
+ apply eqf_xor_1. apply eqf_refl.
+ apply eqf_sym. apply ad_xor_semantics.
+ apply eqf_sym. apply ad_xor_semantics.
+Qed.
+
+Definition ad_double (a:ad) :=
+ match a with
+ | ad_z => ad_z
+ | ad_x p => ad_x (xO p)
end.
-Definition ad_double_plus_un := [a:ad]
- Cases a of
- ad_z => (ad_x xH)
- | (ad_x p) => (ad_x (xI p))
+Definition ad_double_plus_un (a:ad) :=
+ match a with
+ | ad_z => ad_x 1
+ | ad_x p => ad_x (xI p)
end.
-Definition ad_div_2 := [a:ad]
- Cases a of
- ad_z => ad_z
- | (ad_x xH) => ad_z
- | (ad_x (xO p)) => (ad_x p)
- | (ad_x (xI p)) => (ad_x p)
+Definition ad_div_2 (a:ad) :=
+ match a with
+ | ad_z => ad_z
+ | ad_x xH => ad_z
+ | ad_x (xO p) => ad_x p
+ | ad_x (xI p) => ad_x p
end.
-Lemma ad_double_div_2 : (a:ad) (ad_div_2 (ad_double a))=a.
+Lemma ad_double_div_2 : forall a:ad, ad_div_2 (ad_double a) = a.
Proof.
- NewDestruct a; Trivial.
+ destruct a; trivial.
Qed.
-Lemma ad_double_plus_un_div_2 : (a:ad) (ad_div_2 (ad_double_plus_un a))=a.
+Lemma ad_double_plus_un_div_2 :
+ forall a:ad, ad_div_2 (ad_double_plus_un a) = a.
Proof.
- NewDestruct a; Trivial.
+ destruct a; trivial.
Qed.
-Lemma ad_double_inj : (a0,a1:ad) (ad_double a0)=(ad_double a1) -> a0=a1.
+Lemma ad_double_inj : forall a0 a1:ad, ad_double a0 = ad_double a1 -> a0 = a1.
Proof.
- Intros. Rewrite <- (ad_double_div_2 a0). Rewrite H. Apply ad_double_div_2.
+ intros. rewrite <- (ad_double_div_2 a0). rewrite H. apply ad_double_div_2.
Qed.
Lemma ad_double_plus_un_inj :
- (a0,a1:ad) (ad_double_plus_un a0)=(ad_double_plus_un a1) -> a0=a1.
+ forall a0 a1:ad, ad_double_plus_un a0 = ad_double_plus_un a1 -> a0 = a1.
Proof.
- Intros. Rewrite <- (ad_double_plus_un_div_2 a0). Rewrite H. Apply ad_double_plus_un_div_2.
+ intros. rewrite <- (ad_double_plus_un_div_2 a0). rewrite H. apply ad_double_plus_un_div_2.
Qed.
-Definition ad_bit_0 := [a:ad]
- Cases a of
- ad_z => false
- | (ad_x (xO _)) => false
- | _ => true
+Definition ad_bit_0 (a:ad) :=
+ match a with
+ | ad_z => false
+ | ad_x (xO _) => false
+ | _ => true
end.
-Lemma ad_double_bit_0 : (a:ad) (ad_bit_0 (ad_double a))=false.
+Lemma ad_double_bit_0 : forall a:ad, ad_bit_0 (ad_double a) = false.
Proof.
- NewDestruct a; Trivial.
+ destruct a; trivial.
Qed.
-Lemma ad_double_plus_un_bit_0 : (a:ad) (ad_bit_0 (ad_double_plus_un a))=true.
+Lemma ad_double_plus_un_bit_0 :
+ forall a:ad, ad_bit_0 (ad_double_plus_un a) = true.
Proof.
- NewDestruct a; Trivial.
+ destruct a; trivial.
Qed.
-Lemma ad_div_2_double : (a:ad) (ad_bit_0 a)=false -> (ad_double (ad_div_2 a))=a.
+Lemma ad_div_2_double :
+ forall a:ad, ad_bit_0 a = false -> ad_double (ad_div_2 a) = a.
Proof.
- NewDestruct a. Trivial. NewDestruct p. Intro H. Discriminate H.
- Intros. Reflexivity.
- Intro H. Discriminate H.
+ destruct a. trivial. destruct p. intro H. discriminate H.
+ intros. reflexivity.
+ intro H. discriminate H.
Qed.
Lemma ad_div_2_double_plus_un :
- (a:ad) (ad_bit_0 a)=true -> (ad_double_plus_un (ad_div_2 a))=a.
+ forall a:ad, ad_bit_0 a = true -> ad_double_plus_un (ad_div_2 a) = a.
Proof.
- NewDestruct a. Intro. Discriminate H.
- NewDestruct p. Intros. Reflexivity.
- Intro H. Discriminate H.
- Intro. Reflexivity.
+ destruct a. intro. discriminate H.
+ destruct p. intros. reflexivity.
+ intro H. discriminate H.
+ intro. reflexivity.
Qed.
-Lemma ad_bit_0_correct : (a:ad) (ad_bit a O)=(ad_bit_0 a).
+Lemma ad_bit_0_correct : forall a:ad, ad_bit a 0 = ad_bit_0 a.
Proof.
- NewDestruct a; Trivial.
- NewDestruct p; Trivial.
+ destruct a; trivial.
+ destruct p; trivial.
Qed.
-Lemma ad_div_2_correct : (a:ad) (n:nat) (ad_bit (ad_div_2 a) n)=(ad_bit a (S n)).
+Lemma ad_div_2_correct :
+ forall (a:ad) (n:nat), ad_bit (ad_div_2 a) n = ad_bit a (S n).
Proof.
- NewDestruct a; Trivial.
- NewDestruct p; Trivial.
+ destruct a; trivial.
+ destruct p; trivial.
Qed.
Lemma ad_xor_bit_0 :
- (a,a':ad) (ad_bit_0 (ad_xor a a'))=(xorb (ad_bit_0 a) (ad_bit_0 a')).
+ forall a a':ad, ad_bit_0 (ad_xor a a') = xorb (ad_bit_0 a) (ad_bit_0 a').
Proof.
- Intros. Rewrite <- ad_bit_0_correct. Rewrite (ad_xor_semantics a a' O).
- Unfold adf_xor. Rewrite ad_bit_0_correct. Rewrite ad_bit_0_correct. Reflexivity.
+ intros. rewrite <- ad_bit_0_correct. rewrite (ad_xor_semantics a a' 0).
+ unfold adf_xor in |- *. rewrite ad_bit_0_correct. rewrite ad_bit_0_correct. reflexivity.
Qed.
Lemma ad_xor_div_2 :
- (a,a':ad) (ad_div_2 (ad_xor a a'))=(ad_xor (ad_div_2 a) (ad_div_2 a')).
+ forall a a':ad, ad_div_2 (ad_xor a a') = ad_xor (ad_div_2 a) (ad_div_2 a').
Proof.
- Intros. Apply ad_faithful. Unfold eqf. Intro.
- Rewrite (ad_xor_semantics (ad_div_2 a) (ad_div_2 a') n).
- Rewrite ad_div_2_correct.
- Rewrite (ad_xor_semantics a a' (S n)).
- Unfold adf_xor. Rewrite ad_div_2_correct. Rewrite ad_div_2_correct.
- Reflexivity.
+ intros. apply ad_faithful. unfold eqf in |- *. intro.
+ rewrite (ad_xor_semantics (ad_div_2 a) (ad_div_2 a') n).
+ rewrite ad_div_2_correct.
+ rewrite (ad_xor_semantics a a' (S n)).
+ unfold adf_xor in |- *. rewrite ad_div_2_correct. rewrite ad_div_2_correct.
+ reflexivity.
Qed.
-Lemma ad_neg_bit_0 : (a,a':ad) (ad_bit_0 (ad_xor a a'))=true ->
- (ad_bit_0 a)=(negb (ad_bit_0 a')).
+Lemma ad_neg_bit_0 :
+ forall a a':ad,
+ ad_bit_0 (ad_xor a a') = true -> ad_bit_0 a = negb (ad_bit_0 a').
Proof.
- Intros. Rewrite <- true_xorb. Rewrite <- H. Rewrite ad_xor_bit_0.
- Rewrite xorb_assoc. Rewrite xorb_nilpotent. Rewrite xorb_false. Reflexivity.
+ intros. rewrite <- true_xorb. rewrite <- H. rewrite ad_xor_bit_0.
+ rewrite xorb_assoc. rewrite xorb_nilpotent. rewrite xorb_false. reflexivity.
Qed.
Lemma ad_neg_bit_0_1 :
- (a,a':ad) (ad_xor a a')=(ad_x xH) -> (ad_bit_0 a)=(negb (ad_bit_0 a')).
+ forall a a':ad, ad_xor a a' = ad_x 1 -> ad_bit_0 a = negb (ad_bit_0 a').
Proof.
- Intros. Apply ad_neg_bit_0. Rewrite H. Reflexivity.
+ intros. apply ad_neg_bit_0. rewrite H. reflexivity.
Qed.
-Lemma ad_neg_bit_0_2 : (a,a':ad) (p:positive) (ad_xor a a')=(ad_x (xI p)) ->
- (ad_bit_0 a)=(negb (ad_bit_0 a')).
+Lemma ad_neg_bit_0_2 :
+ forall (a a':ad) (p:positive),
+ ad_xor a a' = ad_x (xI p) -> ad_bit_0 a = negb (ad_bit_0 a').
Proof.
- Intros. Apply ad_neg_bit_0. Rewrite H. Reflexivity.
+ intros. apply ad_neg_bit_0. rewrite H. reflexivity.
Qed.
-Lemma ad_same_bit_0 : (a,a':ad) (p:positive) (ad_xor a a')=(ad_x (xO p)) ->
- (ad_bit_0 a)=(ad_bit_0 a').
+Lemma ad_same_bit_0 :
+ forall (a a':ad) (p:positive),
+ ad_xor a a' = ad_x (xO p) -> ad_bit_0 a = ad_bit_0 a'.
Proof.
- Intros. Rewrite <- (xorb_false (ad_bit_0 a)). Cut (ad_bit_0 (ad_x (xO p)))=false.
- Intro. Rewrite <- H0. Rewrite <- H. Rewrite ad_xor_bit_0. Rewrite <- xorb_assoc.
- Rewrite xorb_nilpotent. Rewrite false_xorb. Reflexivity.
- Reflexivity.
-Qed.
+ intros. rewrite <- (xorb_false (ad_bit_0 a)). cut (ad_bit_0 (ad_x (xO p)) = false).
+ intro. rewrite <- H0. rewrite <- H. rewrite ad_xor_bit_0. rewrite <- xorb_assoc.
+ rewrite xorb_nilpotent. rewrite false_xorb. reflexivity.
+ reflexivity.
+Qed. \ No newline at end of file
diff --git a/theories/IntMap/Adist.v b/theories/IntMap/Adist.v
index fbc2870f1..30b54ac14 100644
--- a/theories/IntMap/Adist.v
+++ b/theories/IntMap/Adist.v
@@ -7,233 +7,244 @@
(***********************************************************************)
(*i $Id$ i*)
-Require Bool.
-Require ZArith.
-Require Arith.
-Require Min.
-Require Addr.
-
-Fixpoint ad_plength_1 [p:positive] : nat :=
- Cases p of
- xH => O
- | (xI _) => O
- | (xO p') => (S (ad_plength_1 p'))
+Require Import Bool.
+Require Import ZArith.
+Require Import Arith.
+Require Import Min.
+Require Import Addr.
+
+Fixpoint ad_plength_1 (p:positive) : nat :=
+ match p with
+ | xH => 0
+ | xI _ => 0
+ | xO p' => S (ad_plength_1 p')
end.
Inductive natinf : Set :=
- infty : natinf
+ | infty : natinf
| ni : nat -> natinf.
-Definition ad_plength := [a:ad]
- Cases a of
- ad_z => infty
- | (ad_x p) => (ni (ad_plength_1 p))
+Definition ad_plength (a:ad) :=
+ match a with
+ | ad_z => infty
+ | ad_x p => ni (ad_plength_1 p)
end.
-Lemma ad_plength_infty : (a:ad) (ad_plength a)=infty -> a=ad_z.
+Lemma ad_plength_infty : forall a:ad, ad_plength a = infty -> a = ad_z.
Proof.
- Induction a; Trivial.
- Unfold ad_plength; Intros; Discriminate H.
+ simple induction a; trivial.
+ unfold ad_plength in |- *; intros; discriminate H.
Qed.
-Lemma ad_plength_zeros : (a:ad) (n:nat) (ad_plength a)=(ni n) ->
- (k:nat) (lt k n) -> (ad_bit a k)=false.
+Lemma ad_plength_zeros :
+ forall (a:ad) (n:nat),
+ ad_plength a = ni n -> forall k:nat, k < n -> ad_bit a k = false.
Proof.
- Induction a; Trivial.
- Induction p. Induction n. Intros. Inversion H1.
- Induction k. Simpl in H1. Discriminate H1.
- Intros. Simpl in H1. Discriminate H1.
- Induction k. Trivial.
- Generalize H0. Case n. Intros. Inversion H3.
- Intros. Simpl. Unfold ad_bit in H. Apply (H n0). Simpl in H1. Inversion H1. Reflexivity.
- Exact (lt_S_n n1 n0 H3).
- Simpl. Intros n H. Inversion H. Intros. Inversion H0.
+ simple induction a; trivial.
+ simple induction p. simple induction n. intros. inversion H1.
+ simple induction k. simpl in H1. discriminate H1.
+ intros. simpl in H1. discriminate H1.
+ simple induction k. trivial.
+ generalize H0. case n. intros. inversion H3.
+ intros. simpl in |- *. unfold ad_bit in H. apply (H n0). simpl in H1. inversion H1. reflexivity.
+ exact (lt_S_n n1 n0 H3).
+ simpl in |- *. intros n H. inversion H. intros. inversion H0.
Qed.
-Lemma ad_plength_one : (a:ad) (n:nat) (ad_plength a)=(ni n) -> (ad_bit a n)=true.
+Lemma ad_plength_one :
+ forall (a:ad) (n:nat), ad_plength a = ni n -> ad_bit a n = true.
Proof.
- Induction a. Intros. Inversion H.
- Induction p. Intros. Simpl in H0. Inversion H0. Reflexivity.
- Intros. Simpl in H0. Inversion H0. Simpl. Unfold ad_bit in H. Apply H. Reflexivity.
- Intros. Simpl in H. Inversion H. Reflexivity.
+ simple induction a. intros. inversion H.
+ simple induction p. intros. simpl in H0. inversion H0. reflexivity.
+ intros. simpl in H0. inversion H0. simpl in |- *. unfold ad_bit in H. apply H. reflexivity.
+ intros. simpl in H. inversion H. reflexivity.
Qed.
-Lemma ad_plength_first_one : (a:ad) (n:nat)
- ((k:nat) (lt k n) -> (ad_bit a k)=false) -> (ad_bit a n)=true ->
- (ad_plength a)=(ni n).
+Lemma ad_plength_first_one :
+ forall (a:ad) (n:nat),
+ (forall k:nat, k < n -> ad_bit a k = false) ->
+ ad_bit a n = true -> ad_plength a = ni n.
Proof.
- Induction a. Intros. Simpl in H0. Discriminate H0.
- Induction p. Intros. Generalize H0. Case n. Intros. Reflexivity.
- Intros. Absurd (ad_bit (ad_x (xI p0)) O)=false. Trivial with bool.
- Auto with bool arith.
- Intros. Generalize H0 H1. Case n. Intros. Simpl in H3. Discriminate H3.
- Intros. Simpl. Unfold ad_plength in H.
- Cut (ni (ad_plength_1 p0))=(ni n0). Intro. Inversion H4. Reflexivity.
- Apply H. Intros. Change (ad_bit (ad_x (xO p0)) (S k))=false. Apply H2. Apply lt_n_S. Exact H4.
- Exact H3.
- Intro. Case n. Trivial.
- Intros. Simpl in H0. Discriminate H0.
+ simple induction a. intros. simpl in H0. discriminate H0.
+ simple induction p. intros. generalize H0. case n. intros. reflexivity.
+ intros. absurd (ad_bit (ad_x (xI p0)) 0 = false). trivial with bool.
+ auto with bool arith.
+ intros. generalize H0 H1. case n. intros. simpl in H3. discriminate H3.
+ intros. simpl in |- *. unfold ad_plength in H.
+ cut (ni (ad_plength_1 p0) = ni n0). intro. inversion H4. reflexivity.
+ apply H. intros. change (ad_bit (ad_x (xO p0)) (S k) = false) in |- *. apply H2. apply lt_n_S. exact H4.
+ exact H3.
+ intro. case n. trivial.
+ intros. simpl in H0. discriminate H0.
Qed.
-Definition ni_min := [d,d':natinf]
- Cases d of
- infty => d'
- | (ni n) => Cases d' of
- infty => d
- | (ni n') => (ni (min n n'))
- end
+Definition ni_min (d d':natinf) :=
+ match d with
+ | infty => d'
+ | ni n => match d' with
+ | infty => d
+ | ni n' => ni (min n n')
+ end
end.
-Lemma ni_min_idemp : (d:natinf) (ni_min d d)=d.
+Lemma ni_min_idemp : forall d:natinf, ni_min d d = d.
Proof.
- Induction d; Trivial.
- Unfold ni_min.
- Induction n; Trivial.
- Intros.
- Simpl.
- Inversion H.
- Rewrite H1.
- Rewrite H1.
- Reflexivity.
+ simple induction d; trivial.
+ unfold ni_min in |- *.
+ simple induction n; trivial.
+ intros.
+ simpl in |- *.
+ inversion H.
+ rewrite H1.
+ rewrite H1.
+ reflexivity.
Qed.
-Lemma ni_min_comm : (d,d':natinf) (ni_min d d')=(ni_min d' d).
+Lemma ni_min_comm : forall d d':natinf, ni_min d d' = ni_min d' d.
Proof.
- Induction d. Induction d'; Trivial.
- Induction d'; Trivial. Elim n. Induction n0; Trivial.
- Intros. Elim n1; Trivial. Intros. Unfold ni_min in H. Cut (min n0 n2)=(min n2 n0).
- Intro. Unfold ni_min. Simpl. Rewrite H1. Reflexivity.
- Cut (ni (min n0 n2))=(ni (min n2 n0)). Intros.
- Inversion H1; Trivial.
- Exact (H n2).
+ simple induction d. simple induction d'; trivial.
+ simple induction d'; trivial. elim n. simple induction n0; trivial.
+ intros. elim n1; trivial. intros. unfold ni_min in H. cut (min n0 n2 = min n2 n0).
+ intro. unfold ni_min in |- *. simpl in |- *. rewrite H1. reflexivity.
+ cut (ni (min n0 n2) = ni (min n2 n0)). intros.
+ inversion H1; trivial.
+ exact (H n2).
Qed.
-Lemma ni_min_assoc : (d,d',d'':natinf) (ni_min (ni_min d d') d'')=(ni_min d (ni_min d' d'')).
+Lemma ni_min_assoc :
+ forall d d' d'':natinf, ni_min (ni_min d d') d'' = ni_min d (ni_min d' d'').
Proof.
- Induction d; Trivial. Induction d'; Trivial.
- Induction d''; Trivial.
- Unfold ni_min. Intro. Cut (min (min n n0) n1)=(min n (min n0 n1)).
- Intro. Rewrite H. Reflexivity.
- Generalize n0 n1. Elim n; Trivial.
- Induction n3; Trivial. Induction n5; Trivial.
- Intros. Simpl. Auto.
+ simple induction d; trivial. simple induction d'; trivial.
+ simple induction d''; trivial.
+ unfold ni_min in |- *. intro. cut (min (min n n0) n1 = min n (min n0 n1)).
+ intro. rewrite H. reflexivity.
+ generalize n0 n1. elim n; trivial.
+ simple induction n3; trivial. simple induction n5; trivial.
+ intros. simpl in |- *. auto.
Qed.
-Lemma ni_min_O_l : (d:natinf) (ni_min (ni O) d)=(ni O).
+Lemma ni_min_O_l : forall d:natinf, ni_min (ni 0) d = ni 0.
Proof.
- Induction d; Trivial.
+ simple induction d; trivial.
Qed.
-Lemma ni_min_O_r : (d:natinf) (ni_min d (ni O))=(ni O).
+Lemma ni_min_O_r : forall d:natinf, ni_min d (ni 0) = ni 0.
Proof.
- Intros. Rewrite ni_min_comm. Apply ni_min_O_l.
+ intros. rewrite ni_min_comm. apply ni_min_O_l.
Qed.
-Lemma ni_min_inf_l : (d:natinf) (ni_min infty d)=d.
+Lemma ni_min_inf_l : forall d:natinf, ni_min infty d = d.
Proof.
- Trivial.
+ trivial.
Qed.
-Lemma ni_min_inf_r : (d:natinf) (ni_min d infty)=d.
+Lemma ni_min_inf_r : forall d:natinf, ni_min d infty = d.
Proof.
- Induction d; Trivial.
+ simple induction d; trivial.
Qed.
-Definition ni_le := [d,d':natinf] (ni_min d d')=d.
+Definition ni_le (d d':natinf) := ni_min d d' = d.
-Lemma ni_le_refl : (d:natinf) (ni_le d d).
+Lemma ni_le_refl : forall d:natinf, ni_le d d.
Proof.
- Exact ni_min_idemp.
+ exact ni_min_idemp.
Qed.
-Lemma ni_le_antisym : (d,d':natinf) (ni_le d d') -> (ni_le d' d) -> d=d'.
+Lemma ni_le_antisym : forall d d':natinf, ni_le d d' -> ni_le d' d -> d = d'.
Proof.
- Unfold ni_le. Intros d d'. Rewrite ni_min_comm. Intro H. Rewrite H. Trivial.
+ unfold ni_le in |- *. intros d d'. rewrite ni_min_comm. intro H. rewrite H. trivial.
Qed.
-Lemma ni_le_trans : (d,d',d'':natinf) (ni_le d d') -> (ni_le d' d'') -> (ni_le d d'').
+Lemma ni_le_trans :
+ forall d d' d'':natinf, ni_le d d' -> ni_le d' d'' -> ni_le d d''.
Proof.
- Unfold ni_le. Intros. Rewrite <- H. Rewrite ni_min_assoc. Rewrite H0. Reflexivity.
+ unfold ni_le in |- *. intros. rewrite <- H. rewrite ni_min_assoc. rewrite H0. reflexivity.
Qed.
-Lemma ni_le_min_1 : (d,d':natinf) (ni_le (ni_min d d') d).
+Lemma ni_le_min_1 : forall d d':natinf, ni_le (ni_min d d') d.
Proof.
- Unfold ni_le. Intros. Rewrite (ni_min_comm d d'). Rewrite ni_min_assoc.
- Rewrite ni_min_idemp. Reflexivity.
+ unfold ni_le in |- *. intros. rewrite (ni_min_comm d d'). rewrite ni_min_assoc.
+ rewrite ni_min_idemp. reflexivity.
Qed.
-Lemma ni_le_min_2 : (d,d':natinf) (ni_le (ni_min d d') d').
+Lemma ni_le_min_2 : forall d d':natinf, ni_le (ni_min d d') d'.
Proof.
- Unfold ni_le. Intros. Rewrite ni_min_assoc. Rewrite ni_min_idemp. Reflexivity.
+ unfold ni_le in |- *. intros. rewrite ni_min_assoc. rewrite ni_min_idemp. reflexivity.
Qed.
-Lemma ni_min_case : (d,d':natinf) (ni_min d d')=d \/ (ni_min d d')=d'.
+Lemma ni_min_case : forall d d':natinf, ni_min d d' = d \/ ni_min d d' = d'.
Proof.
- Induction d. Intro. Right . Exact (ni_min_inf_l d').
- Induction d'. Left . Exact (ni_min_inf_r (ni n)).
- Unfold ni_min. Cut (n0:nat)(min n n0)=n\/(min n n0)=n0.
- Intros. Case (H n0). Intro. Left . Rewrite H0. Reflexivity.
- Intro. Right . Rewrite H0. Reflexivity.
- Elim n. Intro. Left . Reflexivity.
- Induction n1. Right . Reflexivity.
- Intros. Case (H n2). Intro. Left . Simpl. Rewrite H1. Reflexivity.
- Intro. Right . Simpl. Rewrite H1. Reflexivity.
+ simple induction d. intro. right. exact (ni_min_inf_l d').
+ simple induction d'. left. exact (ni_min_inf_r (ni n)).
+ unfold ni_min in |- *. cut (forall n0:nat, min n n0 = n \/ min n n0 = n0).
+ intros. case (H n0). intro. left. rewrite H0. reflexivity.
+ intro. right. rewrite H0. reflexivity.
+ elim n. intro. left. reflexivity.
+ simple induction n1. right. reflexivity.
+ intros. case (H n2). intro. left. simpl in |- *. rewrite H1. reflexivity.
+ intro. right. simpl in |- *. rewrite H1. reflexivity.
Qed.
-Lemma ni_le_total : (d,d':natinf) (ni_le d d') \/ (ni_le d' d).
+Lemma ni_le_total : forall d d':natinf, ni_le d d' \/ ni_le d' d.
Proof.
- Unfold ni_le. Intros. Rewrite (ni_min_comm d' d). Apply ni_min_case.
+ unfold ni_le in |- *. intros. rewrite (ni_min_comm d' d). apply ni_min_case.
Qed.
-Lemma ni_le_min_induc : (d,d',dm:natinf) (ni_le dm d) -> (ni_le dm d') ->
- ((d'':natinf) (ni_le d'' d) -> (ni_le d'' d') -> (ni_le d'' dm)) ->
- (ni_min d d')=dm.
+Lemma ni_le_min_induc :
+ forall d d' dm:natinf,
+ ni_le dm d ->
+ ni_le dm d' ->
+ (forall d'':natinf, ni_le d'' d -> ni_le d'' d' -> ni_le d'' dm) ->
+ ni_min d d' = dm.
Proof.
- Intros. Case (ni_min_case d d'). Intro. Rewrite H2.
- Apply ni_le_antisym. Apply H1. Apply ni_le_refl.
- Exact H2.
- Exact H.
- Intro. Rewrite H2. Apply ni_le_antisym. Apply H1. Unfold ni_le. Rewrite ni_min_comm. Exact H2.
- Apply ni_le_refl.
- Exact H0.
+ intros. case (ni_min_case d d'). intro. rewrite H2.
+ apply ni_le_antisym. apply H1. apply ni_le_refl.
+ exact H2.
+ exact H.
+ intro. rewrite H2. apply ni_le_antisym. apply H1. unfold ni_le in |- *. rewrite ni_min_comm. exact H2.
+ apply ni_le_refl.
+ exact H0.
Qed.
-Lemma le_ni_le : (m,n:nat) (le m n) -> (ni_le (ni m) (ni n)).
+Lemma le_ni_le : forall m n:nat, m <= n -> ni_le (ni m) (ni n).
Proof.
- Cut (m,n:nat)(le m n)->(min m n)=m.
- Intros. Unfold ni_le ni_min. Rewrite (H m n H0). Reflexivity.
- Induction m. Trivial.
- Induction n0. Intro. Inversion H0.
- Intros. Simpl. Rewrite (H n1 (le_S_n n n1 H1)). Reflexivity.
+ cut (forall m n:nat, m <= n -> min m n = m).
+ intros. unfold ni_le, ni_min in |- *. rewrite (H m n H0). reflexivity.
+ simple induction m. trivial.
+ simple induction n0. intro. inversion H0.
+ intros. simpl in |- *. rewrite (H n1 (le_S_n n n1 H1)). reflexivity.
Qed.
-Lemma ni_le_le : (m,n:nat) (ni_le (ni m) (ni n)) -> (le m n).
+Lemma ni_le_le : forall m n:nat, ni_le (ni m) (ni n) -> m <= n.
Proof.
- Unfold ni_le. Unfold ni_min. Intros. Inversion H. Apply le_min_r.
+ unfold ni_le in |- *. unfold ni_min in |- *. intros. inversion H. apply le_min_r.
Qed.
-Lemma ad_plength_lb : (a:ad) (n:nat) ((k:nat) (lt k n) -> (ad_bit a k)=false) ->
- (ni_le (ni n) (ad_plength a)).
+Lemma ad_plength_lb :
+ forall (a:ad) (n:nat),
+ (forall k:nat, k < n -> ad_bit a k = false) -> ni_le (ni n) (ad_plength a).
Proof.
- Induction a. Intros. Exact (ni_min_inf_r (ni n)).
- Intros. Unfold ad_plength. Apply le_ni_le. Case (le_or_lt n (ad_plength_1 p)). Trivial.
- Intro. Absurd (ad_bit (ad_x p) (ad_plength_1 p))=false.
- Rewrite (ad_plength_one (ad_x p) (ad_plength_1 p)
- (refl_equal natinf (ad_plength (ad_x p)))).
- Discriminate.
- Apply H. Exact H0.
+ simple induction a. intros. exact (ni_min_inf_r (ni n)).
+ intros. unfold ad_plength in |- *. apply le_ni_le. case (le_or_lt n (ad_plength_1 p)). trivial.
+ intro. absurd (ad_bit (ad_x p) (ad_plength_1 p) = false).
+ rewrite
+ (ad_plength_one (ad_x p) (ad_plength_1 p)
+ (refl_equal (ad_plength (ad_x p)))).
+ discriminate.
+ apply H. exact H0.
Qed.
-Lemma ad_plength_ub : (a:ad) (n:nat) (ad_bit a n)=true ->
- (ni_le (ad_plength a) (ni n)).
+Lemma ad_plength_ub :
+ forall (a:ad) (n:nat), ad_bit a n = true -> ni_le (ad_plength a) (ni n).
Proof.
- Induction a. Intros. Discriminate H.
- Intros. Unfold ad_plength. Apply le_ni_le. Case (le_or_lt (ad_plength_1 p) n). Trivial.
- Intro. Absurd (ad_bit (ad_x p) n)=true.
- Rewrite (ad_plength_zeros (ad_x p) (ad_plength_1 p)
- (refl_equal natinf (ad_plength (ad_x p))) n H0).
- Discriminate.
- Exact H.
+ simple induction a. intros. discriminate H.
+ intros. unfold ad_plength in |- *. apply le_ni_le. case (le_or_lt (ad_plength_1 p) n). trivial.
+ intro. absurd (ad_bit (ad_x p) n = true).
+ rewrite
+ (ad_plength_zeros (ad_x p) (ad_plength_1 p)
+ (refl_equal (ad_plength (ad_x p))) n H0).
+ discriminate.
+ exact H.
Qed.
@@ -244,26 +255,26 @@ Qed.
Instead of working with $d$, we work with $pd$, namely
[ad_pdist]: *)
-Definition ad_pdist := [a,a':ad] (ad_plength (ad_xor a a')).
+Definition ad_pdist (a a':ad) := ad_plength (ad_xor a a').
(** d is a distance, so $d(a,a')=0$ iff $a=a'$; this means that
$pd(a,a')=infty$ iff $a=a'$: *)
-Lemma ad_pdist_eq_1 : (a:ad) (ad_pdist a a)=infty.
+Lemma ad_pdist_eq_1 : forall a:ad, ad_pdist a a = infty.
Proof.
- Intros. Unfold ad_pdist. Rewrite ad_xor_nilpotent. Reflexivity.
+ intros. unfold ad_pdist in |- *. rewrite ad_xor_nilpotent. reflexivity.
Qed.
-Lemma ad_pdist_eq_2 : (a,a':ad) (ad_pdist a a')=infty -> a=a'.
+Lemma ad_pdist_eq_2 : forall a a':ad, ad_pdist a a' = infty -> a = a'.
Proof.
- Intros. Apply ad_xor_eq. Apply ad_plength_infty. Exact H.
+ intros. apply ad_xor_eq. apply ad_plength_infty. exact H.
Qed.
(** $d$ is a distance, so $d(a,a')=d(a',a)$: *)
-Lemma ad_pdist_comm : (a,a':ad) (ad_pdist a a')=(ad_pdist a' a).
+Lemma ad_pdist_comm : forall a a':ad, ad_pdist a a' = ad_pdist a' a.
Proof.
- Unfold ad_pdist. Intros. Rewrite ad_xor_comm. Reflexivity.
+ unfold ad_pdist in |- *. intros. rewrite ad_xor_comm. reflexivity.
Qed.
(** $d$ is an ultrametric distance, that is, not only $d(a,a')\leq
@@ -278,44 +289,48 @@ Qed.
(lemma [ad_plength_ultra]).
*)
-Lemma ad_plength_ultra_1 : (a,a':ad)
- (ni_le (ad_plength a) (ad_plength a')) ->
- (ni_le (ad_plength a) (ad_plength (ad_xor a a'))).
+Lemma ad_plength_ultra_1 :
+ forall a a':ad,
+ ni_le (ad_plength a) (ad_plength a') ->
+ ni_le (ad_plength a) (ad_plength (ad_xor a a')).
Proof.
- Induction a. Intros. Unfold ni_le in H. Unfold 1 3 ad_plength in H.
- Rewrite (ni_min_inf_l (ad_plength a')) in H.
- Rewrite (ad_plength_infty a' H). Simpl. Apply ni_le_refl.
- Intros. Unfold 1 ad_plength. Apply ad_plength_lb. Intros.
- Cut (a'':ad)(ad_xor (ad_x p) a')=a''->(ad_bit a'' k)=false.
- Intros. Apply H1. Reflexivity.
- Intro a''. Case a''. Intro. Reflexivity.
- Intros. Rewrite <- H1. Rewrite (ad_xor_semantics (ad_x p) a' k). Unfold adf_xor.
- Rewrite (ad_plength_zeros (ad_x p) (ad_plength_1 p)
- (refl_equal natinf (ad_plength (ad_x p))) k H0).
- Generalize H. Case a'. Trivial.
- Intros. Cut (ad_bit (ad_x p1) k)=false. Intros. Rewrite H3. Reflexivity.
- Apply ad_plength_zeros with n:=(ad_plength_1 p1). Reflexivity.
- Apply (lt_le_trans k (ad_plength_1 p) (ad_plength_1 p1)). Exact H0.
- Apply ni_le_le. Exact H2.
+ simple induction a. intros. unfold ni_le in H. unfold ad_plength at 1 3 in H.
+ rewrite (ni_min_inf_l (ad_plength a')) in H.
+ rewrite (ad_plength_infty a' H). simpl in |- *. apply ni_le_refl.
+ intros. unfold ad_plength at 1 in |- *. apply ad_plength_lb. intros.
+ cut (forall a'':ad, ad_xor (ad_x p) a' = a'' -> ad_bit a'' k = false).
+ intros. apply H1. reflexivity.
+ intro a''. case a''. intro. reflexivity.
+ intros. rewrite <- H1. rewrite (ad_xor_semantics (ad_x p) a' k). unfold adf_xor in |- *.
+ rewrite
+ (ad_plength_zeros (ad_x p) (ad_plength_1 p)
+ (refl_equal (ad_plength (ad_x p))) k H0).
+ generalize H. case a'. trivial.
+ intros. cut (ad_bit (ad_x p1) k = false). intros. rewrite H3. reflexivity.
+ apply ad_plength_zeros with (n := ad_plength_1 p1). reflexivity.
+ apply (lt_le_trans k (ad_plength_1 p) (ad_plength_1 p1)). exact H0.
+ apply ni_le_le. exact H2.
Qed.
-Lemma ad_plength_ultra : (a,a':ad)
- (ni_le (ni_min (ad_plength a) (ad_plength a')) (ad_plength (ad_xor a a'))).
+Lemma ad_plength_ultra :
+ forall a a':ad,
+ ni_le (ni_min (ad_plength a) (ad_plength a')) (ad_plength (ad_xor a a')).
Proof.
- Intros. Case (ni_le_total (ad_plength a) (ad_plength a')). Intro.
- Cut (ni_min (ad_plength a) (ad_plength a'))=(ad_plength a).
- Intro. Rewrite H0. Apply ad_plength_ultra_1. Exact H.
- Exact H.
- Intro. Cut (ni_min (ad_plength a) (ad_plength a'))=(ad_plength a').
- Intro. Rewrite H0. Rewrite ad_xor_comm. Apply ad_plength_ultra_1. Exact H.
- Rewrite ni_min_comm. Exact H.
+ intros. case (ni_le_total (ad_plength a) (ad_plength a')). intro.
+ cut (ni_min (ad_plength a) (ad_plength a') = ad_plength a).
+ intro. rewrite H0. apply ad_plength_ultra_1. exact H.
+ exact H.
+ intro. cut (ni_min (ad_plength a) (ad_plength a') = ad_plength a').
+ intro. rewrite H0. rewrite ad_xor_comm. apply ad_plength_ultra_1. exact H.
+ rewrite ni_min_comm. exact H.
Qed.
-Lemma ad_pdist_ultra : (a,a',a'':ad)
- (ni_le (ni_min (ad_pdist a a'') (ad_pdist a'' a')) (ad_pdist a a')).
+Lemma ad_pdist_ultra :
+ forall a a' a'':ad,
+ ni_le (ni_min (ad_pdist a a'') (ad_pdist a'' a')) (ad_pdist a a').
Proof.
- Intros. Unfold ad_pdist. Cut (ad_xor (ad_xor a a'') (ad_xor a'' a'))=(ad_xor a a').
- Intro. Rewrite <- H. Apply ad_plength_ultra.
- Rewrite ad_xor_assoc. Rewrite <- (ad_xor_assoc a'' a'' a'). Rewrite ad_xor_nilpotent.
- Rewrite ad_xor_neutral_left. Reflexivity.
-Qed.
+ intros. unfold ad_pdist in |- *. cut (ad_xor (ad_xor a a'') (ad_xor a'' a') = ad_xor a a').
+ intro. rewrite <- H. apply ad_plength_ultra.
+ rewrite ad_xor_assoc. rewrite <- (ad_xor_assoc a'' a'' a'). rewrite ad_xor_nilpotent.
+ rewrite ad_xor_neutral_left. reflexivity.
+Qed. \ No newline at end of file
diff --git a/theories/IntMap/Allmaps.v b/theories/IntMap/Allmaps.v
index fcd111694..0020219d0 100644
--- a/theories/IntMap/Allmaps.v
+++ b/theories/IntMap/Allmaps.v
@@ -23,4 +23,4 @@ Require Export Mapcard.
Require Export Mapcanon.
Require Export Mapc.
Require Export Maplists.
-Require Export Adalloc.
+Require Export Adalloc. \ No newline at end of file
diff --git a/theories/IntMap/Fset.v b/theories/IntMap/Fset.v
index 3c00c21e0..8a2ab00c3 100644
--- a/theories/IntMap/Fset.v
+++ b/theories/IntMap/Fset.v
@@ -9,330 +9,363 @@
(*s Sets operations on maps *)
-Require Bool.
-Require Sumbool.
-Require ZArith.
-Require Addr.
-Require Adist.
-Require Addec.
-Require Map.
+Require Import Bool.
+Require Import Sumbool.
+Require Import ZArith.
+Require Import Addr.
+Require Import Adist.
+Require Import Addec.
+Require Import Map.
Section Dom.
- Variable A, B : Set.
-
- Fixpoint MapDomRestrTo [m:(Map A)] : (Map B) -> (Map A) :=
- Cases m of
- M0 => [_:(Map B)] (M0 A)
- | (M1 a y) => [m':(Map B)] Cases (MapGet B m' a) of
- NONE => (M0 A)
- | _ => m
- end
- | (M2 m1 m2) => [m':(Map B)] Cases m' of
- M0 => (M0 A)
- | (M1 a' y') => Cases (MapGet A m a') of
- NONE => (M0 A)
- | (SOME y) => (M1 A a' y)
- end
- | (M2 m'1 m'2) => (makeM2 A (MapDomRestrTo m1 m'1)
- (MapDomRestrTo m2 m'2))
- end
+ Variables A B : Set.
+
+ Fixpoint MapDomRestrTo (m:Map A) : Map B -> Map A :=
+ match m with
+ | M0 => fun _:Map B => M0 A
+ | M1 a y =>
+ fun m':Map B => match MapGet B m' a with
+ | NONE => M0 A
+ | _ => m
+ end
+ | M2 m1 m2 =>
+ fun m':Map B =>
+ match m' with
+ | M0 => M0 A
+ | M1 a' y' =>
+ match MapGet A m a' with
+ | NONE => M0 A
+ | SOME y => M1 A a' y
+ end
+ | M2 m'1 m'2 =>
+ makeM2 A (MapDomRestrTo m1 m'1) (MapDomRestrTo m2 m'2)
+ end
end.
- Lemma MapDomRestrTo_semantics : (m:(Map A)) (m':(Map B))
- (eqm A (MapGet A (MapDomRestrTo m m'))
- [a0:ad] Cases (MapGet B m' a0) of
- NONE => (NONE A)
- | _ => (MapGet A m a0)
- end).
- Proof.
- Unfold eqm. Induction m. Simpl. Intros. Case (MapGet B m' a); Trivial.
- Intros. Simpl. Elim (sumbool_of_bool (ad_eq a a1)). Intro H. Rewrite H.
- Rewrite <- (ad_eq_complete ? ? H). Case (MapGet B m' a). Reflexivity.
- Intro. Apply M1_semantics_1.
- Intro H. Rewrite H. Case (MapGet B m' a).
- Case (MapGet B m' a1); Reflexivity.
- Case (MapGet B m' a1); Intros; Exact (M1_semantics_2 A a a1 a0 H).
- Induction m'. Trivial.
- Unfold MapDomRestrTo. Intros. Elim (sumbool_of_bool (ad_eq a a1)).
- Intro H1.
- Rewrite (ad_eq_complete ? ? H1). Rewrite (M1_semantics_1 B a1 a0).
- Case (MapGet A (M2 A m0 m1) a1). Reflexivity.
- Intro. Apply M1_semantics_1.
- Intro H1. Rewrite (M1_semantics_2 B a a1 a0 H1). Case (MapGet A (M2 A m0 m1) a). Reflexivity.
- Intro. Exact (M1_semantics_2 A a a1 a2 H1).
- Intros. Change (MapGet A (makeM2 A (MapDomRestrTo m0 m2) (MapDomRestrTo m1 m3)) a)
- =(Cases (MapGet B (M2 B m2 m3) a) of
- NONE => (NONE A)
- | (SOME _) => (MapGet A (M2 A m0 m1) a)
+ Lemma MapDomRestrTo_semantics :
+ forall (m:Map A) (m':Map B),
+ eqm A (MapGet A (MapDomRestrTo m m'))
+ (fun a0:ad =>
+ match MapGet B m' a0 with
+ | NONE => NONE A
+ | _ => MapGet A m a0
end).
- Rewrite (makeM2_M2 A (MapDomRestrTo m0 m2) (MapDomRestrTo m1 m3) a).
- Rewrite MapGet_M2_bit_0_if. Rewrite (H0 m3 (ad_div_2 a)). Rewrite (H m2 (ad_div_2 a)).
- Rewrite (MapGet_M2_bit_0_if B m2 m3 a). Rewrite (MapGet_M2_bit_0_if A m0 m1 a).
- Case (ad_bit_0 a); Reflexivity.
+ Proof.
+ unfold eqm in |- *. simple induction m. simpl in |- *. intros. case (MapGet B m' a); trivial.
+ intros. simpl in |- *. elim (sumbool_of_bool (ad_eq a a1)). intro H. rewrite H.
+ rewrite <- (ad_eq_complete _ _ H). case (MapGet B m' a). reflexivity.
+ intro. apply M1_semantics_1.
+ intro H. rewrite H. case (MapGet B m' a).
+ case (MapGet B m' a1); reflexivity.
+ case (MapGet B m' a1); intros; exact (M1_semantics_2 A a a1 a0 H).
+ simple induction m'. trivial.
+ unfold MapDomRestrTo in |- *. intros. elim (sumbool_of_bool (ad_eq a a1)).
+ intro H1.
+ rewrite (ad_eq_complete _ _ H1). rewrite (M1_semantics_1 B a1 a0).
+ case (MapGet A (M2 A m0 m1) a1). reflexivity.
+ intro. apply M1_semantics_1.
+ intro H1. rewrite (M1_semantics_2 B a a1 a0 H1). case (MapGet A (M2 A m0 m1) a). reflexivity.
+ intro. exact (M1_semantics_2 A a a1 a2 H1).
+ intros. change
+ (MapGet A (makeM2 A (MapDomRestrTo m0 m2) (MapDomRestrTo m1 m3)) a =
+ match MapGet B (M2 B m2 m3) a with
+ | NONE => NONE A
+ | SOME _ => MapGet A (M2 A m0 m1) a
+ end) in |- *.
+ rewrite (makeM2_M2 A (MapDomRestrTo m0 m2) (MapDomRestrTo m1 m3) a).
+ rewrite MapGet_M2_bit_0_if. rewrite (H0 m3 (ad_div_2 a)). rewrite (H m2 (ad_div_2 a)).
+ rewrite (MapGet_M2_bit_0_if B m2 m3 a). rewrite (MapGet_M2_bit_0_if A m0 m1 a).
+ case (ad_bit_0 a); reflexivity.
Qed.
- Fixpoint MapDomRestrBy [m:(Map A)] : (Map B) -> (Map A) :=
- Cases m of
- M0 => [_:(Map B)] (M0 A)
- | (M1 a y) => [m':(Map B)] Cases (MapGet B m' a) of
- NONE => m
- | _ => (M0 A)
- end
- | (M2 m1 m2) => [m':(Map B)] Cases m' of
- M0 => m
- | (M1 a' y') => (MapRemove A m a')
- | (M2 m'1 m'2) => (makeM2 A (MapDomRestrBy m1 m'1)
- (MapDomRestrBy m2 m'2))
- end
+ Fixpoint MapDomRestrBy (m:Map A) : Map B -> Map A :=
+ match m with
+ | M0 => fun _:Map B => M0 A
+ | M1 a y =>
+ fun m':Map B => match MapGet B m' a with
+ | NONE => m
+ | _ => M0 A
+ end
+ | M2 m1 m2 =>
+ fun m':Map B =>
+ match m' with
+ | M0 => m
+ | M1 a' y' => MapRemove A m a'
+ | M2 m'1 m'2 =>
+ makeM2 A (MapDomRestrBy m1 m'1) (MapDomRestrBy m2 m'2)
+ end
end.
- Lemma MapDomRestrBy_semantics : (m:(Map A)) (m':(Map B))
- (eqm A (MapGet A (MapDomRestrBy m m'))
- [a0:ad] Cases (MapGet B m' a0) of
- NONE => (MapGet A m a0)
- | _ => (NONE A)
- end).
- Proof.
- Unfold eqm. Induction m. Simpl. Intros. Case (MapGet B m' a); Trivial.
- Intros. Simpl. Elim (sumbool_of_bool (ad_eq a a1)). Intro H. Rewrite H.
- Rewrite (ad_eq_complete ? ? H). Case (MapGet B m' a1). Apply M1_semantics_1.
- Trivial.
- Intro H. Rewrite H. Case (MapGet B m' a). Rewrite (M1_semantics_2 A a a1 a0 H).
- Case (MapGet B m' a1); Trivial.
- Case (MapGet B m' a1); Trivial.
- Induction m'. Trivial.
- Unfold MapDomRestrBy. Intros. Rewrite (MapRemove_semantics A (M2 A m0 m1) a a1).
- Elim (sumbool_of_bool (ad_eq a a1)). Intro H1. Rewrite H1. Rewrite (ad_eq_complete ? ? H1).
- Rewrite (M1_semantics_1 B a1 a0). Reflexivity.
- Intro H1. Rewrite H1. Rewrite (M1_semantics_2 B a a1 a0 H1). Reflexivity.
- Intros. Change (MapGet A (makeM2 A (MapDomRestrBy m0 m2) (MapDomRestrBy m1 m3)) a)
- =(Cases (MapGet B (M2 B m2 m3) a) of
- NONE => (MapGet A (M2 A m0 m1) a)
- | (SOME _) => (NONE A)
+ Lemma MapDomRestrBy_semantics :
+ forall (m:Map A) (m':Map B),
+ eqm A (MapGet A (MapDomRestrBy m m'))
+ (fun a0:ad =>
+ match MapGet B m' a0 with
+ | NONE => MapGet A m a0
+ | _ => NONE A
end).
- Rewrite (makeM2_M2 A (MapDomRestrBy m0 m2) (MapDomRestrBy m1 m3) a).
- Rewrite MapGet_M2_bit_0_if. Rewrite (H0 m3 (ad_div_2 a)). Rewrite (H m2 (ad_div_2 a)).
- Rewrite (MapGet_M2_bit_0_if B m2 m3 a). Rewrite (MapGet_M2_bit_0_if A m0 m1 a).
- Case (ad_bit_0 a); Reflexivity.
+ Proof.
+ unfold eqm in |- *. simple induction m. simpl in |- *. intros. case (MapGet B m' a); trivial.
+ intros. simpl in |- *. elim (sumbool_of_bool (ad_eq a a1)). intro H. rewrite H.
+ rewrite (ad_eq_complete _ _ H). case (MapGet B m' a1). apply M1_semantics_1.
+ trivial.
+ intro H. rewrite H. case (MapGet B m' a). rewrite (M1_semantics_2 A a a1 a0 H).
+ case (MapGet B m' a1); trivial.
+ case (MapGet B m' a1); trivial.
+ simple induction m'. trivial.
+ unfold MapDomRestrBy in |- *. intros. rewrite (MapRemove_semantics A (M2 A m0 m1) a a1).
+ elim (sumbool_of_bool (ad_eq a a1)). intro H1. rewrite H1. rewrite (ad_eq_complete _ _ H1).
+ rewrite (M1_semantics_1 B a1 a0). reflexivity.
+ intro H1. rewrite H1. rewrite (M1_semantics_2 B a a1 a0 H1). reflexivity.
+ intros. change
+ (MapGet A (makeM2 A (MapDomRestrBy m0 m2) (MapDomRestrBy m1 m3)) a =
+ match MapGet B (M2 B m2 m3) a with
+ | NONE => MapGet A (M2 A m0 m1) a
+ | SOME _ => NONE A
+ end) in |- *.
+ rewrite (makeM2_M2 A (MapDomRestrBy m0 m2) (MapDomRestrBy m1 m3) a).
+ rewrite MapGet_M2_bit_0_if. rewrite (H0 m3 (ad_div_2 a)). rewrite (H m2 (ad_div_2 a)).
+ rewrite (MapGet_M2_bit_0_if B m2 m3 a). rewrite (MapGet_M2_bit_0_if A m0 m1 a).
+ case (ad_bit_0 a); reflexivity.
Qed.
- Definition in_dom := [a:ad; m:(Map A)]
- Cases (MapGet A m a) of
- NONE => false
- | _ => true
+ Definition in_dom (a:ad) (m:Map A) :=
+ match MapGet A m a with
+ | NONE => false
+ | _ => true
end.
- Lemma in_dom_M0 : (a:ad) (in_dom a (M0 A))=false.
+ Lemma in_dom_M0 : forall a:ad, in_dom a (M0 A) = false.
Proof.
- Trivial.
+ trivial.
Qed.
- Lemma in_dom_M1 : (a,a0:ad) (y:A) (in_dom a0 (M1 A a y))=(ad_eq a a0).
+ Lemma in_dom_M1 : forall (a a0:ad) (y:A), in_dom a0 (M1 A a y) = ad_eq a a0.
Proof.
- Unfold in_dom. Intros. Simpl. Case (ad_eq a a0); Reflexivity.
+ unfold in_dom in |- *. intros. simpl in |- *. case (ad_eq a a0); reflexivity.
Qed.
- Lemma in_dom_M1_1 : (a:ad) (y:A) (in_dom a (M1 A a y))=true.
+ Lemma in_dom_M1_1 : forall (a:ad) (y:A), in_dom a (M1 A a y) = true.
Proof.
- Intros. Rewrite in_dom_M1. Apply ad_eq_correct.
+ intros. rewrite in_dom_M1. apply ad_eq_correct.
Qed.
- Lemma in_dom_M1_2 : (a,a0:ad) (y:A) (in_dom a0 (M1 A a y))=true -> a=a0.
+ Lemma in_dom_M1_2 :
+ forall (a a0:ad) (y:A), in_dom a0 (M1 A a y) = true -> a = a0.
Proof.
- Intros. Apply (ad_eq_complete a a0). Rewrite (in_dom_M1 a a0 y) in H. Assumption.
+ intros. apply (ad_eq_complete a a0). rewrite (in_dom_M1 a a0 y) in H. assumption.
Qed.
- Lemma in_dom_some : (m:(Map A)) (a:ad) (in_dom a m)=true ->
- {y:A | (MapGet A m a)=(SOME A y)}.
+ Lemma in_dom_some :
+ forall (m:Map A) (a:ad),
+ in_dom a m = true -> {y : A | MapGet A m a = SOME A y}.
Proof.
- Unfold in_dom. Intros. Elim (option_sum ? (MapGet A m a)). Trivial.
- Intro H0. Rewrite H0 in H. Discriminate H.
+ unfold in_dom in |- *. intros. elim (option_sum _ (MapGet A m a)). trivial.
+ intro H0. rewrite H0 in H. discriminate H.
Qed.
- Lemma in_dom_none : (m:(Map A)) (a:ad) (in_dom a m)=false ->
- (MapGet A m a)=(NONE A).
+ Lemma in_dom_none :
+ forall (m:Map A) (a:ad), in_dom a m = false -> MapGet A m a = NONE A.
Proof.
- Unfold in_dom. Intros. Elim (option_sum ? (MapGet A m a)). Intro H0. Elim H0.
- Intros y H1. Rewrite H1 in H. Discriminate H.
- Trivial.
+ unfold in_dom in |- *. intros. elim (option_sum _ (MapGet A m a)). intro H0. elim H0.
+ intros y H1. rewrite H1 in H. discriminate H.
+ trivial.
Qed.
- Lemma in_dom_put : (m:(Map A)) (a0:ad) (y0:A) (a:ad)
- (in_dom a (MapPut A m a0 y0))=(orb (ad_eq a a0) (in_dom a m)).
+ Lemma in_dom_put :
+ forall (m:Map A) (a0:ad) (y0:A) (a:ad),
+ in_dom a (MapPut A m a0 y0) = orb (ad_eq a a0) (in_dom a m).
Proof.
- Unfold in_dom. Intros. Rewrite (MapPut_semantics A m a0 y0 a).
- Elim (sumbool_of_bool (ad_eq a a0)). Intro H. Rewrite H. Rewrite (ad_eq_comm a a0) in H.
- Rewrite H. Rewrite orb_true_b. Reflexivity.
- Intro H. Rewrite H. Rewrite (ad_eq_comm a a0) in H. Rewrite H. Rewrite orb_false_b.
- Reflexivity.
+ unfold in_dom in |- *. intros. rewrite (MapPut_semantics A m a0 y0 a).
+ elim (sumbool_of_bool (ad_eq a a0)). intro H. rewrite H. rewrite (ad_eq_comm a a0) in H.
+ rewrite H. rewrite orb_true_b. reflexivity.
+ intro H. rewrite H. rewrite (ad_eq_comm a a0) in H. rewrite H. rewrite orb_false_b.
+ reflexivity.
Qed.
- Lemma in_dom_put_behind : (m:(Map A)) (a0:ad) (y0:A) (a:ad)
- (in_dom a (MapPut_behind A m a0 y0))=(orb (ad_eq a a0) (in_dom a m)).
+ Lemma in_dom_put_behind :
+ forall (m:Map A) (a0:ad) (y0:A) (a:ad),
+ in_dom a (MapPut_behind A m a0 y0) = orb (ad_eq a a0) (in_dom a m).
Proof.
- Unfold in_dom. Intros. Rewrite (MapPut_behind_semantics A m a0 y0 a).
- Elim (sumbool_of_bool (ad_eq a a0)). Intro H. Rewrite H. Rewrite (ad_eq_comm a a0) in H.
- Rewrite H. Case (MapGet A m a); Reflexivity.
- Intro H. Rewrite H. Rewrite (ad_eq_comm a a0) in H. Rewrite H. Case (MapGet A m a); Trivial.
+ unfold in_dom in |- *. intros. rewrite (MapPut_behind_semantics A m a0 y0 a).
+ elim (sumbool_of_bool (ad_eq a a0)). intro H. rewrite H. rewrite (ad_eq_comm a a0) in H.
+ rewrite H. case (MapGet A m a); reflexivity.
+ intro H. rewrite H. rewrite (ad_eq_comm a a0) in H. rewrite H. case (MapGet A m a); trivial.
Qed.
- Lemma in_dom_remove : (m:(Map A)) (a0:ad) (a:ad)
- (in_dom a (MapRemove A m a0))=(andb (negb (ad_eq a a0)) (in_dom a m)).
+ Lemma in_dom_remove :
+ forall (m:Map A) (a0 a:ad),
+ in_dom a (MapRemove A m a0) = andb (negb (ad_eq a a0)) (in_dom a m).
Proof.
- Unfold in_dom. Intros. Rewrite (MapRemove_semantics A m a0 a).
- Elim (sumbool_of_bool (ad_eq a a0)). Intro H. Rewrite H. Rewrite (ad_eq_comm a a0) in H.
- Rewrite H. Reflexivity.
- Intro H. Rewrite H. Rewrite (ad_eq_comm a a0) in H. Rewrite H.
- Case (MapGet A m a); Reflexivity.
+ unfold in_dom in |- *. intros. rewrite (MapRemove_semantics A m a0 a).
+ elim (sumbool_of_bool (ad_eq a a0)). intro H. rewrite H. rewrite (ad_eq_comm a a0) in H.
+ rewrite H. reflexivity.
+ intro H. rewrite H. rewrite (ad_eq_comm a a0) in H. rewrite H.
+ case (MapGet A m a); reflexivity.
Qed.
- Lemma in_dom_merge : (m,m':(Map A)) (a:ad)
- (in_dom a (MapMerge A m m'))=(orb (in_dom a m) (in_dom a m')).
+ Lemma in_dom_merge :
+ forall (m m':Map A) (a:ad),
+ in_dom a (MapMerge A m m') = orb (in_dom a m) (in_dom a m').
Proof.
- Unfold in_dom. Intros. Rewrite (MapMerge_semantics A m m' a).
- Elim (option_sum A (MapGet A m' a)). Intro H. Elim H. Intros y H0. Rewrite H0.
- Case (MapGet A m a); Reflexivity.
- Intro H. Rewrite H. Rewrite orb_b_false. Reflexivity.
+ unfold in_dom in |- *. intros. rewrite (MapMerge_semantics A m m' a).
+ elim (option_sum A (MapGet A m' a)). intro H. elim H. intros y H0. rewrite H0.
+ case (MapGet A m a); reflexivity.
+ intro H. rewrite H. rewrite orb_b_false. reflexivity.
Qed.
- Lemma in_dom_delta : (m,m':(Map A)) (a:ad)
- (in_dom a (MapDelta A m m'))=(xorb (in_dom a m) (in_dom a m')).
+ Lemma in_dom_delta :
+ forall (m m':Map A) (a:ad),
+ in_dom a (MapDelta A m m') = xorb (in_dom a m) (in_dom a m').
Proof.
- Unfold in_dom. Intros. Rewrite (MapDelta_semantics A m m' a).
- Elim (option_sum A (MapGet A m' a)). Intro H. Elim H. Intros y H0. Rewrite H0.
- Case (MapGet A m a); Reflexivity.
- Intro H. Rewrite H. Case (MapGet A m a); Reflexivity.
+ unfold in_dom in |- *. intros. rewrite (MapDelta_semantics A m m' a).
+ elim (option_sum A (MapGet A m' a)). intro H. elim H. intros y H0. rewrite H0.
+ case (MapGet A m a); reflexivity.
+ intro H. rewrite H. case (MapGet A m a); reflexivity.
Qed.
End Dom.
Section InDom.
- Variable A, B : Set.
+ Variables A B : Set.
- Lemma in_dom_restrto : (m:(Map A)) (m':(Map B)) (a:ad)
- (in_dom A a (MapDomRestrTo A B m m'))=(andb (in_dom A a m) (in_dom B a m')).
+ Lemma in_dom_restrto :
+ forall (m:Map A) (m':Map B) (a:ad),
+ in_dom A a (MapDomRestrTo A B m m') =
+ andb (in_dom A a m) (in_dom B a m').
Proof.
- Unfold in_dom. Intros. Rewrite (MapDomRestrTo_semantics A B m m' a).
- Elim (option_sum B (MapGet B m' a)). Intro H. Elim H. Intros y H0. Rewrite H0.
- Rewrite andb_b_true. Reflexivity.
- Intro H. Rewrite H. Rewrite andb_b_false. Reflexivity.
+ unfold in_dom in |- *. intros. rewrite (MapDomRestrTo_semantics A B m m' a).
+ elim (option_sum B (MapGet B m' a)). intro H. elim H. intros y H0. rewrite H0.
+ rewrite andb_b_true. reflexivity.
+ intro H. rewrite H. rewrite andb_b_false. reflexivity.
Qed.
- Lemma in_dom_restrby : (m:(Map A)) (m':(Map B)) (a:ad)
- (in_dom A a (MapDomRestrBy A B m m'))=(andb (in_dom A a m) (negb (in_dom B a m'))).
+ Lemma in_dom_restrby :
+ forall (m:Map A) (m':Map B) (a:ad),
+ in_dom A a (MapDomRestrBy A B m m') =
+ andb (in_dom A a m) (negb (in_dom B a m')).
Proof.
- Unfold in_dom. Intros. Rewrite (MapDomRestrBy_semantics A B m m' a).
- Elim (option_sum B (MapGet B m' a)). Intro H. Elim H. Intros y H0. Rewrite H0.
- Unfold negb. Rewrite andb_b_false. Reflexivity.
- Intro H. Rewrite H. Unfold negb. Rewrite andb_b_true. Reflexivity.
+ unfold in_dom in |- *. intros. rewrite (MapDomRestrBy_semantics A B m m' a).
+ elim (option_sum B (MapGet B m' a)). intro H. elim H. intros y H0. rewrite H0.
+ unfold negb in |- *. rewrite andb_b_false. reflexivity.
+ intro H. rewrite H. unfold negb in |- *. rewrite andb_b_true. reflexivity.
Qed.
End InDom.
-Definition FSet := (Map unit).
+Definition FSet := Map unit.
Section FSetDefs.
Variable A : Set.
- Definition in_FSet : ad -> FSet -> bool := (in_dom unit).
+ Definition in_FSet : ad -> FSet -> bool := in_dom unit.
- Fixpoint MapDom [m:(Map A)] : FSet :=
- Cases m of
- M0 => (M0 unit)
- | (M1 a _) => (M1 unit a tt)
- | (M2 m m') => (M2 unit (MapDom m) (MapDom m'))
+ Fixpoint MapDom (m:Map A) : FSet :=
+ match m with
+ | M0 => M0 unit
+ | M1 a _ => M1 unit a tt
+ | M2 m m' => M2 unit (MapDom m) (MapDom m')
end.
- Lemma MapDom_semantics_1 : (m:(Map A)) (a:ad)
- (y:A) (MapGet A m a)=(SOME A y) -> (in_FSet a (MapDom m))=true.
+ Lemma MapDom_semantics_1 :
+ forall (m:Map A) (a:ad) (y:A),
+ MapGet A m a = SOME A y -> in_FSet a (MapDom m) = true.
Proof.
- Induction m. Intros. Discriminate H.
- Unfold MapDom. Unfold in_FSet. Unfold in_dom. Unfold MapGet. Intros a y a0 y0.
- Case (ad_eq a a0). Trivial.
- Intro. Discriminate H.
- Intros m0 H m1 H0 a y. Rewrite (MapGet_M2_bit_0_if A m0 m1 a). Simpl. Unfold in_FSet.
- Unfold in_dom. Rewrite (MapGet_M2_bit_0_if unit (MapDom m0) (MapDom m1) a).
- Case (ad_bit_0 a). Unfold in_FSet in_dom in H0. Intro. Apply H0 with y:=y. Assumption.
- Unfold in_FSet in_dom in H. Intro. Apply H with y:=y. Assumption.
+ simple induction m. intros. discriminate H.
+ unfold MapDom in |- *. unfold in_FSet in |- *. unfold in_dom in |- *. unfold MapGet in |- *. intros a y a0 y0.
+ case (ad_eq a a0). trivial.
+ intro. discriminate H.
+ intros m0 H m1 H0 a y. rewrite (MapGet_M2_bit_0_if A m0 m1 a). simpl in |- *. unfold in_FSet in |- *.
+ unfold in_dom in |- *. rewrite (MapGet_M2_bit_0_if unit (MapDom m0) (MapDom m1) a).
+ case (ad_bit_0 a). unfold in_FSet, in_dom in H0. intro. apply H0 with (y := y). assumption.
+ unfold in_FSet, in_dom in H. intro. apply H with (y := y). assumption.
Qed.
- Lemma MapDom_semantics_2 : (m:(Map A)) (a:ad)
- (in_FSet a (MapDom m))=true -> {y:A | (MapGet A m a)=(SOME A y)}.
+ Lemma MapDom_semantics_2 :
+ forall (m:Map A) (a:ad),
+ in_FSet a (MapDom m) = true -> {y : A | MapGet A m a = SOME A y}.
Proof.
- Induction m. Intros. Discriminate H.
- Unfold MapDom. Unfold in_FSet. Unfold in_dom. Unfold MapGet. Intros a y a0. Case (ad_eq a a0).
- Intro. Split with y. Reflexivity.
- Intro. Discriminate H.
- Intros m0 H m1 H0 a. Rewrite (MapGet_M2_bit_0_if A m0 m1 a). Simpl. Unfold in_FSet.
- Unfold in_dom. Rewrite (MapGet_M2_bit_0_if unit (MapDom m0) (MapDom m1) a).
- Case (ad_bit_0 a). Unfold in_FSet in_dom in H0. Intro. Apply H0. Assumption.
- Unfold in_FSet in_dom in H. Intro. Apply H. Assumption.
+ simple induction m. intros. discriminate H.
+ unfold MapDom in |- *. unfold in_FSet in |- *. unfold in_dom in |- *. unfold MapGet in |- *. intros a y a0. case (ad_eq a a0).
+ intro. split with y. reflexivity.
+ intro. discriminate H.
+ intros m0 H m1 H0 a. rewrite (MapGet_M2_bit_0_if A m0 m1 a). simpl in |- *. unfold in_FSet in |- *.
+ unfold in_dom in |- *. rewrite (MapGet_M2_bit_0_if unit (MapDom m0) (MapDom m1) a).
+ case (ad_bit_0 a). unfold in_FSet, in_dom in H0. intro. apply H0. assumption.
+ unfold in_FSet, in_dom in H. intro. apply H. assumption.
Qed.
- Lemma MapDom_semantics_3 : (m:(Map A)) (a:ad)
- (MapGet A m a)=(NONE A) -> (in_FSet a (MapDom m))=false.
+ Lemma MapDom_semantics_3 :
+ forall (m:Map A) (a:ad),
+ MapGet A m a = NONE A -> in_FSet a (MapDom m) = false.
Proof.
- Intros. Elim (sumbool_of_bool (in_FSet a (MapDom m))). Intro H0.
- Elim (MapDom_semantics_2 m a H0). Intros y H1. Rewrite H in H1. Discriminate H1.
- Trivial.
+ intros. elim (sumbool_of_bool (in_FSet a (MapDom m))). intro H0.
+ elim (MapDom_semantics_2 m a H0). intros y H1. rewrite H in H1. discriminate H1.
+ trivial.
Qed.
- Lemma MapDom_semantics_4 : (m:(Map A)) (a:ad)
- (in_FSet a (MapDom m))=false -> (MapGet A m a)=(NONE A).
+ Lemma MapDom_semantics_4 :
+ forall (m:Map A) (a:ad),
+ in_FSet a (MapDom m) = false -> MapGet A m a = NONE A.
Proof.
- Intros. Elim (option_sum A (MapGet A m a)). Intro H0. Elim H0. Intros y H1.
- Rewrite (MapDom_semantics_1 m a y H1) in H. Discriminate H.
- Trivial.
+ intros. elim (option_sum A (MapGet A m a)). intro H0. elim H0. intros y H1.
+ rewrite (MapDom_semantics_1 m a y H1) in H. discriminate H.
+ trivial.
Qed.
- Lemma MapDom_Dom : (m:(Map A)) (a:ad) (in_dom A a m)=(in_FSet a (MapDom m)).
+ Lemma MapDom_Dom :
+ forall (m:Map A) (a:ad), in_dom A a m = in_FSet a (MapDom m).
Proof.
- Intros. Elim (sumbool_of_bool (in_FSet a (MapDom m))). Intro H.
- Elim (MapDom_semantics_2 m a H). Intros y H0. Rewrite H. Unfold in_dom. Rewrite H0.
- Reflexivity.
- Intro H. Rewrite H. Unfold in_dom. Rewrite (MapDom_semantics_4 m a H). Reflexivity.
+ intros. elim (sumbool_of_bool (in_FSet a (MapDom m))). intro H.
+ elim (MapDom_semantics_2 m a H). intros y H0. rewrite H. unfold in_dom in |- *. rewrite H0.
+ reflexivity.
+ intro H. rewrite H. unfold in_dom in |- *. rewrite (MapDom_semantics_4 m a H). reflexivity.
Qed.
- Definition FSetUnion : FSet -> FSet -> FSet := [s,s':FSet] (MapMerge unit s s').
+ Definition FSetUnion (s s':FSet) : FSet := MapMerge unit s s'.
- Lemma in_FSet_union : (s,s':FSet) (a:ad)
- (in_FSet a (FSetUnion s s'))=(orb (in_FSet a s) (in_FSet a s')).
+ Lemma in_FSet_union :
+ forall (s s':FSet) (a:ad),
+ in_FSet a (FSetUnion s s') = orb (in_FSet a s) (in_FSet a s').
Proof.
- Exact (in_dom_merge unit).
+ exact (in_dom_merge unit).
Qed.
- Definition FSetInter : FSet -> FSet -> FSet := [s,s':FSet] (MapDomRestrTo unit unit s s').
+ Definition FSetInter (s s':FSet) : FSet := MapDomRestrTo unit unit s s'.
- Lemma in_FSet_inter : (s,s':FSet) (a:ad)
- (in_FSet a (FSetInter s s'))=(andb (in_FSet a s) (in_FSet a s')).
+ Lemma in_FSet_inter :
+ forall (s s':FSet) (a:ad),
+ in_FSet a (FSetInter s s') = andb (in_FSet a s) (in_FSet a s').
Proof.
- Exact (in_dom_restrto unit unit).
+ exact (in_dom_restrto unit unit).
Qed.
- Definition FSetDiff : FSet -> FSet -> FSet := [s,s':FSet] (MapDomRestrBy unit unit s s').
+ Definition FSetDiff (s s':FSet) : FSet := MapDomRestrBy unit unit s s'.
- Lemma in_FSet_diff : (s,s':FSet) (a:ad)
- (in_FSet a (FSetDiff s s'))=(andb (in_FSet a s) (negb (in_FSet a s'))).
+ Lemma in_FSet_diff :
+ forall (s s':FSet) (a:ad),
+ in_FSet a (FSetDiff s s') = andb (in_FSet a s) (negb (in_FSet a s')).
Proof.
- Exact (in_dom_restrby unit unit).
+ exact (in_dom_restrby unit unit).
Qed.
- Definition FSetDelta : FSet -> FSet -> FSet := [s,s':FSet] (MapDelta unit s s').
+ Definition FSetDelta (s s':FSet) : FSet := MapDelta unit s s'.
- Lemma in_FSet_delta : (s,s':FSet) (a:ad)
- (in_FSet a (FSetDelta s s'))=(xorb (in_FSet a s) (in_FSet a s')).
+ Lemma in_FSet_delta :
+ forall (s s':FSet) (a:ad),
+ in_FSet a (FSetDelta s s') = xorb (in_FSet a s) (in_FSet a s').
Proof.
- Exact (in_dom_delta unit).
+ exact (in_dom_delta unit).
Qed.
End FSetDefs.
-Lemma FSet_Dom : (s:FSet) (MapDom unit s)=s.
+Lemma FSet_Dom : forall s:FSet, MapDom unit s = s.
Proof.
- Induction s. Trivial.
- Simpl. Intros a t. Elim t. Reflexivity.
- Intros. Simpl. Rewrite H. Rewrite H0. Reflexivity.
-Qed.
+ simple induction s. trivial.
+ simpl in |- *. intros a t. elim t. reflexivity.
+ intros. simpl in |- *. rewrite H. rewrite H0. reflexivity.
+Qed. \ No newline at end of file
diff --git a/theories/IntMap/Lsort.v b/theories/IntMap/Lsort.v
index 80ab704de..3399eaad2 100644
--- a/theories/IntMap/Lsort.v
+++ b/theories/IntMap/Lsort.v
@@ -7,531 +7,622 @@
(***********************************************************************)
(*i $Id$ i*)
-Require Bool.
-Require Sumbool.
-Require Arith.
-Require ZArith.
-Require Addr.
-Require Adist.
-Require Addec.
-Require Map.
-Require PolyList.
-Require Mapiter.
+Require Import Bool.
+Require Import Sumbool.
+Require Import Arith.
+Require Import ZArith.
+Require Import Addr.
+Require Import Adist.
+Require Import Addec.
+Require Import Map.
+Require Import List.
+Require Import Mapiter.
Section LSort.
Variable A : Set.
- Fixpoint ad_less_1 [a,a':ad; p:positive] : bool :=
- Cases p of
- (xO p') => (ad_less_1 (ad_div_2 a) (ad_div_2 a') p')
- | _ => (andb (negb (ad_bit_0 a)) (ad_bit_0 a'))
+ Fixpoint ad_less_1 (a a':ad) (p:positive) {struct p} : bool :=
+ match p with
+ | xO p' => ad_less_1 (ad_div_2 a) (ad_div_2 a') p'
+ | _ => andb (negb (ad_bit_0 a)) (ad_bit_0 a')
end.
- Definition ad_less := [a,a':ad] Cases (ad_xor a a') of
- ad_z => false
- | (ad_x p) => (ad_less_1 a a' p)
- end.
-
- Lemma ad_bit_0_less : (a,a':ad) (ad_bit_0 a)=false -> (ad_bit_0 a')=true ->
- (ad_less a a')=true.
- Proof.
- Intros. Elim (ad_sum (ad_xor a a')). Intro H1. Elim H1. Intros p H2. Unfold ad_less.
- Rewrite H2. Generalize H2. Elim p. Intros. Simpl. Rewrite H. Rewrite H0. Reflexivity.
- Intros. Cut (ad_bit_0 (ad_xor a a'))=false. Intro. Rewrite (ad_xor_bit_0 a a') in H5.
- Rewrite H in H5. Rewrite H0 in H5. Discriminate H5.
- Rewrite H4. Reflexivity.
- Intro. Simpl. Rewrite H. Rewrite H0. Reflexivity.
- Intro H1. Cut (ad_bit_0 (ad_xor a a'))=false. Intro. Rewrite (ad_xor_bit_0 a a') in H2.
- Rewrite H in H2. Rewrite H0 in H2. Discriminate H2.
- Rewrite H1. Reflexivity.
- Qed.
-
- Lemma ad_bit_0_gt : (a,a':ad) (ad_bit_0 a)=true -> (ad_bit_0 a')=false ->
- (ad_less a a')=false.
- Proof.
- Intros. Elim (ad_sum (ad_xor a a')). Intro H1. Elim H1. Intros p H2. Unfold ad_less.
- Rewrite H2. Generalize H2. Elim p. Intros. Simpl. Rewrite H. Rewrite H0. Reflexivity.
- Intros. Cut (ad_bit_0 (ad_xor a a'))=false. Intro. Rewrite (ad_xor_bit_0 a a') in H5.
- Rewrite H in H5. Rewrite H0 in H5. Discriminate H5.
- Rewrite H4. Reflexivity.
- Intro. Simpl. Rewrite H. Rewrite H0. Reflexivity.
- Intro H1. Unfold ad_less. Rewrite H1. Reflexivity.
- Qed.
-
- Lemma ad_less_not_refl : (a:ad) (ad_less a a)=false.
- Proof.
- Intro. Unfold ad_less. Rewrite (ad_xor_nilpotent a). Reflexivity.
- Qed.
-
- Lemma ad_ind_double :
- (a:ad)(P:ad->Prop) (P ad_z) ->
- ((a:ad) (P a) -> (P (ad_double a))) ->
- ((a:ad) (P a) -> (P (ad_double_plus_un a))) -> (P a).
- Proof.
- Intros; Elim a. Trivial.
- Induction p. Intros.
- Apply (H1 (ad_x p0)); Trivial.
- Intros; Apply (H0 (ad_x p0)); Trivial.
- Intros; Apply (H1 ad_z); Assumption.
- Qed.
-
- Lemma ad_rec_double :
- (a:ad)(P:ad->Set) (P ad_z) ->
- ((a:ad) (P a) -> (P (ad_double a))) ->
- ((a:ad) (P a) -> (P (ad_double_plus_un a))) -> (P a).
- Proof.
- Intros; Elim a. Trivial.
- Induction p. Intros.
- Apply (H1 (ad_x p0)); Trivial.
- Intros; Apply (H0 (ad_x p0)); Trivial.
- Intros; Apply (H1 ad_z); Assumption.
- Qed.
-
- Lemma ad_less_def_1 : (a,a':ad) (ad_less (ad_double a) (ad_double a'))=(ad_less a a').
- Proof.
- Induction a. Induction a'. Reflexivity.
- Trivial.
- Induction a'. Unfold ad_less. Simpl. (Elim p; Trivial).
- Unfold ad_less. Simpl. Intro. Case (p_xor p p0). Reflexivity.
- Trivial.
- Qed.
-
- Lemma ad_less_def_2 : (a,a':ad)
- (ad_less (ad_double_plus_un a) (ad_double_plus_un a'))=(ad_less a a').
- Proof.
- Induction a. Induction a'. Reflexivity.
- Trivial.
- Induction a'. Unfold ad_less. Simpl. (Elim p; Trivial).
- Unfold ad_less. Simpl. Intro. Case (p_xor p p0). Reflexivity.
- Trivial.
- Qed.
+ Definition ad_less (a a':ad) :=
+ match ad_xor a a' with
+ | ad_z => false
+ | ad_x p => ad_less_1 a a' p
+ end.
- Lemma ad_less_def_3 : (a,a':ad) (ad_less (ad_double a) (ad_double_plus_un a'))=true.
+ Lemma ad_bit_0_less :
+ forall a a':ad,
+ ad_bit_0 a = false -> ad_bit_0 a' = true -> ad_less a a' = true.
Proof.
- Intros. Apply ad_bit_0_less. Apply ad_double_bit_0.
- Apply ad_double_plus_un_bit_0.
+ intros. elim (ad_sum (ad_xor a a')). intro H1. elim H1. intros p H2. unfold ad_less in |- *.
+ rewrite H2. generalize H2. elim p. intros. simpl in |- *. rewrite H. rewrite H0. reflexivity.
+ intros. cut (ad_bit_0 (ad_xor a a') = false). intro. rewrite (ad_xor_bit_0 a a') in H5.
+ rewrite H in H5. rewrite H0 in H5. discriminate H5.
+ rewrite H4. reflexivity.
+ intro. simpl in |- *. rewrite H. rewrite H0. reflexivity.
+ intro H1. cut (ad_bit_0 (ad_xor a a') = false). intro. rewrite (ad_xor_bit_0 a a') in H2.
+ rewrite H in H2. rewrite H0 in H2. discriminate H2.
+ rewrite H1. reflexivity.
Qed.
- Lemma ad_less_def_4 : (a,a':ad) (ad_less (ad_double_plus_un a) (ad_double a'))=false.
+ Lemma ad_bit_0_gt :
+ forall a a':ad,
+ ad_bit_0 a = true -> ad_bit_0 a' = false -> ad_less a a' = false.
Proof.
- Intros. Apply ad_bit_0_gt. Apply ad_double_plus_un_bit_0.
- Apply ad_double_bit_0.
+ intros. elim (ad_sum (ad_xor a a')). intro H1. elim H1. intros p H2. unfold ad_less in |- *.
+ rewrite H2. generalize H2. elim p. intros. simpl in |- *. rewrite H. rewrite H0. reflexivity.
+ intros. cut (ad_bit_0 (ad_xor a a') = false). intro. rewrite (ad_xor_bit_0 a a') in H5.
+ rewrite H in H5. rewrite H0 in H5. discriminate H5.
+ rewrite H4. reflexivity.
+ intro. simpl in |- *. rewrite H. rewrite H0. reflexivity.
+ intro H1. unfold ad_less in |- *. rewrite H1. reflexivity.
Qed.
- Lemma ad_less_z : (a:ad) (ad_less a ad_z)=false.
+ Lemma ad_less_not_refl : forall a:ad, ad_less a a = false.
Proof.
- Induction a. Reflexivity.
- Unfold ad_less. Intro. Rewrite (ad_xor_neutral_right (ad_x p)). (Elim p; Trivial).
+ intro. unfold ad_less in |- *. rewrite (ad_xor_nilpotent a). reflexivity.
Qed.
- Lemma ad_z_less_1 : (a:ad) (ad_less ad_z a)=true -> {p:positive | a=(ad_x p)}.
+ Lemma ad_ind_double :
+ forall (a:ad) (P:ad -> Prop),
+ P ad_z ->
+ (forall a:ad, P a -> P (ad_double a)) ->
+ (forall a:ad, P a -> P (ad_double_plus_un a)) -> P a.
Proof.
- Induction a. Intro. Discriminate H.
- Intros. Split with p. Reflexivity.
- Qed.
-
- Lemma ad_z_less_2 : (a:ad) (ad_less ad_z a)=false -> a=ad_z.
- Proof.
- Induction a. Trivial.
- Unfold ad_less. Simpl. Cut (p:positive)(ad_less_1 ad_z (ad_x p) p)=false->False.
- Intros. Elim (H p H0).
- Induction p. Intros. Discriminate H0.
- Intros. Exact (H H0).
- Intro. Discriminate H.
+ intros; elim a. trivial.
+ simple induction p. intros.
+ apply (H1 (ad_x p0)); trivial.
+ intros; apply (H0 (ad_x p0)); trivial.
+ intros; apply (H1 ad_z); assumption.
Qed.
- Lemma ad_less_trans : (a,a',a'':ad)
- (ad_less a a')=true -> (ad_less a' a'')=true -> (ad_less a a'')=true.
+ Lemma ad_rec_double :
+ forall (a:ad) (P:ad -> Set),
+ P ad_z ->
+ (forall a:ad, P a -> P (ad_double a)) ->
+ (forall a:ad, P a -> P (ad_double_plus_un a)) -> P a.
Proof.
- Intro a. Apply ad_ind_double with P:=[a:ad]
- (a',a'':ad)
- (ad_less a a')=true
- ->(ad_less a' a'')=true->(ad_less a a'')=true.
- Intros. Elim (sumbool_of_bool (ad_less ad_z a'')). Trivial.
- Intro H1. Rewrite (ad_z_less_2 a'' H1) in H0. Rewrite (ad_less_z a') in H0. Discriminate H0.
- Intros a0 H a'. Apply ad_ind_double with P:=[a':ad]
- (a'':ad)
- (ad_less (ad_double a0) a')=true
- ->(ad_less a' a'')=true->(ad_less (ad_double a0) a'')=true.
- Intros. Rewrite (ad_less_z (ad_double a0)) in H0. Discriminate H0.
- Intros a1 H0 a'' H1. Rewrite (ad_less_def_1 a0 a1) in H1.
- Apply ad_ind_double with P:=[a'':ad]
- (ad_less (ad_double a1) a'')=true
- ->(ad_less (ad_double a0) a'')=true.
- Intro. Rewrite (ad_less_z (ad_double a1)) in H2. Discriminate H2.
- Intros. Rewrite (ad_less_def_1 a1 a2) in H3. Rewrite (ad_less_def_1 a0 a2).
- Exact (H a1 a2 H1 H3).
- Intros. Apply ad_less_def_3.
- Intros a1 H0 a'' H1. Apply ad_ind_double with P:=[a'':ad]
- (ad_less (ad_double_plus_un a1) a'')=true
- ->(ad_less (ad_double a0) a'')=true.
- Intro. Rewrite (ad_less_z (ad_double_plus_un a1)) in H2. Discriminate H2.
- Intros. Rewrite (ad_less_def_4 a1 a2) in H3. Discriminate H3.
- Intros. Apply ad_less_def_3.
- Intros a0 H a'. Apply ad_ind_double with P:=[a':ad]
- (a'':ad)
- (ad_less (ad_double_plus_un a0) a')=true
- ->(ad_less a' a'')=true
- ->(ad_less (ad_double_plus_un a0) a'')=true.
- Intros. Rewrite (ad_less_z (ad_double_plus_un a0)) in H0. Discriminate H0.
- Intros. Rewrite (ad_less_def_4 a0 a1) in H1. Discriminate H1.
- Intros a1 H0 a'' H1. Apply ad_ind_double with P:=[a'':ad]
- (ad_less (ad_double_plus_un a1) a'')=true
- ->(ad_less (ad_double_plus_un a0) a'')=true.
- Intro. Rewrite (ad_less_z (ad_double_plus_un a1)) in H2. Discriminate H2.
- Intros. Rewrite (ad_less_def_4 a1 a2) in H3. Discriminate H3.
- Rewrite (ad_less_def_2 a0 a1) in H1. Intros. Rewrite (ad_less_def_2 a1 a2) in H3.
- Rewrite (ad_less_def_2 a0 a2). Exact (H a1 a2 H1 H3).
- Qed.
-
- Fixpoint alist_sorted [l:(alist A)] : bool :=
- Cases l of
- nil => true
- | (cons (a, _) l') => Cases l' of
- nil => true
- | (cons (a', y') l'') => (andb (ad_less a a')
- (alist_sorted l'))
- end
+ intros; elim a. trivial.
+ simple induction p. intros.
+ apply (H1 (ad_x p0)); trivial.
+ intros; apply (H0 (ad_x p0)); trivial.
+ intros; apply (H1 ad_z); assumption.
+ Qed.
+
+ Lemma ad_less_def_1 :
+ forall a a':ad, ad_less (ad_double a) (ad_double a') = ad_less a a'.
+ Proof.
+ simple induction a. simple induction a'. reflexivity.
+ trivial.
+ simple induction a'. unfold ad_less in |- *. simpl in |- *. elim p; trivial.
+ unfold ad_less in |- *. simpl in |- *. intro. case (p_xor p p0). reflexivity.
+ trivial.
+ Qed.
+
+ Lemma ad_less_def_2 :
+ forall a a':ad,
+ ad_less (ad_double_plus_un a) (ad_double_plus_un a') = ad_less a a'.
+ Proof.
+ simple induction a. simple induction a'. reflexivity.
+ trivial.
+ simple induction a'. unfold ad_less in |- *. simpl in |- *. elim p; trivial.
+ unfold ad_less in |- *. simpl in |- *. intro. case (p_xor p p0). reflexivity.
+ trivial.
+ Qed.
+
+ Lemma ad_less_def_3 :
+ forall a a':ad, ad_less (ad_double a) (ad_double_plus_un a') = true.
+ Proof.
+ intros. apply ad_bit_0_less. apply ad_double_bit_0.
+ apply ad_double_plus_un_bit_0.
+ Qed.
+
+ Lemma ad_less_def_4 :
+ forall a a':ad, ad_less (ad_double_plus_un a) (ad_double a') = false.
+ Proof.
+ intros. apply ad_bit_0_gt. apply ad_double_plus_un_bit_0.
+ apply ad_double_bit_0.
+ Qed.
+
+ Lemma ad_less_z : forall a:ad, ad_less a ad_z = false.
+ Proof.
+ simple induction a. reflexivity.
+ unfold ad_less in |- *. intro. rewrite (ad_xor_neutral_right (ad_x p)). elim p; trivial.
+ Qed.
+
+ Lemma ad_z_less_1 :
+ forall a:ad, ad_less ad_z a = true -> {p : positive | a = ad_x p}.
+ Proof.
+ simple induction a. intro. discriminate H.
+ intros. split with p. reflexivity.
+ Qed.
+
+ Lemma ad_z_less_2 : forall a:ad, ad_less ad_z a = false -> a = ad_z.
+ Proof.
+ simple induction a. trivial.
+ unfold ad_less in |- *. simpl in |- *. cut (forall p:positive, ad_less_1 ad_z (ad_x p) p = false -> False).
+ intros. elim (H p H0).
+ simple induction p. intros. discriminate H0.
+ intros. exact (H H0).
+ intro. discriminate H.
+ Qed.
+
+ Lemma ad_less_trans :
+ forall a a' a'':ad,
+ ad_less a a' = true -> ad_less a' a'' = true -> ad_less a a'' = true.
+ Proof.
+ intro a. apply ad_ind_double with
+ (P := fun a:ad =>
+ forall a' a'':ad,
+ ad_less a a' = true ->
+ ad_less a' a'' = true -> ad_less a a'' = true).
+ intros. elim (sumbool_of_bool (ad_less ad_z a'')). trivial.
+ intro H1. rewrite (ad_z_less_2 a'' H1) in H0. rewrite (ad_less_z a') in H0. discriminate H0.
+ intros a0 H a'. apply ad_ind_double with
+ (P := fun a':ad =>
+ forall a'':ad,
+ ad_less (ad_double a0) a' = true ->
+ ad_less a' a'' = true -> ad_less (ad_double a0) a'' = true).
+ intros. rewrite (ad_less_z (ad_double a0)) in H0. discriminate H0.
+ intros a1 H0 a'' H1. rewrite (ad_less_def_1 a0 a1) in H1.
+ apply ad_ind_double with
+ (P := fun a'':ad =>
+ ad_less (ad_double a1) a'' = true ->
+ ad_less (ad_double a0) a'' = true).
+ intro. rewrite (ad_less_z (ad_double a1)) in H2. discriminate H2.
+ intros. rewrite (ad_less_def_1 a1 a2) in H3. rewrite (ad_less_def_1 a0 a2).
+ exact (H a1 a2 H1 H3).
+ intros. apply ad_less_def_3.
+ intros a1 H0 a'' H1. apply ad_ind_double with
+ (P := fun a'':ad =>
+ ad_less (ad_double_plus_un a1) a'' = true ->
+ ad_less (ad_double a0) a'' = true).
+ intro. rewrite (ad_less_z (ad_double_plus_un a1)) in H2. discriminate H2.
+ intros. rewrite (ad_less_def_4 a1 a2) in H3. discriminate H3.
+ intros. apply ad_less_def_3.
+ intros a0 H a'. apply ad_ind_double with
+ (P := fun a':ad =>
+ forall a'':ad,
+ ad_less (ad_double_plus_un a0) a' = true ->
+ ad_less a' a'' = true ->
+ ad_less (ad_double_plus_un a0) a'' = true).
+ intros. rewrite (ad_less_z (ad_double_plus_un a0)) in H0. discriminate H0.
+ intros. rewrite (ad_less_def_4 a0 a1) in H1. discriminate H1.
+ intros a1 H0 a'' H1. apply ad_ind_double with
+ (P := fun a'':ad =>
+ ad_less (ad_double_plus_un a1) a'' = true ->
+ ad_less (ad_double_plus_un a0) a'' = true).
+ intro. rewrite (ad_less_z (ad_double_plus_un a1)) in H2. discriminate H2.
+ intros. rewrite (ad_less_def_4 a1 a2) in H3. discriminate H3.
+ rewrite (ad_less_def_2 a0 a1) in H1. intros. rewrite (ad_less_def_2 a1 a2) in H3.
+ rewrite (ad_less_def_2 a0 a2). exact (H a1 a2 H1 H3).
+ Qed.
+
+ Fixpoint alist_sorted (l:alist A) : bool :=
+ match l with
+ | nil => true
+ | (a, _) :: l' =>
+ match l' with
+ | nil => true
+ | (a', y') :: l'' => andb (ad_less a a') (alist_sorted l')
+ end
end.
- Fixpoint alist_nth_ad [n:nat; l:(alist A)] : ad :=
- Cases l of
- nil => ad_z (* dummy *)
- | (cons (a, y) l') => Cases n of
- O => a
- | (S n') => (alist_nth_ad n' l')
- end
+ Fixpoint alist_nth_ad (n:nat) (l:alist A) {struct l} : ad :=
+ match l with
+ | nil => ad_z (* dummy *)
+ | (a, y) :: l' => match n with
+ | O => a
+ | S n' => alist_nth_ad n' l'
+ end
end.
- Definition alist_sorted_1 := [l:(alist A)]
- (n:nat) (le (S (S n)) (length l)) ->
- (ad_less (alist_nth_ad n l) (alist_nth_ad (S n) l))=true.
-
- Lemma alist_sorted_imp_1 : (l:(alist A)) (alist_sorted l)=true -> (alist_sorted_1 l).
- Proof.
- Unfold alist_sorted_1. Induction l. Intros. Elim (le_Sn_O (S n) H0).
- Intro r. Elim r. Intros a y. Induction l0. Intros. Simpl in H1.
- Elim (le_Sn_O n (le_S_n (S n) O H1)).
- Intro r0. Elim r0. Intros a0 y0. Induction n. Intros. Simpl. Simpl in H1.
- Exact (proj1 ? ? (andb_prop ? ? H1)).
- Intros. Change (ad_less (alist_nth_ad n0 (cons (a0,y0) l1))
- (alist_nth_ad (S n0) (cons (a0,y0) l1)))=true.
- Apply H0. Exact (proj2 ? ? (andb_prop ? ? H1)).
- Apply le_S_n. Exact H3.
- Qed.
-
- Definition alist_sorted_2 := [l:(alist A)]
- (m,n:nat) (lt m n) -> (le (S n) (length l)) ->
- (ad_less (alist_nth_ad m l) (alist_nth_ad n l))=true.
-
- Lemma alist_sorted_1_imp_2 : (l:(alist A)) (alist_sorted_1 l) -> (alist_sorted_2 l).
- Proof.
- Unfold alist_sorted_1 alist_sorted_2 lt. Intros l H m n H0. Elim H0. Exact (H m).
- Intros. Apply ad_less_trans with a':=(alist_nth_ad m0 l). Apply H2. Apply le_trans_S.
- Assumption.
- Apply H. Assumption.
- Qed.
-
- Lemma alist_sorted_2_imp : (l:(alist A)) (alist_sorted_2 l) -> (alist_sorted l)=true.
- Proof.
- Unfold alist_sorted_2 lt. Induction l. Trivial.
- Intro r. Elim r. Intros a y. Induction l0. Trivial.
- Intro r0. Elim r0. Intros a0 y0. Intros.
- Change (andb (ad_less a a0) (alist_sorted (cons (a0,y0) l1)))=true.
- Apply andb_true_intro. Split. Apply (H1 (0) (1)). Apply le_n.
- Simpl. Apply le_n_S. Apply le_n_S. Apply le_O_n.
- Apply H0. Intros. Apply (H1 (S m) (S n)). Apply le_n_S. Assumption.
- Exact (le_n_S ? ? H3).
- Qed.
+ Definition alist_sorted_1 (l:alist A) :=
+ forall n:nat,
+ S (S n) <= length l ->
+ ad_less (alist_nth_ad n l) (alist_nth_ad (S n) l) = true.
- Lemma app_length : (C:Set) (l,l':(list C)) (length (app l l'))=(plus (length l) (length l')).
+ Lemma alist_sorted_imp_1 :
+ forall l:alist A, alist_sorted l = true -> alist_sorted_1 l.
Proof.
- Induction l. Trivial.
- Intros. Simpl. Rewrite (H l'). Reflexivity.
- Qed.
-
- Lemma aapp_length : (l,l':(alist A)) (length (aapp A l l'))=(plus (length l) (length l')).
+ unfold alist_sorted_1 in |- *. simple induction l. intros. elim (le_Sn_O (S n) H0).
+ intro r. elim r. intros a y. simple induction l0. intros. simpl in H1.
+ elim (le_Sn_O n (le_S_n (S n) 0 H1)).
+ intro r0. elim r0. intros a0 y0. simple induction n. intros. simpl in |- *. simpl in H1.
+ exact (proj1 (andb_prop _ _ H1)).
+ intros. change
+ (ad_less (alist_nth_ad n0 ((a0, y0) :: l1))
+ (alist_nth_ad (S n0) ((a0, y0) :: l1)) = true)
+ in |- *.
+ apply H0. exact (proj2 (andb_prop _ _ H1)).
+ apply le_S_n. exact H3.
+ Qed.
+
+ Definition alist_sorted_2 (l:alist A) :=
+ forall m n:nat,
+ m < n ->
+ S n <= length l -> ad_less (alist_nth_ad m l) (alist_nth_ad n l) = true.
+
+ Lemma alist_sorted_1_imp_2 :
+ forall l:alist A, alist_sorted_1 l -> alist_sorted_2 l.
+ Proof.
+ unfold alist_sorted_1, alist_sorted_2, lt in |- *. intros l H m n H0. elim H0. exact (H m).
+ intros. apply ad_less_trans with (a' := alist_nth_ad m0 l). apply H2. apply le_Sn_le.
+ assumption.
+ apply H. assumption.
+ Qed.
+
+ Lemma alist_sorted_2_imp :
+ forall l:alist A, alist_sorted_2 l -> alist_sorted l = true.
+ Proof.
+ unfold alist_sorted_2, lt in |- *. simple induction l. trivial.
+ intro r. elim r. intros a y. simple induction l0. trivial.
+ intro r0. elim r0. intros a0 y0. intros.
+ change (andb (ad_less a a0) (alist_sorted ((a0, y0) :: l1)) = true)
+ in |- *.
+ apply andb_true_intro. split. apply (H1 0 1). apply le_n.
+ simpl in |- *. apply le_n_S. apply le_n_S. apply le_O_n.
+ apply H0. intros. apply (H1 (S m) (S n)). apply le_n_S. assumption.
+ exact (le_n_S _ _ H3).
+ Qed.
+
+ Lemma app_length :
+ forall (C:Set) (l l':list C), length (l ++ l') = length l + length l'.
+ Proof.
+ simple induction l. trivial.
+ intros. simpl in |- *. rewrite (H l'). reflexivity.
+ Qed.
+
+ Lemma aapp_length :
+ forall l l':alist A, length (aapp A l l') = length l + length l'.
Proof.
- Exact (app_length ad*A).
+ exact (app_length (ad * A)).
Qed.
- Lemma alist_nth_ad_aapp_1 : (l,l':(alist A)) (n:nat)
- (le (S n) (length l)) -> (alist_nth_ad n (aapp A l l'))=(alist_nth_ad n l).
+ Lemma alist_nth_ad_aapp_1 :
+ forall (l l':alist A) (n:nat),
+ S n <= length l -> alist_nth_ad n (aapp A l l') = alist_nth_ad n l.
Proof.
- Induction l. Intros. Elim (le_Sn_O n H).
- Intro r. Elim r. Intros a y l' H l''. Induction n. Trivial.
- Intros. Simpl. Apply H. Apply le_S_n. Exact H1.
+ simple induction l. intros. elim (le_Sn_O n H).
+ intro r. elim r. intros a y l' H l''. simple induction n. trivial.
+ intros. simpl in |- *. apply H. apply le_S_n. exact H1.
Qed.
- Lemma alist_nth_ad_aapp_2 : (l,l':(alist A)) (n:nat)
- (le (S n) (length l')) ->
- (alist_nth_ad (plus (length l) n) (aapp A l l'))=(alist_nth_ad n l').
+ Lemma alist_nth_ad_aapp_2 :
+ forall (l l':alist A) (n:nat),
+ S n <= length l' ->
+ alist_nth_ad (length l + n) (aapp A l l') = alist_nth_ad n l'.
Proof.
- Induction l. Trivial.
- Intro r. Elim r. Intros a y l' H l'' n H0. Simpl. Apply H. Exact H0.
+ simple induction l. trivial.
+ intro r. elim r. intros a y l' H l'' n H0. simpl in |- *. apply H. exact H0.
Qed.
- Lemma interval_split : (p,q,n:nat) (le (S n) (plus p q)) ->
- {n' : nat | (le (S n') q) /\ n=(plus p n')}+{(le (S n) p)}.
+ Lemma interval_split :
+ forall p q n:nat,
+ S n <= p + q -> {n' : nat | S n' <= q /\ n = p + n'} + {S n <= p}.
Proof.
- Induction p. Simpl. Intros. Left . Split with n. (Split; [ Assumption | Reflexivity ]).
- Intros p' H q. Induction n. Intros. Right . Apply le_n_S. Apply le_O_n.
- Intros. Elim (H ? ? (le_S_n ? ? H1)). Intro H2. Left . Elim H2. Intros n' H3.
- Elim H3. Intros H4 H5. Split with n'. (Split; [ Assumption | Rewrite H5; Reflexivity ]).
- Intro H2. Right . Apply le_n_S. Assumption.
+ simple induction p. simpl in |- *. intros. left. split with n. split; [ assumption | reflexivity ].
+ intros p' H q. simple induction n. intros. right. apply le_n_S. apply le_O_n.
+ intros. elim (H _ _ (le_S_n _ _ H1)). intro H2. left. elim H2. intros n' H3.
+ elim H3. intros H4 H5. split with n'. split; [ assumption | rewrite H5; reflexivity ].
+ intro H2. right. apply le_n_S. assumption.
Qed.
- Lemma alist_conc_sorted : (l,l':(alist A)) (alist_sorted_2 l) -> (alist_sorted_2 l') ->
- ((n,n':nat) (le (S n) (length l)) -> (le (S n') (length l')) ->
- (ad_less (alist_nth_ad n l) (alist_nth_ad n' l'))=true) ->
- (alist_sorted_2 (aapp A l l')).
+ Lemma alist_conc_sorted :
+ forall l l':alist A,
+ alist_sorted_2 l ->
+ alist_sorted_2 l' ->
+ (forall n n':nat,
+ S n <= length l ->
+ S n' <= length l' ->
+ ad_less (alist_nth_ad n l) (alist_nth_ad n' l') = true) ->
+ alist_sorted_2 (aapp A l l').
Proof.
- Unfold alist_sorted_2 lt. Intros. Rewrite (aapp_length l l') in H3.
- Elim (interval_split (length l) (length l') m
- (le_trans ? ? ? (le_n_S ? ? (lt_le_weak m n H2)) H3)).
- Intro H4. Elim H4. Intros m' H5. Elim H5. Intros. Rewrite H7.
- Rewrite (alist_nth_ad_aapp_2 l l' m' H6). Elim (interval_split (length l) (length l') n H3).
- Intro H8. Elim H8. Intros n' H9. Elim H9. Intros. Rewrite H11.
- Rewrite (alist_nth_ad_aapp_2 l l' n' H10). Apply H0. Rewrite H7 in H2. Rewrite H11 in H2.
- Change (le (plus (S (length l)) m') (plus (length l) n')) in H2.
- Rewrite (plus_Snm_nSm (length l) m') in H2. Exact (simpl_le_plus_l (length l) (S m') n' H2).
- Exact H10.
- Intro H8. Rewrite H7 in H2. Cut (le (S (length l)) (length l)). Intros. Elim (le_Sn_n ? H9).
- Apply le_trans with m:=(S n). Apply le_n_S. Apply le_trans with m:=(S (plus (length l) m')).
- Apply le_trans with m:=(plus (length l) m'). Apply le_plus_l.
- Apply le_n_Sn.
- Exact H2.
- Exact H8.
- Intro H4. Rewrite (alist_nth_ad_aapp_1 l l' m H4).
- Elim (interval_split (length l) (length l') n H3). Intro H5. Elim H5. Intros n' H6. Elim H6.
- Intros. Rewrite H8. Rewrite (alist_nth_ad_aapp_2 l l' n' H7). Exact (H1 m n' H4 H7).
- Intro H5. Rewrite (alist_nth_ad_aapp_1 l l' n H5). Exact (H m n H2 H5).
+ unfold alist_sorted_2, lt in |- *. intros. rewrite (aapp_length l l') in H3.
+ elim
+ (interval_split (length l) (length l') m
+ (le_trans _ _ _ (le_n_S _ _ (lt_le_weak m n H2)) H3)).
+ intro H4. elim H4. intros m' H5. elim H5. intros. rewrite H7.
+ rewrite (alist_nth_ad_aapp_2 l l' m' H6). elim (interval_split (length l) (length l') n H3).
+ intro H8. elim H8. intros n' H9. elim H9. intros. rewrite H11.
+ rewrite (alist_nth_ad_aapp_2 l l' n' H10). apply H0. rewrite H7 in H2. rewrite H11 in H2.
+ change (S (length l) + m' <= length l + n') in H2.
+ rewrite (plus_Snm_nSm (length l) m') in H2. exact ((fun p n m:nat => plus_le_reg_l n m p) (length l) (S m') n' H2).
+ exact H10.
+ intro H8. rewrite H7 in H2. cut (S (length l) <= length l). intros. elim (le_Sn_n _ H9).
+ apply le_trans with (m := S n). apply le_n_S. apply le_trans with (m := S (length l + m')).
+ apply le_trans with (m := length l + m'). apply le_plus_l.
+ apply le_n_Sn.
+ exact H2.
+ exact H8.
+ intro H4. rewrite (alist_nth_ad_aapp_1 l l' m H4).
+ elim (interval_split (length l) (length l') n H3). intro H5. elim H5. intros n' H6. elim H6.
+ intros. rewrite H8. rewrite (alist_nth_ad_aapp_2 l l' n' H7). exact (H1 m n' H4 H7).
+ intro H5. rewrite (alist_nth_ad_aapp_1 l l' n H5). exact (H m n H2 H5).
Qed.
- Lemma alist_nth_ad_semantics : (l:(alist A)) (n:nat) (le (S n) (length l)) ->
- {y:A | (alist_semantics A l (alist_nth_ad n l))=(SOME A y)}.
+ Lemma alist_nth_ad_semantics :
+ forall (l:alist A) (n:nat),
+ S n <= length l ->
+ {y : A | alist_semantics A l (alist_nth_ad n l) = SOME A y}.
Proof.
- Induction l. Intros. Elim (le_Sn_O ? H).
- Intro r. Elim r. Intros a y l0 H. Induction n. Simpl. Intro. Split with y.
- Rewrite (ad_eq_correct a). Reflexivity.
- Intros. Elim (H ? (le_S_n ? ? H1)). Intros y0 H2.
- Elim (sumbool_of_bool (ad_eq a (alist_nth_ad n0 l0))). Intro H3. Split with y.
- Rewrite (ad_eq_complete ? ? H3). Simpl. Rewrite (ad_eq_correct (alist_nth_ad n0 l0)).
- Reflexivity.
- Intro H3. Split with y0. Simpl. Rewrite H3. Assumption.
+ simple induction l. intros. elim (le_Sn_O _ H).
+ intro r. elim r. intros a y l0 H. simple induction n. simpl in |- *. intro. split with y.
+ rewrite (ad_eq_correct a). reflexivity.
+ intros. elim (H _ (le_S_n _ _ H1)). intros y0 H2.
+ elim (sumbool_of_bool (ad_eq a (alist_nth_ad n0 l0))). intro H3. split with y.
+ rewrite (ad_eq_complete _ _ H3). simpl in |- *. rewrite (ad_eq_correct (alist_nth_ad n0 l0)).
+ reflexivity.
+ intro H3. split with y0. simpl in |- *. rewrite H3. assumption.
Qed.
- Lemma alist_of_Map_nth_ad : (m:(Map A)) (pf:ad->ad)
- (l:(alist A)) l=(MapFold1 A (alist A) (anil A) (aapp A)
- [a0:ad][y:A](acons A (a0,y) (anil A)) pf m) ->
- (n:nat) (le (S n) (length l)) -> {a':ad | (alist_nth_ad n l)=(pf a')}.
+ Lemma alist_of_Map_nth_ad :
+ forall (m:Map A) (pf:ad -> ad) (l:alist A),
+ l =
+ MapFold1 A (alist A) (anil A) (aapp A)
+ (fun (a0:ad) (y:A) => acons A (a0, y) (anil A)) pf m ->
+ forall n:nat, S n <= length l -> {a' : ad | alist_nth_ad n l = pf a'}.
Proof.
- Intros. Elim (alist_nth_ad_semantics l n H0). Intros y H1.
- Apply (alist_of_Map_semantics_1_1 A m pf (alist_nth_ad n l) y).
- Rewrite <- H. Assumption.
+ intros. elim (alist_nth_ad_semantics l n H0). intros y H1.
+ apply (alist_of_Map_semantics_1_1 A m pf (alist_nth_ad n l) y).
+ rewrite <- H. assumption.
Qed.
- Definition ad_monotonic := [pf:ad->ad] (a,a':ad)
- (ad_less a a')=true -> (ad_less (pf a) (pf a'))=true.
+ Definition ad_monotonic (pf:ad -> ad) :=
+ forall a a':ad, ad_less a a' = true -> ad_less (pf a) (pf a') = true.
- Lemma ad_double_monotonic : (ad_monotonic ad_double).
+ Lemma ad_double_monotonic : ad_monotonic ad_double.
Proof.
- Unfold ad_monotonic. Intros. Rewrite ad_less_def_1. Assumption.
+ unfold ad_monotonic in |- *. intros. rewrite ad_less_def_1. assumption.
Qed.
- Lemma ad_double_plus_un_monotonic : (ad_monotonic ad_double_plus_un).
+ Lemma ad_double_plus_un_monotonic : ad_monotonic ad_double_plus_un.
Proof.
- Unfold ad_monotonic. Intros. Rewrite ad_less_def_2. Assumption.
+ unfold ad_monotonic in |- *. intros. rewrite ad_less_def_2. assumption.
Qed.
- Lemma ad_comp_monotonic : (pf,pf':ad->ad) (ad_monotonic pf) -> (ad_monotonic pf') ->
- (ad_monotonic [a0:ad] (pf (pf' a0))).
+ Lemma ad_comp_monotonic :
+ forall pf pf':ad -> ad,
+ ad_monotonic pf ->
+ ad_monotonic pf' -> ad_monotonic (fun a0:ad => pf (pf' a0)).
Proof.
- Unfold ad_monotonic. Intros. Apply H. Apply H0. Exact H1.
+ unfold ad_monotonic in |- *. intros. apply H. apply H0. exact H1.
Qed.
- Lemma ad_comp_double_monotonic : (pf:ad->ad) (ad_monotonic pf) ->
- (ad_monotonic [a0:ad] (pf (ad_double a0))).
+ Lemma ad_comp_double_monotonic :
+ forall pf:ad -> ad,
+ ad_monotonic pf -> ad_monotonic (fun a0:ad => pf (ad_double a0)).
Proof.
- Intros. Apply ad_comp_monotonic. Assumption.
- Exact ad_double_monotonic.
+ intros. apply ad_comp_monotonic. assumption.
+ exact ad_double_monotonic.
Qed.
- Lemma ad_comp_double_plus_un_monotonic : (pf:ad->ad) (ad_monotonic pf) ->
- (ad_monotonic [a0:ad] (pf (ad_double_plus_un a0))).
+ Lemma ad_comp_double_plus_un_monotonic :
+ forall pf:ad -> ad,
+ ad_monotonic pf -> ad_monotonic (fun a0:ad => pf (ad_double_plus_un a0)).
Proof.
- Intros. Apply ad_comp_monotonic. Assumption.
- Exact ad_double_plus_un_monotonic.
+ intros. apply ad_comp_monotonic. assumption.
+ exact ad_double_plus_un_monotonic.
Qed.
- Lemma alist_of_Map_sorts_1 : (m:(Map A)) (pf:ad->ad) (ad_monotonic pf) ->
- (alist_sorted_2 (MapFold1 A (alist A) (anil A) (aapp A)
- [a:ad][y:A](acons A (a,y) (anil A)) pf m)).
- Proof.
- Induction m. Simpl. Intros. Apply alist_sorted_1_imp_2. Apply alist_sorted_imp_1. Reflexivity.
- Intros. Simpl. Apply alist_sorted_1_imp_2. Apply alist_sorted_imp_1. Reflexivity.
- Intros. Simpl. Apply alist_conc_sorted.
- Exact (H [a0:ad](pf (ad_double a0)) (ad_comp_double_monotonic pf H1)).
- Exact (H0 [a0:ad](pf (ad_double_plus_un a0)) (ad_comp_double_plus_un_monotonic pf H1)).
- Intros. Elim (alist_of_Map_nth_ad m0 [a0:ad](pf (ad_double a0))
- (MapFold1 A (alist A) (anil A) (aapp A)
- [a0:ad][y:A](acons A (a0,y) (anil A))
- [a0:ad](pf (ad_double a0)) m0) (refl_equal ? ?) n H2).
- Intros a H4. Rewrite H4. Elim (alist_of_Map_nth_ad m1 [a0:ad](pf (ad_double_plus_un a0))
+ Lemma alist_of_Map_sorts_1 :
+ forall (m:Map A) (pf:ad -> ad),
+ ad_monotonic pf ->
+ alist_sorted_2
(MapFold1 A (alist A) (anil A) (aapp A)
- [a0:ad][y:A](acons A (a0,y) (anil A))
- [a0:ad](pf (ad_double_plus_un a0)) m1) (refl_equal ? ?) n' H3).
- Intros a' H5. Rewrite H5. Unfold ad_monotonic in H1. Apply H1. Apply ad_less_def_3.
- Qed.
-
- Lemma alist_of_Map_sorts : (m:(Map A)) (alist_sorted (alist_of_Map A m))=true.
- Proof.
- Intro. Apply alist_sorted_2_imp.
- Exact (alist_of_Map_sorts_1 m [a0:ad]a0 [a,a':ad][p:(ad_less a a')=true]p).
- Qed.
-
- Lemma alist_of_Map_sorts1 : (m:(Map A)) (alist_sorted_1 (alist_of_Map A m)).
- Proof.
- Intro. Apply alist_sorted_imp_1. Apply alist_of_Map_sorts.
+ (fun (a:ad) (y:A) => acons A (a, y) (anil A)) pf m).
+ Proof.
+ simple induction m. simpl in |- *. intros. apply alist_sorted_1_imp_2. apply alist_sorted_imp_1. reflexivity.
+ intros. simpl in |- *. apply alist_sorted_1_imp_2. apply alist_sorted_imp_1. reflexivity.
+ intros. simpl in |- *. apply alist_conc_sorted.
+ exact
+ (H (fun a0:ad => pf (ad_double a0)) (ad_comp_double_monotonic pf H1)).
+ exact
+ (H0 (fun a0:ad => pf (ad_double_plus_un a0))
+ (ad_comp_double_plus_un_monotonic pf H1)).
+ intros. elim
+ (alist_of_Map_nth_ad m0 (fun a0:ad => pf (ad_double a0))
+ (MapFold1 A (alist A) (anil A) (aapp A)
+ (fun (a0:ad) (y:A) => acons A (a0, y) (anil A))
+ (fun a0:ad => pf (ad_double a0)) m0) (refl_equal _) n H2).
+ intros a H4. rewrite H4. elim
+ (alist_of_Map_nth_ad m1 (fun a0:ad => pf (ad_double_plus_un a0))
+ (MapFold1 A (alist A) (anil A) (aapp A)
+ (fun (a0:ad) (y:A) => acons A (a0, y) (anil A))
+ (fun a0:ad => pf (ad_double_plus_un a0)) m1) (
+ refl_equal _) n' H3).
+ intros a' H5. rewrite H5. unfold ad_monotonic in H1. apply H1. apply ad_less_def_3.
+ Qed.
+
+ Lemma alist_of_Map_sorts :
+ forall m:Map A, alist_sorted (alist_of_Map A m) = true.
+ Proof.
+ intro. apply alist_sorted_2_imp.
+ exact
+ (alist_of_Map_sorts_1 m (fun a0:ad => a0)
+ (fun (a a':ad) (p:ad_less a a' = true) => p)).
+ Qed.
+
+ Lemma alist_of_Map_sorts1 :
+ forall m:Map A, alist_sorted_1 (alist_of_Map A m).
+ Proof.
+ intro. apply alist_sorted_imp_1. apply alist_of_Map_sorts.
Qed.
- Lemma alist_of_Map_sorts2 : (m:(Map A)) (alist_sorted_2 (alist_of_Map A m)).
+ Lemma alist_of_Map_sorts2 :
+ forall m:Map A, alist_sorted_2 (alist_of_Map A m).
Proof.
- Intro. Apply alist_sorted_1_imp_2. Apply alist_of_Map_sorts1.
+ intro. apply alist_sorted_1_imp_2. apply alist_of_Map_sorts1.
Qed.
- Lemma ad_less_total : (a,a':ad) {(ad_less a a')=true}+{(ad_less a' a)=true}+{a=a'}.
- Proof.
- Intro a. Refine (ad_rec_double a [a:ad] (a':ad){(ad_less a a')=true}+{(ad_less a' a)=true}+{a=a'}
- ? ? ?).
- Intro. Elim (sumbool_of_bool (ad_less ad_z a')). Intro H. Left . Left . Assumption.
- Intro H. Right . Rewrite (ad_z_less_2 a' H). Reflexivity.
- Intros a0 H a'. Refine (ad_rec_double a' [a':ad] {(ad_less (ad_double a0) a')=true}
- +{(ad_less a' (ad_double a0))=true}+{(ad_double a0)=a'} ? ? ?).
- Elim (sumbool_of_bool (ad_less ad_z (ad_double a0))). Intro H0. Left . Right . Assumption.
- Intro H0. Right . Exact (ad_z_less_2 ? H0).
- Intros a1 H0. Rewrite ad_less_def_1. Rewrite ad_less_def_1. Elim (H a1). Intro H1.
- Left . Assumption.
- Intro H1. Right . Rewrite H1. Reflexivity.
- Intros a1 H0. Left . Left . Apply ad_less_def_3.
- Intros a0 H a'. Refine (ad_rec_double a' [a':ad] {(ad_less (ad_double_plus_un a0) a')=true}
- +{(ad_less a' (ad_double_plus_un a0))=true}
- +{(ad_double_plus_un a0)=a'} ? ? ?).
- Left . Right . (Case a0; Reflexivity).
- Intros a1 H0. Left . Right . Apply ad_less_def_3.
- Intros a1 H0. Rewrite ad_less_def_2. Rewrite ad_less_def_2. Elim (H a1). Intro H1.
- Left . Assumption.
- Intro H1. Right . Rewrite H1. Reflexivity.
- Qed.
-
- Lemma alist_too_low : (l:(alist A)) (a,a':ad) (y:A)
- (ad_less a a')=true -> (alist_sorted_2 (cons (a',y) l)) ->
- (alist_semantics A (cons (a',y) l) a)=(NONE A).
- Proof.
- Induction l. Intros. Simpl. Elim (sumbool_of_bool (ad_eq a' a)). Intro H1.
- Rewrite (ad_eq_complete ? ? H1) in H. Rewrite (ad_less_not_refl a) in H. Discriminate H.
- Intro H1. Rewrite H1. Reflexivity.
- Intro r. Elim r. Intros a y l0 H a0 a1 y0 H0 H1.
- Change (Case (ad_eq a1 a0) of
- (SOME A y0)
- (alist_semantics A (cons (a,y) l0) a0)
- end)=(NONE A).
- Elim (sumbool_of_bool (ad_eq a1 a0)). Intro H2. Rewrite (ad_eq_complete ? ? H2) in H0.
- Rewrite (ad_less_not_refl a0) in H0. Discriminate H0.
- Intro H2. Rewrite H2. Apply H. Apply ad_less_trans with a':=a1. Assumption.
- Unfold alist_sorted_2 in H1. Apply (H1 (0) (1)). Apply lt_n_Sn.
- Simpl. Apply le_n_S. Apply le_n_S. Apply le_O_n.
- Apply alist_sorted_1_imp_2. Apply alist_sorted_imp_1.
- Cut (alist_sorted (cons (a1,y0) (cons (a,y) l0)))=true. Intro H3.
- Exact (proj2 ? ? (andb_prop ? ? H3)).
- Apply alist_sorted_2_imp. Assumption.
- Qed.
-
- Lemma alist_semantics_nth_ad : (l:(alist A)) (a:ad) (y:A)
- (alist_semantics A l a)=(SOME A y) ->
- {n:nat | (le (S n) (length l)) /\ (alist_nth_ad n l)=a}.
- Proof.
- Induction l. Intros. Discriminate H.
- Intro r. Elim r. Intros a y l0 H a0 y0 H0. Simpl in H0. Elim (sumbool_of_bool (ad_eq a a0)).
- Intro H1. Rewrite H1 in H0. Split with O. Split. Simpl. Apply le_n_S. Apply le_O_n.
- Simpl. Exact (ad_eq_complete ? ? H1).
- Intro H1. Rewrite H1 in H0. Elim (H a0 y0 H0). Intros n' H2. Split with (S n'). Split.
- Simpl. Apply le_n_S. Exact (proj1 ? ? H2).
- Exact (proj2 ? ? H2).
- Qed.
-
- Lemma alist_semantics_tail : (l:(alist A)) (a:ad) (y:A)
- (alist_sorted_2 (cons (a,y) l)) ->
- (eqm A (alist_semantics A l) [a0:ad] if (ad_eq a a0)
- then (NONE A)
- else (alist_semantics A (cons (a,y) l) a0)).
- Proof.
- Unfold eqm. Intros. Elim (sumbool_of_bool (ad_eq a a0)). Intro H0. Rewrite H0.
- Rewrite <- (ad_eq_complete ? ? H0). Unfold alist_sorted_2 in H.
- Elim (option_sum A (alist_semantics A l a)). Intro H1. Elim H1. Intros y0 H2.
- Elim (alist_semantics_nth_ad l a y0 H2). Intros n H3. Elim H3. Intros.
- Cut (ad_less (alist_nth_ad (0) (cons (a,y) l)) (alist_nth_ad (S n) (cons (a,y) l)))=true.
- Intro. Simpl in H6. Rewrite H5 in H6. Rewrite (ad_less_not_refl a) in H6. Discriminate H6.
- Apply H. Apply lt_O_Sn.
- Simpl. Apply le_n_S. Assumption.
- Trivial.
- Intro H0. Simpl. Rewrite H0. Reflexivity.
- Qed.
-
- Lemma alist_semantics_same_tail : (l,l':(alist A)) (a:ad) (y:A)
- (alist_sorted_2 (cons (a,y) l)) -> (alist_sorted_2 (cons (a,y) l')) ->
- (eqm A (alist_semantics A (cons (a,y) l)) (alist_semantics A (cons (a,y) l'))) ->
- (eqm A (alist_semantics A l) (alist_semantics A l')).
- Proof.
- Unfold eqm. Intros. Rewrite (alist_semantics_tail ? ? ? H a0).
- Rewrite (alist_semantics_tail ? ? ? H0 a0). Case (ad_eq a a0). Reflexivity.
- Exact (H1 a0).
- Qed.
-
- Lemma alist_sorted_tail : (l:(alist A)) (a:ad) (y:A)
- (alist_sorted_2 (cons (a,y) l)) -> (alist_sorted_2 l).
- Proof.
- Unfold alist_sorted_2. Intros. Apply (H (S m) (S n)). Apply lt_n_S. Assumption.
- Simpl. Apply le_n_S. Assumption.
- Qed.
-
- Lemma alist_canonical : (l,l':(alist A))
- (eqm A (alist_semantics A l) (alist_semantics A l')) ->
- (alist_sorted_2 l) -> (alist_sorted_2 l') -> l=l'.
- Proof.
- Unfold eqm. Induction l. Induction l'. Trivial.
- Intro r. Elim r. Intros a y l0 H H0 H1 H2. Simpl in H0.
- Cut (NONE A)=(Case (ad_eq a a) of (SOME A y)
- (alist_semantics A l0 a)
- end).
- Rewrite (ad_eq_correct a). Intro. Discriminate H3.
- Exact (H0 a).
- Intro r. Elim r. Intros a y l0 H. Induction l'. Intros. Simpl in H0.
- Cut (Case (ad_eq a a) of (SOME A y)
- (alist_semantics A l0 a)
- end)=(NONE A).
- Rewrite (ad_eq_correct a). Intro. Discriminate H3.
- Exact (H0 a).
- Intro r'. Elim r'. Intros a' y' l'0 H0 H1 H2 H3. Elim (ad_less_total a a'). Intro H4.
- Elim H4. Intro H5.
- Cut (alist_semantics A (cons (a,y) l0) a)=(alist_semantics A (cons (a',y') l'0) a).
- Intro. Rewrite (alist_too_low l'0 a a' y' H5 H3) in H6. Simpl in H6.
- Rewrite (ad_eq_correct a) in H6. Discriminate H6.
- Exact (H1 a).
- Intro H5. Cut (alist_semantics A (cons (a,y) l0) a')=(alist_semantics A (cons (a',y') l'0) a').
- Intro. Rewrite (alist_too_low l0 a' a y H5 H2) in H6. Simpl in H6.
- Rewrite (ad_eq_correct a') in H6. Discriminate H6.
- Exact (H1 a').
- Intro H4. Rewrite H4.
- Cut (alist_semantics A (cons (a,y) l0) a)=(alist_semantics A (cons (a',y') l'0) a).
- Intro. Simpl in H5. Rewrite H4 in H5. Rewrite (ad_eq_correct a') in H5. Inversion H5.
- Rewrite H4 in H1. Rewrite H7 in H1. Cut l0=l'0. Intro. Rewrite H6. Reflexivity.
- Apply H. Rewrite H4 in H2. Rewrite H7 in H2.
- Exact (alist_semantics_same_tail l0 l'0 a' y' H2 H3 H1).
- Exact (alist_sorted_tail ? ? ? H2).
- Exact (alist_sorted_tail ? ? ? H3).
- Exact (H1 a).
- Qed.
-
-End LSort.
+ Lemma ad_less_total :
+ forall a a':ad, {ad_less a a' = true} + {ad_less a' a = true} + {a = a'}.
+ Proof.
+ intro a. refine
+ (ad_rec_double a
+ (fun a:ad =>
+ forall a':ad,
+ {ad_less a a' = true} + {ad_less a' a = true} + {a = a'}) _ _ _).
+ intro. elim (sumbool_of_bool (ad_less ad_z a')). intro H. left. left. assumption.
+ intro H. right. rewrite (ad_z_less_2 a' H). reflexivity.
+ intros a0 H a'. refine
+ (ad_rec_double a'
+ (fun a':ad =>
+ {ad_less (ad_double a0) a' = true} +
+ {ad_less a' (ad_double a0) = true} + {ad_double a0 = a'}) _ _ _).
+ elim (sumbool_of_bool (ad_less ad_z (ad_double a0))). intro H0. left. right. assumption.
+ intro H0. right. exact (ad_z_less_2 _ H0).
+ intros a1 H0. rewrite ad_less_def_1. rewrite ad_less_def_1. elim (H a1). intro H1.
+ left. assumption.
+ intro H1. right. rewrite H1. reflexivity.
+ intros a1 H0. left. left. apply ad_less_def_3.
+ intros a0 H a'. refine
+ (ad_rec_double a'
+ (fun a':ad =>
+ {ad_less (ad_double_plus_un a0) a' = true} +
+ {ad_less a' (ad_double_plus_un a0) = true} +
+ {ad_double_plus_un a0 = a'}) _ _ _).
+ left. right. case a0; reflexivity.
+ intros a1 H0. left. right. apply ad_less_def_3.
+ intros a1 H0. rewrite ad_less_def_2. rewrite ad_less_def_2. elim (H a1). intro H1.
+ left. assumption.
+ intro H1. right. rewrite H1. reflexivity.
+ Qed.
+
+ Lemma alist_too_low :
+ forall (l:alist A) (a a':ad) (y:A),
+ ad_less a a' = true ->
+ alist_sorted_2 ((a', y) :: l) ->
+ alist_semantics A ((a', y) :: l) a = NONE A.
+ Proof.
+ simple induction l. intros. simpl in |- *. elim (sumbool_of_bool (ad_eq a' a)). intro H1.
+ rewrite (ad_eq_complete _ _ H1) in H. rewrite (ad_less_not_refl a) in H. discriminate H.
+ intro H1. rewrite H1. reflexivity.
+ intro r. elim r. intros a y l0 H a0 a1 y0 H0 H1.
+ change
+ (match ad_eq a1 a0 with
+ | true => SOME A y0
+ | false => alist_semantics A ((a, y) :: l0) a0
+ end = NONE A) in |- *.
+ elim (sumbool_of_bool (ad_eq a1 a0)). intro H2. rewrite (ad_eq_complete _ _ H2) in H0.
+ rewrite (ad_less_not_refl a0) in H0. discriminate H0.
+ intro H2. rewrite H2. apply H. apply ad_less_trans with (a' := a1). assumption.
+ unfold alist_sorted_2 in H1. apply (H1 0 1). apply lt_n_Sn.
+ simpl in |- *. apply le_n_S. apply le_n_S. apply le_O_n.
+ apply alist_sorted_1_imp_2. apply alist_sorted_imp_1.
+ cut (alist_sorted ((a1, y0) :: (a, y) :: l0) = true). intro H3.
+ exact (proj2 (andb_prop _ _ H3)).
+ apply alist_sorted_2_imp. assumption.
+ Qed.
+
+ Lemma alist_semantics_nth_ad :
+ forall (l:alist A) (a:ad) (y:A),
+ alist_semantics A l a = SOME A y ->
+ {n : nat | S n <= length l /\ alist_nth_ad n l = a}.
+ Proof.
+ simple induction l. intros. discriminate H.
+ intro r. elim r. intros a y l0 H a0 y0 H0. simpl in H0. elim (sumbool_of_bool (ad_eq a a0)).
+ intro H1. rewrite H1 in H0. split with 0. split. simpl in |- *. apply le_n_S. apply le_O_n.
+ simpl in |- *. exact (ad_eq_complete _ _ H1).
+ intro H1. rewrite H1 in H0. elim (H a0 y0 H0). intros n' H2. split with (S n'). split.
+ simpl in |- *. apply le_n_S. exact (proj1 H2).
+ exact (proj2 H2).
+ Qed.
+
+ Lemma alist_semantics_tail :
+ forall (l:alist A) (a:ad) (y:A),
+ alist_sorted_2 ((a, y) :: l) ->
+ eqm A (alist_semantics A l)
+ (fun a0:ad =>
+ if ad_eq a a0 then NONE A else alist_semantics A ((a, y) :: l) a0).
+ Proof.
+ unfold eqm in |- *. intros. elim (sumbool_of_bool (ad_eq a a0)). intro H0. rewrite H0.
+ rewrite <- (ad_eq_complete _ _ H0). unfold alist_sorted_2 in H.
+ elim (option_sum A (alist_semantics A l a)). intro H1. elim H1. intros y0 H2.
+ elim (alist_semantics_nth_ad l a y0 H2). intros n H3. elim H3. intros.
+ cut
+ (ad_less (alist_nth_ad 0 ((a, y) :: l))
+ (alist_nth_ad (S n) ((a, y) :: l)) = true).
+ intro. simpl in H6. rewrite H5 in H6. rewrite (ad_less_not_refl a) in H6. discriminate H6.
+ apply H. apply lt_O_Sn.
+ simpl in |- *. apply le_n_S. assumption.
+ trivial.
+ intro H0. simpl in |- *. rewrite H0. reflexivity.
+ Qed.
+
+ Lemma alist_semantics_same_tail :
+ forall (l l':alist A) (a:ad) (y:A),
+ alist_sorted_2 ((a, y) :: l) ->
+ alist_sorted_2 ((a, y) :: l') ->
+ eqm A (alist_semantics A ((a, y) :: l))
+ (alist_semantics A ((a, y) :: l')) ->
+ eqm A (alist_semantics A l) (alist_semantics A l').
+ Proof.
+ unfold eqm in |- *. intros. rewrite (alist_semantics_tail _ _ _ H a0).
+ rewrite (alist_semantics_tail _ _ _ H0 a0). case (ad_eq a a0). reflexivity.
+ exact (H1 a0).
+ Qed.
+
+ Lemma alist_sorted_tail :
+ forall (l:alist A) (a:ad) (y:A),
+ alist_sorted_2 ((a, y) :: l) -> alist_sorted_2 l.
+ Proof.
+ unfold alist_sorted_2 in |- *. intros. apply (H (S m) (S n)). apply lt_n_S. assumption.
+ simpl in |- *. apply le_n_S. assumption.
+ Qed.
+
+ Lemma alist_canonical :
+ forall l l':alist A,
+ eqm A (alist_semantics A l) (alist_semantics A l') ->
+ alist_sorted_2 l -> alist_sorted_2 l' -> l = l'.
+ Proof.
+ unfold eqm in |- *. simple induction l. simple induction l'. trivial.
+ intro r. elim r. intros a y l0 H H0 H1 H2. simpl in H0.
+ cut
+ (NONE A =
+ match ad_eq a a with
+ | true => SOME A y
+ | false => alist_semantics A l0 a
+ end).
+ rewrite (ad_eq_correct a). intro. discriminate H3.
+ exact (H0 a).
+ intro r. elim r. intros a y l0 H. simple induction l'. intros. simpl in H0.
+ cut
+ (match ad_eq a a with
+ | true => SOME A y
+ | false => alist_semantics A l0 a
+ end = NONE A).
+ rewrite (ad_eq_correct a). intro. discriminate H3.
+ exact (H0 a).
+ intro r'. elim r'. intros a' y' l'0 H0 H1 H2 H3. elim (ad_less_total a a'). intro H4.
+ elim H4. intro H5.
+ cut
+ (alist_semantics A ((a, y) :: l0) a =
+ alist_semantics A ((a', y') :: l'0) a).
+ intro. rewrite (alist_too_low l'0 a a' y' H5 H3) in H6. simpl in H6.
+ rewrite (ad_eq_correct a) in H6. discriminate H6.
+ exact (H1 a).
+ intro H5. cut
+ (alist_semantics A ((a, y) :: l0) a' =
+ alist_semantics A ((a', y') :: l'0) a').
+ intro. rewrite (alist_too_low l0 a' a y H5 H2) in H6. simpl in H6.
+ rewrite (ad_eq_correct a') in H6. discriminate H6.
+ exact (H1 a').
+ intro H4. rewrite H4.
+ cut
+ (alist_semantics A ((a, y) :: l0) a =
+ alist_semantics A ((a', y') :: l'0) a).
+ intro. simpl in H5. rewrite H4 in H5. rewrite (ad_eq_correct a') in H5. inversion H5.
+ rewrite H4 in H1. rewrite H7 in H1. cut (l0 = l'0). intro. rewrite H6. reflexivity.
+ apply H. rewrite H4 in H2. rewrite H7 in H2.
+ exact (alist_semantics_same_tail l0 l'0 a' y' H2 H3 H1).
+ exact (alist_sorted_tail _ _ _ H2).
+ exact (alist_sorted_tail _ _ _ H3).
+ exact (H1 a).
+ Qed.
+
+End LSort. \ No newline at end of file
diff --git a/theories/IntMap/Map.v b/theories/IntMap/Map.v
index b89f61042..68091d6f0 100644
--- a/theories/IntMap/Map.v
+++ b/theories/IntMap/Map.v
@@ -9,12 +9,12 @@
(** Definition of finite sets as trees indexed by adresses *)
-Require Bool.
-Require Sumbool.
-Require ZArith.
-Require Addr.
-Require Adist.
-Require Addec.
+Require Import Bool.
+Require Import Sumbool.
+Require Import ZArith.
+Require Import Addr.
+Require Import Adist.
+Require Import Addec.
Section MapDefs.
@@ -23,174 +23,197 @@ Section MapDefs.
Variable A : Set.
Inductive Map : Set :=
- M0 : Map
+ | M0 : Map
| M1 : ad -> A -> Map
| M2 : Map -> Map -> Map.
Inductive option : Set :=
- NONE : option
+ | NONE : option
| SOME : A -> option.
- Lemma option_sum : (o:option) {y:A | o=(SOME y)}+{o=NONE}.
+ Lemma option_sum : forall o:option, {y : A | o = SOME y} + {o = NONE}.
Proof.
- Induction o. Right . Reflexivity.
- Left . Split with a. Reflexivity.
+ simple induction o. right. reflexivity.
+ left. split with a. reflexivity.
Qed.
(** The semantics of maps is given by the function [MapGet].
The semantics of a map [m] is a partial, finite function from
[ad] to [A]: *)
- Fixpoint MapGet [m:Map] : ad -> option :=
- Cases m of
- M0 => [a:ad] NONE
- | (M1 x y) => [a:ad]
- if (ad_eq x a)
- then (SOME y)
- else NONE
- | (M2 m1 m2) => [a:ad]
- Cases a of
- ad_z => (MapGet m1 ad_z)
- | (ad_x xH) => (MapGet m2 ad_z)
- | (ad_x (xO p)) => (MapGet m1 (ad_x p))
- | (ad_x (xI p)) => (MapGet m2 (ad_x p))
- end
+ Fixpoint MapGet (m:Map) : ad -> option :=
+ match m with
+ | M0 => fun a:ad => NONE
+ | M1 x y => fun a:ad => if ad_eq x a then SOME y else NONE
+ | M2 m1 m2 =>
+ fun a:ad =>
+ match a with
+ | ad_z => MapGet m1 ad_z
+ | ad_x xH => MapGet m2 ad_z
+ | ad_x (xO p) => MapGet m1 (ad_x p)
+ | ad_x (xI p) => MapGet m2 (ad_x p)
+ end
end.
Definition newMap := M0.
Definition MapSingleton := M1.
- Definition eqm := [g,g':ad->option] (a:ad) (g a)=(g' a).
+ Definition eqm (g g':ad -> option) := forall a:ad, g a = g' a.
- Lemma newMap_semantics : (eqm (MapGet newMap) [a:ad] NONE).
+ Lemma newMap_semantics : eqm (MapGet newMap) (fun a:ad => NONE).
Proof.
- Simpl. Unfold eqm. Trivial.
+ simpl in |- *. unfold eqm in |- *. trivial.
Qed.
- Lemma MapSingleton_semantics : (a:ad) (y:A)
- (eqm (MapGet (MapSingleton a y)) [a':ad] if (ad_eq a a') then (SOME y) else NONE).
+ Lemma MapSingleton_semantics :
+ forall (a:ad) (y:A),
+ eqm (MapGet (MapSingleton a y))
+ (fun a':ad => if ad_eq a a' then SOME y else NONE).
Proof.
- Simpl. Unfold eqm. Trivial.
+ simpl in |- *. unfold eqm in |- *. trivial.
Qed.
- Lemma M1_semantics_1 : (a:ad) (y:A) (MapGet (M1 a y) a)=(SOME y).
+ Lemma M1_semantics_1 : forall (a:ad) (y:A), MapGet (M1 a y) a = SOME y.
Proof.
- Unfold MapGet. Intros. Rewrite (ad_eq_correct a). Reflexivity.
+ unfold MapGet in |- *. intros. rewrite (ad_eq_correct a). reflexivity.
Qed.
Lemma M1_semantics_2 :
- (a,a':ad) (y:A) (ad_eq a a')=false -> (MapGet (M1 a y) a')=NONE.
+ forall (a a':ad) (y:A), ad_eq a a' = false -> MapGet (M1 a y) a' = NONE.
Proof.
- Intros. Simpl. Rewrite H. Reflexivity.
+ intros. simpl in |- *. rewrite H. reflexivity.
Qed.
Lemma Map2_semantics_1 :
- (m,m':Map) (eqm (MapGet m) [a:ad] (MapGet (M2 m m') (ad_double a))).
+ forall m m':Map,
+ eqm (MapGet m) (fun a:ad => MapGet (M2 m m') (ad_double a)).
Proof.
- Unfold eqm. Induction a; Trivial.
+ unfold eqm in |- *. simple induction a; trivial.
Qed.
- Lemma Map2_semantics_1_eq : (m,m':Map) (f:ad->option) (eqm (MapGet (M2 m m')) f)
- -> (eqm (MapGet m) [a:ad] (f (ad_double a))).
+ Lemma Map2_semantics_1_eq :
+ forall (m m':Map) (f:ad -> option),
+ eqm (MapGet (M2 m m')) f -> eqm (MapGet m) (fun a:ad => f (ad_double a)).
Proof.
- Unfold eqm.
- Intros.
- Rewrite <- (H (ad_double a)).
- Exact (Map2_semantics_1 m m' a).
+ unfold eqm in |- *.
+ intros.
+ rewrite <- (H (ad_double a)).
+ exact (Map2_semantics_1 m m' a).
Qed.
Lemma Map2_semantics_2 :
- (m,m':Map) (eqm (MapGet m') [a:ad] (MapGet (M2 m m') (ad_double_plus_un a))).
- Proof.
- Unfold eqm. Induction a; Trivial.
- Qed.
-
- Lemma Map2_semantics_2_eq : (m,m':Map) (f:ad->option) (eqm (MapGet (M2 m m')) f)
- -> (eqm (MapGet m') [a:ad] (f (ad_double_plus_un a))).
- Proof.
- Unfold eqm.
- Intros.
- Rewrite <- (H (ad_double_plus_un a)).
- Exact (Map2_semantics_2 m m' a).
- Qed.
-
- Lemma MapGet_M2_bit_0_0 : (a:ad) (ad_bit_0 a)=false
- -> (m,m':Map) (MapGet (M2 m m') a)=(MapGet m (ad_div_2 a)).
- Proof.
- Induction a; Trivial. Induction p. Intros. Discriminate H0.
- Trivial.
- Intros. Discriminate H.
- Qed.
-
- Lemma MapGet_M2_bit_0_1 : (a:ad) (ad_bit_0 a)=true
- -> (m,m':Map) (MapGet (M2 m m') a)=(MapGet m' (ad_div_2 a)).
- Proof.
- Induction a. Intros. Discriminate H.
- Induction p. Trivial.
- Intros. Discriminate H0.
- Trivial.
- Qed.
-
- Lemma MapGet_M2_bit_0_if : (m,m':Map) (a:ad) (MapGet (M2 m m') a)=
- (if (ad_bit_0 a) then (MapGet m' (ad_div_2 a)) else (MapGet m (ad_div_2 a))).
- Proof.
- Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H. Rewrite H.
- Apply MapGet_M2_bit_0_1; Assumption.
- Intro H. Rewrite H. Apply MapGet_M2_bit_0_0; Assumption.
- Qed.
-
- Lemma MapGet_M2_bit_0 : (m,m',m'':Map)
- (a:ad) (if (ad_bit_0 a) then (MapGet (M2 m' m) a) else (MapGet (M2 m m'') a))=
- (MapGet m (ad_div_2 a)).
- Proof.
- Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H. Rewrite H.
- Apply MapGet_M2_bit_0_1; Assumption.
- Intro H. Rewrite H. Apply MapGet_M2_bit_0_0; Assumption.
- Qed.
-
- Lemma Map2_semantics_3 : (m,m':Map) (eqm (MapGet (M2 m m'))
- [a:ad] Cases (ad_bit_0 a) of
- false => (MapGet m (ad_div_2 a))
- | true => (MapGet m' (ad_div_2 a))
- end).
- Proof.
- Unfold eqm.
- Induction a; Trivial.
- Induction p; Trivial.
- Qed.
-
- Lemma Map2_semantics_3_eq : (m,m':Map) (f,f':ad->option)
- (eqm (MapGet m) f) -> (eqm (MapGet m') f') -> (eqm (MapGet (M2 m m'))
- [a:ad] Cases (ad_bit_0 a) of
- false => (f (ad_div_2 a))
- | true => (f' (ad_div_2 a))
- end).
- Proof.
- Unfold eqm.
- Intros.
- Rewrite <- (H (ad_div_2 a)).
- Rewrite <- (H0 (ad_div_2 a)).
- Exact (Map2_semantics_3 m m' a).
- Qed.
-
- Fixpoint MapPut1 [a:ad; y:A; a':ad; y':A; p:positive] : Map :=
- Cases p of
- (xO p') => let m = (MapPut1 (ad_div_2 a) y (ad_div_2 a') y' p') in
- Cases (ad_bit_0 a) of
- false => (M2 m M0)
- | true => (M2 M0 m)
- end
- | _ => Cases (ad_bit_0 a) of
- false => (M2 (M1 (ad_div_2 a) y) (M1 (ad_div_2 a') y'))
- | true => (M2 (M1 (ad_div_2 a') y') (M1 (ad_div_2 a) y))
- end
+ forall m m':Map,
+ eqm (MapGet m') (fun a:ad => MapGet (M2 m m') (ad_double_plus_un a)).
+ Proof.
+ unfold eqm in |- *. simple induction a; trivial.
+ Qed.
+
+ Lemma Map2_semantics_2_eq :
+ forall (m m':Map) (f:ad -> option),
+ eqm (MapGet (M2 m m')) f ->
+ eqm (MapGet m') (fun a:ad => f (ad_double_plus_un a)).
+ Proof.
+ unfold eqm in |- *.
+ intros.
+ rewrite <- (H (ad_double_plus_un a)).
+ exact (Map2_semantics_2 m m' a).
+ Qed.
+
+ Lemma MapGet_M2_bit_0_0 :
+ forall a:ad,
+ ad_bit_0 a = false ->
+ forall m m':Map, MapGet (M2 m m') a = MapGet m (ad_div_2 a).
+ Proof.
+ simple induction a; trivial. simple induction p. intros. discriminate H0.
+ trivial.
+ intros. discriminate H.
+ Qed.
+
+ Lemma MapGet_M2_bit_0_1 :
+ forall a:ad,
+ ad_bit_0 a = true ->
+ forall m m':Map, MapGet (M2 m m') a = MapGet m' (ad_div_2 a).
+ Proof.
+ simple induction a. intros. discriminate H.
+ simple induction p. trivial.
+ intros. discriminate H0.
+ trivial.
+ Qed.
+
+ Lemma MapGet_M2_bit_0_if :
+ forall (m m':Map) (a:ad),
+ MapGet (M2 m m') a =
+ (if ad_bit_0 a then MapGet m' (ad_div_2 a) else MapGet m (ad_div_2 a)).
+ Proof.
+ intros. elim (sumbool_of_bool (ad_bit_0 a)). intro H. rewrite H.
+ apply MapGet_M2_bit_0_1; assumption.
+ intro H. rewrite H. apply MapGet_M2_bit_0_0; assumption.
+ Qed.
+
+ Lemma MapGet_M2_bit_0 :
+ forall (m m' m'':Map) (a:ad),
+ (if ad_bit_0 a then MapGet (M2 m' m) a else MapGet (M2 m m'') a) =
+ MapGet m (ad_div_2 a).
+ Proof.
+ intros. elim (sumbool_of_bool (ad_bit_0 a)). intro H. rewrite H.
+ apply MapGet_M2_bit_0_1; assumption.
+ intro H. rewrite H. apply MapGet_M2_bit_0_0; assumption.
+ Qed.
+
+ Lemma Map2_semantics_3 :
+ forall m m':Map,
+ eqm (MapGet (M2 m m'))
+ (fun a:ad =>
+ match ad_bit_0 a with
+ | false => MapGet m (ad_div_2 a)
+ | true => MapGet m' (ad_div_2 a)
+ end).
+ Proof.
+ unfold eqm in |- *.
+ simple induction a; trivial.
+ simple induction p; trivial.
+ Qed.
+
+ Lemma Map2_semantics_3_eq :
+ forall (m m':Map) (f f':ad -> option),
+ eqm (MapGet m) f ->
+ eqm (MapGet m') f' ->
+ eqm (MapGet (M2 m m'))
+ (fun a:ad =>
+ match ad_bit_0 a with
+ | false => f (ad_div_2 a)
+ | true => f' (ad_div_2 a)
+ end).
+ Proof.
+ unfold eqm in |- *.
+ intros.
+ rewrite <- (H (ad_div_2 a)).
+ rewrite <- (H0 (ad_div_2 a)).
+ exact (Map2_semantics_3 m m' a).
+ Qed.
+
+ Fixpoint MapPut1 (a:ad) (y:A) (a':ad) (y':A) (p:positive) {struct p} :
+ Map :=
+ match p with
+ | xO p' =>
+ let m := MapPut1 (ad_div_2 a) y (ad_div_2 a') y' p' in
+ match ad_bit_0 a with
+ | false => M2 m M0
+ | true => M2 M0 m
+ end
+ | _ =>
+ match ad_bit_0 a with
+ | false => M2 (M1 (ad_div_2 a) y) (M1 (ad_div_2 a') y')
+ | true => M2 (M1 (ad_div_2 a') y') (M1 (ad_div_2 a) y)
+ end
end.
- Lemma MapGet_if_commute : (b:bool) (m,m':Map) (a:ad)
- (MapGet (if b then m else m') a)=(if b then (MapGet m a) else (MapGet m' a)).
+ Lemma MapGet_if_commute :
+ forall (b:bool) (m m':Map) (a:ad),
+ MapGet (if b then m else m') a = (if b then MapGet m a else MapGet m' a).
Proof.
- Intros. Case b; Trivial.
+ intros. case b; trivial.
Qed.
(*i
@@ -206,581 +229,637 @@ Section MapDefs.
Qed.
i*)
- Lemma MapGet_if_same : (m:Map) (b:bool) (a:ad)
- (MapGet (if b then m else m) a)=(MapGet m a).
+ Lemma MapGet_if_same :
+ forall (m:Map) (b:bool) (a:ad), MapGet (if b then m else m) a = MapGet m a.
Proof.
- Induction b;Trivial.
+ simple induction b; trivial.
Qed.
- Lemma MapGet_M2_bit_0_2 : (m,m',m'':Map)
- (a:ad) (MapGet (if (ad_bit_0 a) then (M2 m m') else (M2 m' m'')) a)=
- (MapGet m' (ad_div_2 a)).
+ Lemma MapGet_M2_bit_0_2 :
+ forall (m m' m'':Map) (a:ad),
+ MapGet (if ad_bit_0 a then M2 m m' else M2 m' m'') a =
+ MapGet m' (ad_div_2 a).
Proof.
- Intros. Rewrite MapGet_if_commute. Apply MapGet_M2_bit_0.
+ intros. rewrite MapGet_if_commute. apply MapGet_M2_bit_0.
Qed.
- Lemma MapPut1_semantics_1 : (p:positive) (a,a':ad) (y,y':A)
- (ad_xor a a')=(ad_x p)
- -> (MapGet (MapPut1 a y a' y' p) a)=(SOME y).
+ Lemma MapPut1_semantics_1 :
+ forall (p:positive) (a a':ad) (y y':A),
+ ad_xor a a' = ad_x p -> MapGet (MapPut1 a y a' y' p) a = SOME y.
Proof.
- Induction p. Intros. Unfold MapPut1. Rewrite MapGet_M2_bit_0_2. Apply M1_semantics_1.
- Intros. Simpl. Rewrite MapGet_M2_bit_0_2. Apply H. Rewrite <- ad_xor_div_2. Rewrite H0.
- Reflexivity.
- Intros. Unfold MapPut1. Rewrite MapGet_M2_bit_0_2. Apply M1_semantics_1.
+ simple induction p. intros. unfold MapPut1 in |- *. rewrite MapGet_M2_bit_0_2. apply M1_semantics_1.
+ intros. simpl in |- *. rewrite MapGet_M2_bit_0_2. apply H. rewrite <- ad_xor_div_2. rewrite H0.
+ reflexivity.
+ intros. unfold MapPut1 in |- *. rewrite MapGet_M2_bit_0_2. apply M1_semantics_1.
Qed.
- Lemma MapPut1_semantics_2 : (p:positive) (a,a':ad) (y,y':A)
- (ad_xor a a')=(ad_x p)
- -> (MapGet (MapPut1 a y a' y' p) a')=(SOME y').
+ Lemma MapPut1_semantics_2 :
+ forall (p:positive) (a a':ad) (y y':A),
+ ad_xor a a' = ad_x p -> MapGet (MapPut1 a y a' y' p) a' = SOME y'.
Proof.
- Induction p. Intros. Unfold MapPut1. Rewrite (ad_neg_bit_0_2 a a' p0 H0).
- Rewrite if_negb. Rewrite MapGet_M2_bit_0_2. Apply M1_semantics_1.
- Intros. Simpl. Rewrite (ad_same_bit_0 a a' p0 H0). Rewrite MapGet_M2_bit_0_2.
- Apply H. Rewrite <- ad_xor_div_2. Rewrite H0. Reflexivity.
- Intros. Unfold MapPut1. Rewrite (ad_neg_bit_0_1 a a' H). Rewrite if_negb.
- Rewrite MapGet_M2_bit_0_2. Apply M1_semantics_1.
+ simple induction p. intros. unfold MapPut1 in |- *. rewrite (ad_neg_bit_0_2 a a' p0 H0).
+ rewrite if_negb. rewrite MapGet_M2_bit_0_2. apply M1_semantics_1.
+ intros. simpl in |- *. rewrite (ad_same_bit_0 a a' p0 H0). rewrite MapGet_M2_bit_0_2.
+ apply H. rewrite <- ad_xor_div_2. rewrite H0. reflexivity.
+ intros. unfold MapPut1 in |- *. rewrite (ad_neg_bit_0_1 a a' H). rewrite if_negb.
+ rewrite MapGet_M2_bit_0_2. apply M1_semantics_1.
Qed.
- Lemma MapGet_M2_both_NONE : (m,m':Map) (a:ad)
- (MapGet m (ad_div_2 a))=NONE -> (MapGet m' (ad_div_2 a))=NONE ->
- (MapGet (M2 m m') a)=NONE.
+ Lemma MapGet_M2_both_NONE :
+ forall (m m':Map) (a:ad),
+ MapGet m (ad_div_2 a) = NONE ->
+ MapGet m' (ad_div_2 a) = NONE -> MapGet (M2 m m') a = NONE.
Proof.
- Intros. Rewrite (Map2_semantics_3 m m' a).
- Case (ad_bit_0 a); Assumption.
+ intros. rewrite (Map2_semantics_3 m m' a).
+ case (ad_bit_0 a); assumption.
Qed.
- Lemma MapPut1_semantics_3 : (p:positive) (a,a',a0:ad) (y,y':A)
- (ad_xor a a')=(ad_x p) -> (ad_eq a a0)=false -> (ad_eq a' a0)=false ->
- (MapGet (MapPut1 a y a' y' p) a0)=NONE.
- Proof.
- Induction p. Intros. Unfold MapPut1. Elim (ad_neq a a0 H1). Intro. Rewrite H3. Rewrite if_negb.
- Rewrite MapGet_M2_bit_0_2. Apply M1_semantics_2. Apply ad_div_bit_neq. Assumption.
- Rewrite (ad_neg_bit_0_2 a a' p0 H0) in H3. Rewrite (negb_intro (ad_bit_0 a')).
- Rewrite (negb_intro (ad_bit_0 a0)). Rewrite H3. Reflexivity.
- Intro. Elim (ad_neq a' a0 H2). Intro. Rewrite (ad_neg_bit_0_2 a a' p0 H0). Rewrite H4.
- Rewrite (negb_elim (ad_bit_0 a0)). Rewrite MapGet_M2_bit_0_2.
- Apply M1_semantics_2; Assumption.
- Intro; Case (ad_bit_0 a); Apply MapGet_M2_both_NONE;
- Apply M1_semantics_2; Assumption.
- Intros. Simpl. Elim (ad_neq a a0 H1). Intro. Rewrite H3. Rewrite if_negb.
- Rewrite MapGet_M2_bit_0_2. Reflexivity.
- Intro. Elim (ad_neq a' a0 H2). Intro. Rewrite (ad_same_bit_0 a a' p0 H0). Rewrite H4.
- Rewrite if_negb. Rewrite MapGet_M2_bit_0_2. Reflexivity.
- Intro. Cut (ad_xor (ad_div_2 a) (ad_div_2 a'))=(ad_x p0). Intro.
- Case (ad_bit_0 a); Apply MapGet_M2_both_NONE; Trivial;
- Apply H; Assumption.
- Rewrite <- ad_xor_div_2. Rewrite H0. Reflexivity.
- Intros. Simpl. Elim (ad_neq a a0 H0). Intro. Rewrite H2. Rewrite if_negb.
- Rewrite MapGet_M2_bit_0_2. Apply M1_semantics_2. Apply ad_div_bit_neq. Assumption.
- Rewrite (ad_neg_bit_0_1 a a' H) in H2. Rewrite (negb_intro (ad_bit_0 a')).
- Rewrite (negb_intro (ad_bit_0 a0)). Rewrite H2. Reflexivity.
- Intro. Elim (ad_neq a' a0 H1). Intro. Rewrite (ad_neg_bit_0_1 a a' H). Rewrite H3.
- Rewrite (negb_elim (ad_bit_0 a0)). Rewrite MapGet_M2_bit_0_2.
- Apply M1_semantics_2; Assumption.
- Intro. Case (ad_bit_0 a); Apply MapGet_M2_both_NONE; Apply M1_semantics_2; Assumption.
- Qed.
-
- Lemma MapPut1_semantics : (p:positive) (a,a':ad) (y,y':A)
- (ad_xor a a')=(ad_x p)
- -> (eqm (MapGet (MapPut1 a y a' y' p))
- [a0:ad] if (ad_eq a a0) then (SOME y)
- else if (ad_eq a' a0) then (SOME y') else NONE).
- Proof.
- Unfold eqm. Intros. Elim (sumbool_of_bool (ad_eq a a0)). Intro H0. Rewrite H0.
- Rewrite <- (ad_eq_complete ? ? H0). Exact (MapPut1_semantics_1 p a a' y y' H).
- Intro H0. Rewrite H0. Elim (sumbool_of_bool (ad_eq a' a0)). Intro H1.
- Rewrite <- (ad_eq_complete ? ? H1). Rewrite (ad_eq_correct a').
- Exact (MapPut1_semantics_2 p a a' y y' H).
- Intro H1. Rewrite H1. Exact (MapPut1_semantics_3 p a a' a0 y y' H H0 H1).
- Qed.
-
- Lemma MapPut1_semantics' : (p:positive) (a,a':ad) (y,y':A)
- (ad_xor a a')=(ad_x p)
- -> (eqm (MapGet (MapPut1 a y a' y' p))
- [a0:ad] if (ad_eq a' a0) then (SOME y')
- else if (ad_eq a a0) then (SOME y) else NONE).
- Proof.
- Unfold eqm. Intros. Rewrite (MapPut1_semantics p a a' y y' H a0).
- Elim (sumbool_of_bool (ad_eq a a0)). Intro H0. Rewrite H0.
- Rewrite <- (ad_eq_complete a a0 H0). Rewrite (ad_eq_comm a' a).
- Rewrite (ad_xor_eq_false a a' p H). Reflexivity.
- Intro H0. Rewrite H0. Reflexivity.
- Qed.
-
- Fixpoint MapPut [m:Map] : ad -> A -> Map :=
- Cases m of
- M0 => M1
- | (M1 a y) => [a':ad; y':A]
- Cases (ad_xor a a') of
- ad_z => (M1 a' y')
- | (ad_x p) => (MapPut1 a y a' y' p)
+ Lemma MapPut1_semantics_3 :
+ forall (p:positive) (a a' a0:ad) (y y':A),
+ ad_xor a a' = ad_x p ->
+ ad_eq a a0 = false ->
+ ad_eq a' a0 = false -> MapGet (MapPut1 a y a' y' p) a0 = NONE.
+ Proof.
+ simple induction p. intros. unfold MapPut1 in |- *. elim (ad_neq a a0 H1). intro. rewrite H3. rewrite if_negb.
+ rewrite MapGet_M2_bit_0_2. apply M1_semantics_2. apply ad_div_bit_neq. assumption.
+ rewrite (ad_neg_bit_0_2 a a' p0 H0) in H3. rewrite (negb_intro (ad_bit_0 a')).
+ rewrite (negb_intro (ad_bit_0 a0)). rewrite H3. reflexivity.
+ intro. elim (ad_neq a' a0 H2). intro. rewrite (ad_neg_bit_0_2 a a' p0 H0). rewrite H4.
+ rewrite (negb_elim (ad_bit_0 a0)). rewrite MapGet_M2_bit_0_2.
+ apply M1_semantics_2; assumption.
+ intro; case (ad_bit_0 a); apply MapGet_M2_both_NONE; apply M1_semantics_2;
+ assumption.
+ intros. simpl in |- *. elim (ad_neq a a0 H1). intro. rewrite H3. rewrite if_negb.
+ rewrite MapGet_M2_bit_0_2. reflexivity.
+ intro. elim (ad_neq a' a0 H2). intro. rewrite (ad_same_bit_0 a a' p0 H0). rewrite H4.
+ rewrite if_negb. rewrite MapGet_M2_bit_0_2. reflexivity.
+ intro. cut (ad_xor (ad_div_2 a) (ad_div_2 a') = ad_x p0). intro.
+ case (ad_bit_0 a); apply MapGet_M2_both_NONE; trivial; apply H;
+ assumption.
+ rewrite <- ad_xor_div_2. rewrite H0. reflexivity.
+ intros. simpl in |- *. elim (ad_neq a a0 H0). intro. rewrite H2. rewrite if_negb.
+ rewrite MapGet_M2_bit_0_2. apply M1_semantics_2. apply ad_div_bit_neq. assumption.
+ rewrite (ad_neg_bit_0_1 a a' H) in H2. rewrite (negb_intro (ad_bit_0 a')).
+ rewrite (negb_intro (ad_bit_0 a0)). rewrite H2. reflexivity.
+ intro. elim (ad_neq a' a0 H1). intro. rewrite (ad_neg_bit_0_1 a a' H). rewrite H3.
+ rewrite (negb_elim (ad_bit_0 a0)). rewrite MapGet_M2_bit_0_2.
+ apply M1_semantics_2; assumption.
+ intro. case (ad_bit_0 a); apply MapGet_M2_both_NONE; apply M1_semantics_2;
+ assumption.
+ Qed.
+
+ Lemma MapPut1_semantics :
+ forall (p:positive) (a a':ad) (y y':A),
+ ad_xor a a' = ad_x p ->
+ eqm (MapGet (MapPut1 a y a' y' p))
+ (fun a0:ad =>
+ if ad_eq a a0
+ then SOME y
+ else if ad_eq a' a0 then SOME y' else NONE).
+ Proof.
+ unfold eqm in |- *. intros. elim (sumbool_of_bool (ad_eq a a0)). intro H0. rewrite H0.
+ rewrite <- (ad_eq_complete _ _ H0). exact (MapPut1_semantics_1 p a a' y y' H).
+ intro H0. rewrite H0. elim (sumbool_of_bool (ad_eq a' a0)). intro H1.
+ rewrite <- (ad_eq_complete _ _ H1). rewrite (ad_eq_correct a').
+ exact (MapPut1_semantics_2 p a a' y y' H).
+ intro H1. rewrite H1. exact (MapPut1_semantics_3 p a a' a0 y y' H H0 H1).
+ Qed.
+
+ Lemma MapPut1_semantics' :
+ forall (p:positive) (a a':ad) (y y':A),
+ ad_xor a a' = ad_x p ->
+ eqm (MapGet (MapPut1 a y a' y' p))
+ (fun a0:ad =>
+ if ad_eq a' a0
+ then SOME y'
+ else if ad_eq a a0 then SOME y else NONE).
+ Proof.
+ unfold eqm in |- *. intros. rewrite (MapPut1_semantics p a a' y y' H a0).
+ elim (sumbool_of_bool (ad_eq a a0)). intro H0. rewrite H0.
+ rewrite <- (ad_eq_complete a a0 H0). rewrite (ad_eq_comm a' a).
+ rewrite (ad_xor_eq_false a a' p H). reflexivity.
+ intro H0. rewrite H0. reflexivity.
+ Qed.
+
+ Fixpoint MapPut (m:Map) : ad -> A -> Map :=
+ match m with
+ | M0 => M1
+ | M1 a y =>
+ fun (a':ad) (y':A) =>
+ match ad_xor a a' with
+ | ad_z => M1 a' y'
+ | ad_x p => MapPut1 a y a' y' p
+ end
+ | M2 m1 m2 =>
+ fun (a:ad) (y:A) =>
+ match a with
+ | ad_z => M2 (MapPut m1 ad_z y) m2
+ | ad_x xH => M2 m1 (MapPut m2 ad_z y)
+ | ad_x (xO p) => M2 (MapPut m1 (ad_x p) y) m2
+ | ad_x (xI p) => M2 m1 (MapPut m2 (ad_x p) y)
end
- | (M2 m1 m2) => [a:ad; y:A]
- Cases a of
- ad_z => (M2 (MapPut m1 ad_z y) m2)
- | (ad_x xH) => (M2 m1 (MapPut m2 ad_z y))
- | (ad_x (xO p)) => (M2 (MapPut m1 (ad_x p) y) m2)
- | (ad_x (xI p)) => (M2 m1 (MapPut m2 (ad_x p) y))
- end
end.
- Lemma MapPut_semantics_1 : (a:ad) (y:A) (a0:ad)
- (MapGet (MapPut M0 a y) a0)=(MapGet (M1 a y) a0).
- Proof.
- Trivial.
- Qed.
-
- Lemma MapPut_semantics_2_1 : (a:ad) (y,y':A) (a0:ad)
- (MapGet (MapPut (M1 a y) a y') a0)=(if (ad_eq a a0) then (SOME y') else NONE).
- Proof.
- Simpl. Intros. Rewrite (ad_xor_nilpotent a). Trivial.
- Qed.
-
- Lemma MapPut_semantics_2_2 : (a,a':ad) (y,y':A) (a0:ad) (a'':ad) (ad_xor a a')=a'' ->
- (MapGet (MapPut (M1 a y) a' y') a0)=
- (if (ad_eq a' a0) then (SOME y') else
- if (ad_eq a a0) then (SOME y) else NONE).
- Proof.
- Induction a''. Intro. Rewrite (ad_xor_eq ? ? H). Rewrite MapPut_semantics_2_1.
- Case (ad_eq a' a0); Trivial.
- Intros. Simpl. Rewrite H. Rewrite (MapPut1_semantics p a a' y y' H a0).
- Elim (sumbool_of_bool (ad_eq a a0)). Intro H0. Rewrite H0. Rewrite <- (ad_eq_complete ? ? H0).
- Rewrite (ad_eq_comm a' a). Rewrite (ad_xor_eq_false ? ? ? H). Reflexivity.
- Intro H0. Rewrite H0. Reflexivity.
- Qed.
-
- Lemma MapPut_semantics_2 : (a,a':ad) (y,y':A) (a0:ad)
- (MapGet (MapPut (M1 a y) a' y') a0)=
- (if (ad_eq a' a0) then (SOME y') else
- if (ad_eq a a0) then (SOME y) else NONE).
- Proof.
- Intros. Apply MapPut_semantics_2_2 with a'':=(ad_xor a a'); Trivial.
- Qed.
-
- Lemma MapPut_semantics_3_1 : (m,m':Map) (a:ad) (y:A)
- (MapPut (M2 m m') a y)=(if (ad_bit_0 a) then (M2 m (MapPut m' (ad_div_2 a) y))
- else (M2 (MapPut m (ad_div_2 a) y) m')).
- Proof.
- Induction a. Trivial.
- Induction p; Trivial.
- Qed.
-
- Lemma MapPut_semantics : (m:Map) (a:ad) (y:A)
- (eqm (MapGet (MapPut m a y)) [a':ad] if (ad_eq a a') then (SOME y) else (MapGet m a')).
- Proof.
- Unfold eqm. Induction m. Exact MapPut_semantics_1.
- Intros. Unfold 2 MapGet. Apply MapPut_semantics_2; Assumption.
- Intros. Rewrite MapPut_semantics_3_1. Rewrite (MapGet_M2_bit_0_if m0 m1 a0).
- Elim (sumbool_of_bool (ad_bit_0 a)). Intro H1. Rewrite H1. Rewrite MapGet_M2_bit_0_if.
- Elim (sumbool_of_bool (ad_bit_0 a0)). Intro H2. Rewrite H2.
- Rewrite (H0 (ad_div_2 a) y (ad_div_2 a0)). Elim (sumbool_of_bool (ad_eq a a0)).
- Intro H3. Rewrite H3. Rewrite (ad_div_eq ? ? H3). Reflexivity.
- Intro H3. Rewrite H3. Rewrite <- H2 in H1. Rewrite (ad_div_bit_neq ? ? H3 H1). Reflexivity.
- Intro H2. Rewrite H2. Rewrite (ad_eq_comm a a0). Rewrite (ad_bit_0_neq a0 a H2 H1).
- Reflexivity.
- Intro H1. Rewrite H1. Rewrite MapGet_M2_bit_0_if. Elim (sumbool_of_bool (ad_bit_0 a0)).
- Intro H2. Rewrite H2. Rewrite (ad_bit_0_neq a a0 H1 H2). Reflexivity.
- Intro H2. Rewrite H2. Rewrite (H (ad_div_2 a) y (ad_div_2 a0)).
- Elim (sumbool_of_bool (ad_eq a a0)). Intro H3. Rewrite H3.
- Rewrite (ad_div_eq a a0 H3). Reflexivity.
- Intro H3. Rewrite H3. Rewrite <- H2 in H1. Rewrite (ad_div_bit_neq a a0 H3 H1). Reflexivity.
- Qed.
-
- Fixpoint MapPut_behind [m:Map] : ad -> A -> Map :=
- Cases m of
- M0 => M1
- | (M1 a y) => [a':ad; y':A]
- Cases (ad_xor a a') of
- ad_z => m
- | (ad_x p) => (MapPut1 a y a' y' p)
+ Lemma MapPut_semantics_1 :
+ forall (a:ad) (y:A) (a0:ad),
+ MapGet (MapPut M0 a y) a0 = MapGet (M1 a y) a0.
+ Proof.
+ trivial.
+ Qed.
+
+ Lemma MapPut_semantics_2_1 :
+ forall (a:ad) (y y':A) (a0:ad),
+ MapGet (MapPut (M1 a y) a y') a0 =
+ (if ad_eq a a0 then SOME y' else NONE).
+ Proof.
+ simpl in |- *. intros. rewrite (ad_xor_nilpotent a). trivial.
+ Qed.
+
+ Lemma MapPut_semantics_2_2 :
+ forall (a a':ad) (y y':A) (a0 a'':ad),
+ ad_xor a a' = a'' ->
+ MapGet (MapPut (M1 a y) a' y') a0 =
+ (if ad_eq a' a0 then SOME y' else if ad_eq a a0 then SOME y else NONE).
+ Proof.
+ simple induction a''. intro. rewrite (ad_xor_eq _ _ H). rewrite MapPut_semantics_2_1.
+ case (ad_eq a' a0); trivial.
+ intros. simpl in |- *. rewrite H. rewrite (MapPut1_semantics p a a' y y' H a0).
+ elim (sumbool_of_bool (ad_eq a a0)). intro H0. rewrite H0. rewrite <- (ad_eq_complete _ _ H0).
+ rewrite (ad_eq_comm a' a). rewrite (ad_xor_eq_false _ _ _ H). reflexivity.
+ intro H0. rewrite H0. reflexivity.
+ Qed.
+
+ Lemma MapPut_semantics_2 :
+ forall (a a':ad) (y y':A) (a0:ad),
+ MapGet (MapPut (M1 a y) a' y') a0 =
+ (if ad_eq a' a0 then SOME y' else if ad_eq a a0 then SOME y else NONE).
+ Proof.
+ intros. apply MapPut_semantics_2_2 with (a'' := ad_xor a a'); trivial.
+ Qed.
+
+ Lemma MapPut_semantics_3_1 :
+ forall (m m':Map) (a:ad) (y:A),
+ MapPut (M2 m m') a y =
+ (if ad_bit_0 a
+ then M2 m (MapPut m' (ad_div_2 a) y)
+ else M2 (MapPut m (ad_div_2 a) y) m').
+ Proof.
+ simple induction a. trivial.
+ simple induction p; trivial.
+ Qed.
+
+ Lemma MapPut_semantics :
+ forall (m:Map) (a:ad) (y:A),
+ eqm (MapGet (MapPut m a y))
+ (fun a':ad => if ad_eq a a' then SOME y else MapGet m a').
+ Proof.
+ unfold eqm in |- *. simple induction m. exact MapPut_semantics_1.
+ intros. unfold MapGet at 2 in |- *. apply MapPut_semantics_2; assumption.
+ intros. rewrite MapPut_semantics_3_1. rewrite (MapGet_M2_bit_0_if m0 m1 a0).
+ elim (sumbool_of_bool (ad_bit_0 a)). intro H1. rewrite H1. rewrite MapGet_M2_bit_0_if.
+ elim (sumbool_of_bool (ad_bit_0 a0)). intro H2. rewrite H2.
+ rewrite (H0 (ad_div_2 a) y (ad_div_2 a0)). elim (sumbool_of_bool (ad_eq a a0)).
+ intro H3. rewrite H3. rewrite (ad_div_eq _ _ H3). reflexivity.
+ intro H3. rewrite H3. rewrite <- H2 in H1. rewrite (ad_div_bit_neq _ _ H3 H1). reflexivity.
+ intro H2. rewrite H2. rewrite (ad_eq_comm a a0). rewrite (ad_bit_0_neq a0 a H2 H1).
+ reflexivity.
+ intro H1. rewrite H1. rewrite MapGet_M2_bit_0_if. elim (sumbool_of_bool (ad_bit_0 a0)).
+ intro H2. rewrite H2. rewrite (ad_bit_0_neq a a0 H1 H2). reflexivity.
+ intro H2. rewrite H2. rewrite (H (ad_div_2 a) y (ad_div_2 a0)).
+ elim (sumbool_of_bool (ad_eq a a0)). intro H3. rewrite H3.
+ rewrite (ad_div_eq a a0 H3). reflexivity.
+ intro H3. rewrite H3. rewrite <- H2 in H1. rewrite (ad_div_bit_neq a a0 H3 H1). reflexivity.
+ Qed.
+
+ Fixpoint MapPut_behind (m:Map) : ad -> A -> Map :=
+ match m with
+ | M0 => M1
+ | M1 a y =>
+ fun (a':ad) (y':A) =>
+ match ad_xor a a' with
+ | ad_z => m
+ | ad_x p => MapPut1 a y a' y' p
+ end
+ | M2 m1 m2 =>
+ fun (a:ad) (y:A) =>
+ match a with
+ | ad_z => M2 (MapPut_behind m1 ad_z y) m2
+ | ad_x xH => M2 m1 (MapPut_behind m2 ad_z y)
+ | ad_x (xO p) => M2 (MapPut_behind m1 (ad_x p) y) m2
+ | ad_x (xI p) => M2 m1 (MapPut_behind m2 (ad_x p) y)
end
- | (M2 m1 m2) => [a:ad; y:A]
- Cases a of
- ad_z => (M2 (MapPut_behind m1 ad_z y) m2)
- | (ad_x xH) => (M2 m1 (MapPut_behind m2 ad_z y))
- | (ad_x (xO p)) => (M2 (MapPut_behind m1 (ad_x p) y) m2)
- | (ad_x (xI p)) => (M2 m1 (MapPut_behind m2 (ad_x p) y))
- end
end.
- Lemma MapPut_behind_semantics_3_1 : (m,m':Map) (a:ad) (y:A)
- (MapPut_behind (M2 m m') a y)=
- (if (ad_bit_0 a) then (M2 m (MapPut_behind m' (ad_div_2 a) y))
- else (M2 (MapPut_behind m (ad_div_2 a) y) m')).
- Proof.
- Induction a. Trivial.
- Induction p; Trivial.
- Qed.
-
- Lemma MapPut_behind_as_before_1 : (a,a',a0:ad) (ad_eq a' a0)=false ->
- (y,y':A) (MapGet (MapPut (M1 a y) a' y') a0)
- =(MapGet (MapPut_behind (M1 a y) a' y') a0).
- Proof.
- Intros a a' a0. Simpl. Intros H y y'. Elim (ad_sum (ad_xor a a')). Intro H0. Elim H0.
- Intros p H1. Rewrite H1. Reflexivity.
- Intro H0. Rewrite H0. Rewrite (ad_xor_eq ? ? H0). Rewrite (M1_semantics_2 a' a0 y H).
- Exact (M1_semantics_2 a' a0 y' H).
- Qed.
-
- Lemma MapPut_behind_as_before : (m:Map) (a:ad) (y:A)
- (a0:ad) (ad_eq a a0)=false ->
- (MapGet (MapPut m a y) a0)=(MapGet (MapPut_behind m a y) a0).
- Proof.
- Induction m. Trivial.
- Intros a y a' y' a0 H. Exact (MapPut_behind_as_before_1 a a' a0 H y y').
- Intros. Rewrite MapPut_semantics_3_1. Rewrite MapPut_behind_semantics_3_1.
- Elim (sumbool_of_bool (ad_bit_0 a)). Intro H2. Rewrite H2. Rewrite MapGet_M2_bit_0_if.
- Rewrite MapGet_M2_bit_0_if. Elim (sumbool_of_bool (ad_bit_0 a0)). Intro H3.
- Rewrite H3. Apply H0. Rewrite <- H3 in H2. Exact (ad_div_bit_neq a a0 H1 H2).
- Intro H3. Rewrite H3. Reflexivity.
- Intro H2. Rewrite H2. Rewrite MapGet_M2_bit_0_if. Rewrite MapGet_M2_bit_0_if.
- Elim (sumbool_of_bool (ad_bit_0 a0)). Intro H3. Rewrite H3. Reflexivity.
- Intro H3. Rewrite H3. Apply H. Rewrite <- H3 in H2. Exact (ad_div_bit_neq a a0 H1 H2).
- Qed.
-
- Lemma MapPut_behind_new : (m:Map) (a:ad) (y:A)
- (MapGet (MapPut_behind m a y) a)=(Cases (MapGet m a) of
- (SOME y') => (SOME y')
- | _ => (SOME y)
- end).
- Proof.
- Induction m. Simpl. Intros. Rewrite (ad_eq_correct a). Reflexivity.
- Intros. Elim (ad_sum (ad_xor a a1)). Intro H. Elim H. Intros p H0. Simpl.
- Rewrite H0. Rewrite (ad_xor_eq_false a a1 p). Exact (MapPut1_semantics_2 p a a1 a0 y H0).
- Assumption.
- Intro H. Simpl. Rewrite H. Rewrite <- (ad_xor_eq ? ? H). Rewrite (ad_eq_correct a).
- Exact (M1_semantics_1 a a0).
- Intros. Rewrite MapPut_behind_semantics_3_1. Rewrite (MapGet_M2_bit_0_if m0 m1 a).
- Elim (sumbool_of_bool (ad_bit_0 a)). Intro H1. Rewrite H1. Rewrite (MapGet_M2_bit_0_1 a H1).
- Exact (H0 (ad_div_2 a) y).
- Intro H1. Rewrite H1. Rewrite (MapGet_M2_bit_0_0 a H1). Exact (H (ad_div_2 a) y).
- Qed.
-
- Lemma MapPut_behind_semantics : (m:Map) (a:ad) (y:A)
- (eqm (MapGet (MapPut_behind m a y))
- [a':ad] Cases (MapGet m a') of
- (SOME y') => (SOME y')
- | _ => if (ad_eq a a') then (SOME y) else NONE
- end).
- Proof.
- Unfold eqm. Intros. Elim (sumbool_of_bool (ad_eq a a0)). Intro H. Rewrite H.
- Rewrite (ad_eq_complete ? ? H). Apply MapPut_behind_new.
- Intro H. Rewrite H. Rewrite <- (MapPut_behind_as_before m a y a0 H).
- Rewrite (MapPut_semantics m a y a0). Rewrite H. Case (MapGet m a0); Trivial.
- Qed.
-
- Definition makeM2 := [m,m':Map] Cases m m' of
- M0 M0 => M0
- | M0 (M1 a y) => (M1 (ad_double_plus_un a) y)
- | (M1 a y) M0 => (M1 (ad_double a) y)
- | _ _ => (M2 m m')
- end.
-
- Lemma makeM2_M2 : (m,m':Map) (eqm (MapGet (makeM2 m m')) (MapGet (M2 m m'))).
- Proof.
- Unfold eqm. Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H.
- Rewrite (MapGet_M2_bit_0_1 a H m m'). Case m'. Case m. Reflexivity.
- Intros a0 y. Simpl. Rewrite (ad_bit_0_1_not_double a H a0). Reflexivity.
- Intros m1 m2. Unfold makeM2. Rewrite MapGet_M2_bit_0_1. Reflexivity.
- Assumption.
- Case m. Intros a0 y. Simpl. Elim (sumbool_of_bool (ad_eq a0 (ad_div_2 a))).
- Intro H0. Rewrite H0. Rewrite (ad_eq_complete ? ? H0). Rewrite (ad_div_2_double_plus_un a H).
- Rewrite (ad_eq_correct a). Reflexivity.
- Intro H0. Rewrite H0. Rewrite (ad_eq_comm a0 (ad_div_2 a)) in H0.
- Rewrite (ad_not_div_2_not_double_plus_un a a0 H0). Reflexivity.
- Intros a0 y0 a1 y1. Unfold makeM2. Rewrite MapGet_M2_bit_0_1. Reflexivity.
- Assumption.
- Intros m1 m2 a0 y. Unfold makeM2. Rewrite MapGet_M2_bit_0_1. Reflexivity.
- Assumption.
- Intros m1 m2. Unfold makeM2.
- Cut (MapGet (M2 m (M2 m1 m2)) a)=(MapGet (M2 m1 m2) (ad_div_2 a)).
- Case m; Trivial.
- Exact (MapGet_M2_bit_0_1 a H m (M2 m1 m2)).
- Intro H. Rewrite (MapGet_M2_bit_0_0 a H m m'). Case m. Case m'. Reflexivity.
- Intros a0 y. Simpl. Rewrite (ad_bit_0_0_not_double_plus_un a H a0). Reflexivity.
- Intros m1 m2. Unfold makeM2. Rewrite MapGet_M2_bit_0_0. Reflexivity.
- Assumption.
- Case m'. Intros a0 y. Simpl. Elim (sumbool_of_bool (ad_eq a0 (ad_div_2 a))). Intro H0.
- Rewrite H0. Rewrite (ad_eq_complete ? ? H0). Rewrite (ad_div_2_double a H).
- Rewrite (ad_eq_correct a). Reflexivity.
- Intro H0. Rewrite H0. Rewrite (ad_eq_comm (ad_double a0) a).
- Rewrite (ad_eq_comm a0 (ad_div_2 a)) in H0. Rewrite (ad_not_div_2_not_double a a0 H0).
- Reflexivity.
- Intros a0 y0 a1 y1. Unfold makeM2. Rewrite MapGet_M2_bit_0_0. Reflexivity.
- Assumption.
- Intros m1 m2 a0 y. Unfold makeM2. Rewrite MapGet_M2_bit_0_0. Reflexivity.
- Assumption.
- Intros m1 m2. Unfold makeM2. Exact (MapGet_M2_bit_0_0 a H (M2 m1 m2) m').
- Qed.
-
- Fixpoint MapRemove [m:Map] : ad -> Map :=
- Cases m of
- M0 => [_:ad] M0
- | (M1 a y) => [a':ad]
- Cases (ad_eq a a') of
- true => M0
- | false => m
- end
- | (M2 m1 m2) => [a:ad]
- if (ad_bit_0 a)
- then (makeM2 m1 (MapRemove m2 (ad_div_2 a)))
- else (makeM2 (MapRemove m1 (ad_div_2 a)) m2)
+ Lemma MapPut_behind_semantics_3_1 :
+ forall (m m':Map) (a:ad) (y:A),
+ MapPut_behind (M2 m m') a y =
+ (if ad_bit_0 a
+ then M2 m (MapPut_behind m' (ad_div_2 a) y)
+ else M2 (MapPut_behind m (ad_div_2 a) y) m').
+ Proof.
+ simple induction a. trivial.
+ simple induction p; trivial.
+ Qed.
+
+ Lemma MapPut_behind_as_before_1 :
+ forall a a' a0:ad,
+ ad_eq a' a0 = false ->
+ forall y y':A,
+ MapGet (MapPut (M1 a y) a' y') a0 =
+ MapGet (MapPut_behind (M1 a y) a' y') a0.
+ Proof.
+ intros a a' a0. simpl in |- *. intros H y y'. elim (ad_sum (ad_xor a a')). intro H0. elim H0.
+ intros p H1. rewrite H1. reflexivity.
+ intro H0. rewrite H0. rewrite (ad_xor_eq _ _ H0). rewrite (M1_semantics_2 a' a0 y H).
+ exact (M1_semantics_2 a' a0 y' H).
+ Qed.
+
+ Lemma MapPut_behind_as_before :
+ forall (m:Map) (a:ad) (y:A) (a0:ad),
+ ad_eq a a0 = false ->
+ MapGet (MapPut m a y) a0 = MapGet (MapPut_behind m a y) a0.
+ Proof.
+ simple induction m. trivial.
+ intros a y a' y' a0 H. exact (MapPut_behind_as_before_1 a a' a0 H y y').
+ intros. rewrite MapPut_semantics_3_1. rewrite MapPut_behind_semantics_3_1.
+ elim (sumbool_of_bool (ad_bit_0 a)). intro H2. rewrite H2. rewrite MapGet_M2_bit_0_if.
+ rewrite MapGet_M2_bit_0_if. elim (sumbool_of_bool (ad_bit_0 a0)). intro H3.
+ rewrite H3. apply H0. rewrite <- H3 in H2. exact (ad_div_bit_neq a a0 H1 H2).
+ intro H3. rewrite H3. reflexivity.
+ intro H2. rewrite H2. rewrite MapGet_M2_bit_0_if. rewrite MapGet_M2_bit_0_if.
+ elim (sumbool_of_bool (ad_bit_0 a0)). intro H3. rewrite H3. reflexivity.
+ intro H3. rewrite H3. apply H. rewrite <- H3 in H2. exact (ad_div_bit_neq a a0 H1 H2).
+ Qed.
+
+ Lemma MapPut_behind_new :
+ forall (m:Map) (a:ad) (y:A),
+ MapGet (MapPut_behind m a y) a =
+ match MapGet m a with
+ | SOME y' => SOME y'
+ | _ => SOME y
+ end.
+ Proof.
+ simple induction m. simpl in |- *. intros. rewrite (ad_eq_correct a). reflexivity.
+ intros. elim (ad_sum (ad_xor a a1)). intro H. elim H. intros p H0. simpl in |- *.
+ rewrite H0. rewrite (ad_xor_eq_false a a1 p). exact (MapPut1_semantics_2 p a a1 a0 y H0).
+ assumption.
+ intro H. simpl in |- *. rewrite H. rewrite <- (ad_xor_eq _ _ H). rewrite (ad_eq_correct a).
+ exact (M1_semantics_1 a a0).
+ intros. rewrite MapPut_behind_semantics_3_1. rewrite (MapGet_M2_bit_0_if m0 m1 a).
+ elim (sumbool_of_bool (ad_bit_0 a)). intro H1. rewrite H1. rewrite (MapGet_M2_bit_0_1 a H1).
+ exact (H0 (ad_div_2 a) y).
+ intro H1. rewrite H1. rewrite (MapGet_M2_bit_0_0 a H1). exact (H (ad_div_2 a) y).
+ Qed.
+
+ Lemma MapPut_behind_semantics :
+ forall (m:Map) (a:ad) (y:A),
+ eqm (MapGet (MapPut_behind m a y))
+ (fun a':ad =>
+ match MapGet m a' with
+ | SOME y' => SOME y'
+ | _ => if ad_eq a a' then SOME y else NONE
+ end).
+ Proof.
+ unfold eqm in |- *. intros. elim (sumbool_of_bool (ad_eq a a0)). intro H. rewrite H.
+ rewrite (ad_eq_complete _ _ H). apply MapPut_behind_new.
+ intro H. rewrite H. rewrite <- (MapPut_behind_as_before m a y a0 H).
+ rewrite (MapPut_semantics m a y a0). rewrite H. case (MapGet m a0); trivial.
+ Qed.
+
+ Definition makeM2 (m m':Map) :=
+ match m, m' with
+ | M0, M0 => M0
+ | M0, M1 a y => M1 (ad_double_plus_un a) y
+ | M1 a y, M0 => M1 (ad_double a) y
+ | _, _ => M2 m m'
end.
- Lemma MapRemove_semantics : (m:Map) (a:ad)
- (eqm (MapGet (MapRemove m a)) [a':ad] if (ad_eq a a') then NONE else (MapGet m a')).
- Proof.
- Unfold eqm. Induction m. Simpl. Intros. Case (ad_eq a a0); Trivial.
- Intros. Simpl. Elim (sumbool_of_bool (ad_eq a1 a2)). Intro H. Rewrite H.
- Elim (sumbool_of_bool (ad_eq a a1)). Intro H0. Rewrite H0. Reflexivity.
- Intro H0. Rewrite H0. Rewrite (ad_eq_complete ? ? H) in H0. Exact (M1_semantics_2 a a2 a0 H0).
- Intro H. Elim (sumbool_of_bool (ad_eq a a1)). Intro H0. Rewrite H0. Rewrite H.
- Rewrite <- (ad_eq_complete ? ? H0) in H. Rewrite H. Reflexivity.
- Intro H0. Rewrite H0. Rewrite H. Reflexivity.
- Intros. Change (MapGet (if (ad_bit_0 a)
- then (makeM2 m0 (MapRemove m1 (ad_div_2 a)))
- else (makeM2 (MapRemove m0 (ad_div_2 a)) m1))
- a0)
- =(if (ad_eq a a0) then NONE else (MapGet (M2 m0 m1) a0)).
- Elim (sumbool_of_bool (ad_bit_0 a)). Intro H1. Rewrite H1.
- Rewrite (makeM2_M2 m0 (MapRemove m1 (ad_div_2 a)) a0). Elim (sumbool_of_bool (ad_bit_0 a0)).
- Intro H2. Rewrite MapGet_M2_bit_0_1. Rewrite (H0 (ad_div_2 a) (ad_div_2 a0)).
- Elim (sumbool_of_bool (ad_eq a a0)). Intro H3. Rewrite H3. Rewrite (ad_div_eq ? ? H3).
- Reflexivity.
- Intro H3. Rewrite H3. Rewrite <- H2 in H1. Rewrite (ad_div_bit_neq ? ? H3 H1).
- Rewrite (MapGet_M2_bit_0_1 a0 H2 m0 m1). Reflexivity.
- Assumption.
- Intro H2. Rewrite (MapGet_M2_bit_0_0 a0 H2 m0 (MapRemove m1 (ad_div_2 a))).
- Rewrite (ad_eq_comm a a0). Rewrite (ad_bit_0_neq ? ? H2 H1).
- Rewrite (MapGet_M2_bit_0_0 a0 H2 m0 m1). Reflexivity.
- Intro H1. Rewrite H1. Rewrite (makeM2_M2 (MapRemove m0 (ad_div_2 a)) m1 a0).
- Elim (sumbool_of_bool (ad_bit_0 a0)). Intro H2. Rewrite MapGet_M2_bit_0_1.
- Rewrite (MapGet_M2_bit_0_1 a0 H2 m0 m1). Rewrite (ad_bit_0_neq a a0 H1 H2). Reflexivity.
- Assumption.
- Intro H2. Rewrite MapGet_M2_bit_0_0. Rewrite (H (ad_div_2 a) (ad_div_2 a0)).
- Rewrite (MapGet_M2_bit_0_0 a0 H2 m0 m1). Elim (sumbool_of_bool (ad_eq a a0)). Intro H3.
- Rewrite H3. Rewrite (ad_div_eq ? ? H3). Reflexivity.
- Intro H3. Rewrite H3. Rewrite <- H2 in H1. Rewrite (ad_div_bit_neq ? ? H3 H1). Reflexivity.
- Assumption.
- Qed.
-
- Fixpoint MapCard [m:Map] : nat :=
- Cases m of
- M0 => O
- | (M1 _ _) => (S O)
- | (M2 m m') => (plus (MapCard m) (MapCard m'))
+ Lemma makeM2_M2 :
+ forall m m':Map, eqm (MapGet (makeM2 m m')) (MapGet (M2 m m')).
+ Proof.
+ unfold eqm in |- *. intros. elim (sumbool_of_bool (ad_bit_0 a)). intro H.
+ rewrite (MapGet_M2_bit_0_1 a H m m'). case m'. case m. reflexivity.
+ intros a0 y. simpl in |- *. rewrite (ad_bit_0_1_not_double a H a0). reflexivity.
+ intros m1 m2. unfold makeM2 in |- *. rewrite MapGet_M2_bit_0_1. reflexivity.
+ assumption.
+ case m. intros a0 y. simpl in |- *. elim (sumbool_of_bool (ad_eq a0 (ad_div_2 a))).
+ intro H0. rewrite H0. rewrite (ad_eq_complete _ _ H0). rewrite (ad_div_2_double_plus_un a H).
+ rewrite (ad_eq_correct a). reflexivity.
+ intro H0. rewrite H0. rewrite (ad_eq_comm a0 (ad_div_2 a)) in H0.
+ rewrite (ad_not_div_2_not_double_plus_un a a0 H0). reflexivity.
+ intros a0 y0 a1 y1. unfold makeM2 in |- *. rewrite MapGet_M2_bit_0_1. reflexivity.
+ assumption.
+ intros m1 m2 a0 y. unfold makeM2 in |- *. rewrite MapGet_M2_bit_0_1. reflexivity.
+ assumption.
+ intros m1 m2. unfold makeM2 in |- *.
+ cut (MapGet (M2 m (M2 m1 m2)) a = MapGet (M2 m1 m2) (ad_div_2 a)).
+ case m; trivial.
+ exact (MapGet_M2_bit_0_1 a H m (M2 m1 m2)).
+ intro H. rewrite (MapGet_M2_bit_0_0 a H m m'). case m. case m'. reflexivity.
+ intros a0 y. simpl in |- *. rewrite (ad_bit_0_0_not_double_plus_un a H a0). reflexivity.
+ intros m1 m2. unfold makeM2 in |- *. rewrite MapGet_M2_bit_0_0. reflexivity.
+ assumption.
+ case m'. intros a0 y. simpl in |- *. elim (sumbool_of_bool (ad_eq a0 (ad_div_2 a))). intro H0.
+ rewrite H0. rewrite (ad_eq_complete _ _ H0). rewrite (ad_div_2_double a H).
+ rewrite (ad_eq_correct a). reflexivity.
+ intro H0. rewrite H0. rewrite (ad_eq_comm (ad_double a0) a).
+ rewrite (ad_eq_comm a0 (ad_div_2 a)) in H0. rewrite (ad_not_div_2_not_double a a0 H0).
+ reflexivity.
+ intros a0 y0 a1 y1. unfold makeM2 in |- *. rewrite MapGet_M2_bit_0_0. reflexivity.
+ assumption.
+ intros m1 m2 a0 y. unfold makeM2 in |- *. rewrite MapGet_M2_bit_0_0. reflexivity.
+ assumption.
+ intros m1 m2. unfold makeM2 in |- *. exact (MapGet_M2_bit_0_0 a H (M2 m1 m2) m').
+ Qed.
+
+ Fixpoint MapRemove (m:Map) : ad -> Map :=
+ match m with
+ | M0 => fun _:ad => M0
+ | M1 a y =>
+ fun a':ad => match ad_eq a a' with
+ | true => M0
+ | false => m
+ end
+ | M2 m1 m2 =>
+ fun a:ad =>
+ if ad_bit_0 a
+ then makeM2 m1 (MapRemove m2 (ad_div_2 a))
+ else makeM2 (MapRemove m1 (ad_div_2 a)) m2
end.
- Fixpoint MapMerge [m:Map] : Map -> Map :=
- Cases m of
- M0 => [m':Map] m'
- | (M1 a y) => [m':Map] (MapPut_behind m' a y)
- | (M2 m1 m2) => [m':Map] Cases m' of
- M0 => m
- | (M1 a' y') => (MapPut m a' y')
- | (M2 m'1 m'2) => (M2 (MapMerge m1 m'1)
- (MapMerge m2 m'2))
- end
+ Lemma MapRemove_semantics :
+ forall (m:Map) (a:ad),
+ eqm (MapGet (MapRemove m a))
+ (fun a':ad => if ad_eq a a' then NONE else MapGet m a').
+ Proof.
+ unfold eqm in |- *. simple induction m. simpl in |- *. intros. case (ad_eq a a0); trivial.
+ intros. simpl in |- *. elim (sumbool_of_bool (ad_eq a1 a2)). intro H. rewrite H.
+ elim (sumbool_of_bool (ad_eq a a1)). intro H0. rewrite H0. reflexivity.
+ intro H0. rewrite H0. rewrite (ad_eq_complete _ _ H) in H0. exact (M1_semantics_2 a a2 a0 H0).
+ intro H. elim (sumbool_of_bool (ad_eq a a1)). intro H0. rewrite H0. rewrite H.
+ rewrite <- (ad_eq_complete _ _ H0) in H. rewrite H. reflexivity.
+ intro H0. rewrite H0. rewrite H. reflexivity.
+ intros. change
+ (MapGet
+ (if ad_bit_0 a
+ then makeM2 m0 (MapRemove m1 (ad_div_2 a))
+ else makeM2 (MapRemove m0 (ad_div_2 a)) m1) a0 =
+ (if ad_eq a a0 then NONE else MapGet (M2 m0 m1) a0))
+ in |- *.
+ elim (sumbool_of_bool (ad_bit_0 a)). intro H1. rewrite H1.
+ rewrite (makeM2_M2 m0 (MapRemove m1 (ad_div_2 a)) a0). elim (sumbool_of_bool (ad_bit_0 a0)).
+ intro H2. rewrite MapGet_M2_bit_0_1. rewrite (H0 (ad_div_2 a) (ad_div_2 a0)).
+ elim (sumbool_of_bool (ad_eq a a0)). intro H3. rewrite H3. rewrite (ad_div_eq _ _ H3).
+ reflexivity.
+ intro H3. rewrite H3. rewrite <- H2 in H1. rewrite (ad_div_bit_neq _ _ H3 H1).
+ rewrite (MapGet_M2_bit_0_1 a0 H2 m0 m1). reflexivity.
+ assumption.
+ intro H2. rewrite (MapGet_M2_bit_0_0 a0 H2 m0 (MapRemove m1 (ad_div_2 a))).
+ rewrite (ad_eq_comm a a0). rewrite (ad_bit_0_neq _ _ H2 H1).
+ rewrite (MapGet_M2_bit_0_0 a0 H2 m0 m1). reflexivity.
+ intro H1. rewrite H1. rewrite (makeM2_M2 (MapRemove m0 (ad_div_2 a)) m1 a0).
+ elim (sumbool_of_bool (ad_bit_0 a0)). intro H2. rewrite MapGet_M2_bit_0_1.
+ rewrite (MapGet_M2_bit_0_1 a0 H2 m0 m1). rewrite (ad_bit_0_neq a a0 H1 H2). reflexivity.
+ assumption.
+ intro H2. rewrite MapGet_M2_bit_0_0. rewrite (H (ad_div_2 a) (ad_div_2 a0)).
+ rewrite (MapGet_M2_bit_0_0 a0 H2 m0 m1). elim (sumbool_of_bool (ad_eq a a0)). intro H3.
+ rewrite H3. rewrite (ad_div_eq _ _ H3). reflexivity.
+ intro H3. rewrite H3. rewrite <- H2 in H1. rewrite (ad_div_bit_neq _ _ H3 H1). reflexivity.
+ assumption.
+ Qed.
+
+ Fixpoint MapCard (m:Map) : nat :=
+ match m with
+ | M0 => 0
+ | M1 _ _ => 1
+ | M2 m m' => MapCard m + MapCard m'
+ end.
+
+ Fixpoint MapMerge (m:Map) : Map -> Map :=
+ match m with
+ | M0 => fun m':Map => m'
+ | M1 a y => fun m':Map => MapPut_behind m' a y
+ | M2 m1 m2 =>
+ fun m':Map =>
+ match m' with
+ | M0 => m
+ | M1 a' y' => MapPut m a' y'
+ | M2 m'1 m'2 => M2 (MapMerge m1 m'1) (MapMerge m2 m'2)
+ end
end.
- Lemma MapMerge_semantics : (m,m':Map)
- (eqm (MapGet (MapMerge m m'))
- [a0:ad] Cases (MapGet m' a0) of
- (SOME y') => (SOME y')
- | NONE => (MapGet m a0)
- end).
- Proof.
- Unfold eqm. Induction m. Intros. Simpl. Case (MapGet m' a); Trivial.
- Intros. Simpl. Rewrite (MapPut_behind_semantics m' a a0 a1). Reflexivity.
- Induction m'. Trivial.
- Intros. Unfold MapMerge. Rewrite (MapPut_semantics (M2 m0 m1) a a0 a1).
- Elim (sumbool_of_bool (ad_eq a a1)). Intro H1. Rewrite H1. Rewrite (ad_eq_complete ? ? H1).
- Rewrite (M1_semantics_1 a1 a0). Reflexivity.
- Intro H1. Rewrite H1. Rewrite (M1_semantics_2 a a1 a0 H1). Reflexivity.
- Intros. Cut (MapMerge (M2 m0 m1) (M2 m2 m3))=(M2 (MapMerge m0 m2) (MapMerge m1 m3)).
- Intro. Rewrite H3. Rewrite MapGet_M2_bit_0_if. Rewrite (H0 m3 (ad_div_2 a)).
- Rewrite (H m2 (ad_div_2 a)). Rewrite (MapGet_M2_bit_0_if m2 m3 a).
- Rewrite (MapGet_M2_bit_0_if m0 m1 a). Case (ad_bit_0 a); Trivial.
- Reflexivity.
+ Lemma MapMerge_semantics :
+ forall m m':Map,
+ eqm (MapGet (MapMerge m m'))
+ (fun a0:ad =>
+ match MapGet m' a0 with
+ | SOME y' => SOME y'
+ | NONE => MapGet m a0
+ end).
+ Proof.
+ unfold eqm in |- *. simple induction m. intros. simpl in |- *. case (MapGet m' a); trivial.
+ intros. simpl in |- *. rewrite (MapPut_behind_semantics m' a a0 a1). reflexivity.
+ simple induction m'. trivial.
+ intros. unfold MapMerge in |- *. rewrite (MapPut_semantics (M2 m0 m1) a a0 a1).
+ elim (sumbool_of_bool (ad_eq a a1)). intro H1. rewrite H1. rewrite (ad_eq_complete _ _ H1).
+ rewrite (M1_semantics_1 a1 a0). reflexivity.
+ intro H1. rewrite H1. rewrite (M1_semantics_2 a a1 a0 H1). reflexivity.
+ intros. cut (MapMerge (M2 m0 m1) (M2 m2 m3) = M2 (MapMerge m0 m2) (MapMerge m1 m3)).
+ intro. rewrite H3. rewrite MapGet_M2_bit_0_if. rewrite (H0 m3 (ad_div_2 a)).
+ rewrite (H m2 (ad_div_2 a)). rewrite (MapGet_M2_bit_0_if m2 m3 a).
+ rewrite (MapGet_M2_bit_0_if m0 m1 a). case (ad_bit_0 a); trivial.
+ reflexivity.
Qed.
(** [MapInter], [MapRngRestrTo], [MapRngRestrBy], [MapInverse]
not implemented: need a decidable equality on [A]. *)
- Fixpoint MapDelta [m:Map] : Map -> Map :=
- Cases m of
- M0 => [m':Map] m'
- | (M1 a y) => [m':Map] Cases (MapGet m' a) of
- NONE => (MapPut m' a y)
- | _ => (MapRemove m' a)
- end
- | (M2 m1 m2) => [m':Map] Cases m' of
- M0 => m
- | (M1 a' y') => Cases (MapGet m a') of
- NONE => (MapPut m a' y')
- | _ => (MapRemove m a')
- end
- | (M2 m'1 m'2) => (makeM2 (MapDelta m1 m'1)
- (MapDelta m2 m'2))
- end
- end.
-
- Lemma MapDelta_semantics_comm : (m,m':Map)
- (eqm (MapGet (MapDelta m m')) (MapGet (MapDelta m' m))).
- Proof.
- Unfold eqm. Induction m. Induction m'; Reflexivity.
- Induction m'. Reflexivity.
- Unfold MapDelta. Intros. Elim (sumbool_of_bool (ad_eq a a1)). Intro H.
- Rewrite <- (ad_eq_complete ? ? H). Rewrite (M1_semantics_1 a a2).
- Rewrite (M1_semantics_1 a a0). Simpl. Rewrite (ad_eq_correct a). Reflexivity.
- Intro H. Rewrite (M1_semantics_2 a a1 a0 H). Rewrite (ad_eq_comm a a1) in H.
- Rewrite (M1_semantics_2 a1 a a2 H). Rewrite (MapPut_semantics (M1 a a0) a1 a2 a3).
- Rewrite (MapPut_semantics (M1 a1 a2) a a0 a3). Elim (sumbool_of_bool (ad_eq a a3)).
- Intro H0. Rewrite H0. Rewrite (ad_eq_complete ? ? H0) in H. Rewrite H.
- Rewrite (ad_eq_complete ? ? H0). Rewrite (M1_semantics_1 a3 a0). Reflexivity.
- Intro H0. Rewrite H0. Rewrite (M1_semantics_2 a a3 a0 H0).
- Elim (sumbool_of_bool (ad_eq a1 a3)). Intro H1. Rewrite H1.
- Rewrite (ad_eq_complete ? ? H1). Exact (M1_semantics_1 a3 a2).
- Intro H1. Rewrite H1. Exact (M1_semantics_2 a1 a3 a2 H1).
- Intros. Reflexivity.
- Induction m'. Reflexivity.
- Reflexivity.
- Intros. Simpl. Rewrite (makeM2_M2 (MapDelta m0 m2) (MapDelta m1 m3) a).
- Rewrite (makeM2_M2 (MapDelta m2 m0) (MapDelta m3 m1) a).
- Rewrite (MapGet_M2_bit_0_if (MapDelta m0 m2) (MapDelta m1 m3) a).
- Rewrite (MapGet_M2_bit_0_if (MapDelta m2 m0) (MapDelta m3 m1) a).
- Rewrite (H0 m3 (ad_div_2 a)). Rewrite (H m2 (ad_div_2 a)). Reflexivity.
- Qed.
-
- Lemma MapDelta_semantics_1_1 : (a:ad) (y:A) (m':Map) (a0:ad)
- (MapGet (M1 a y) a0)=NONE -> (MapGet m' a0)=NONE ->
- (MapGet (MapDelta (M1 a y) m') a0)=NONE.
- Proof.
- Intros. Unfold MapDelta. Elim (sumbool_of_bool (ad_eq a a0)). Intro H1.
- Rewrite (ad_eq_complete ? ? H1) in H. Rewrite (M1_semantics_1 a0 y) in H. Discriminate H.
- Intro H1. Case (MapGet m' a). Rewrite (MapPut_semantics m' a y a0). Rewrite H1. Assumption.
- Rewrite (MapRemove_semantics m' a a0). Rewrite H1. Trivial.
- Qed.
-
- Lemma MapDelta_semantics_1 : (m,m':Map) (a:ad)
- (MapGet m a)=NONE -> (MapGet m' a)=NONE ->
- (MapGet (MapDelta m m') a)=NONE.
- Proof.
- Induction m. Trivial.
- Exact MapDelta_semantics_1_1.
- Induction m'. Trivial.
- Intros. Rewrite (MapDelta_semantics_comm (M2 m0 m1) (M1 a a0) a1).
- Apply MapDelta_semantics_1_1; Trivial.
- Intros. Simpl. Rewrite (makeM2_M2 (MapDelta m0 m2) (MapDelta m1 m3) a).
- Rewrite MapGet_M2_bit_0_if. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H5. Rewrite H5.
- Apply H0. Rewrite (MapGet_M2_bit_0_1 a H5 m0 m1) in H3. Exact H3.
- Rewrite (MapGet_M2_bit_0_1 a H5 m2 m3) in H4. Exact H4.
- Intro H5. Rewrite H5. Apply H. Rewrite (MapGet_M2_bit_0_0 a H5 m0 m1) in H3. Exact H3.
- Rewrite (MapGet_M2_bit_0_0 a H5 m2 m3) in H4. Exact H4.
- Qed.
-
- Lemma MapDelta_semantics_2_1 : (a:ad) (y:A) (m':Map) (a0:ad) (y0:A)
- (MapGet (M1 a y) a0)=NONE -> (MapGet m' a0)=(SOME y0) ->
- (MapGet (MapDelta (M1 a y) m') a0)=(SOME y0).
- Proof.
- Intros. Unfold MapDelta. Elim (sumbool_of_bool (ad_eq a a0)). Intro H1.
- Rewrite (ad_eq_complete ? ? H1) in H. Rewrite (M1_semantics_1 a0 y) in H. Discriminate H.
- Intro H1. Case (MapGet m' a). Rewrite (MapPut_semantics m' a y a0). Rewrite H1. Assumption.
- Rewrite (MapRemove_semantics m' a a0). Rewrite H1. Trivial.
- Qed.
-
- Lemma MapDelta_semantics_2_2 : (a:ad) (y:A) (m':Map) (a0:ad) (y0:A)
- (MapGet (M1 a y) a0)=(SOME y0) -> (MapGet m' a0)=NONE ->
- (MapGet (MapDelta (M1 a y) m') a0)=(SOME y0).
- Proof.
- Intros. Unfold MapDelta. Elim (sumbool_of_bool (ad_eq a a0)). Intro H1.
- Rewrite (ad_eq_complete ? ? H1) in H. Rewrite (ad_eq_complete ? ? H1).
- Rewrite H0. Rewrite (MapPut_semantics m' a0 y a0). Rewrite (ad_eq_correct a0).
- Rewrite (M1_semantics_1 a0 y) in H. Simple Inversion H. Assumption.
- Intro H1. Rewrite (M1_semantics_2 a a0 y H1) in H. Discriminate H.
- Qed.
-
- Lemma MapDelta_semantics_2 : (m,m':Map) (a:ad) (y:A)
- (MapGet m a)=NONE -> (MapGet m' a)=(SOME y) ->
- (MapGet (MapDelta m m') a)=(SOME y).
- Proof.
- Induction m. Trivial.
- Exact MapDelta_semantics_2_1.
- Induction m'. Intros. Discriminate H2.
- Intros. Rewrite (MapDelta_semantics_comm (M2 m0 m1) (M1 a a0) a1).
- Apply MapDelta_semantics_2_2; Assumption.
- Intros. Simpl. Rewrite (makeM2_M2 (MapDelta m0 m2) (MapDelta m1 m3) a).
- Rewrite MapGet_M2_bit_0_if. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H5. Rewrite H5.
- Apply H0. Rewrite <- (MapGet_M2_bit_0_1 a H5 m0 m1). Assumption.
- Rewrite <- (MapGet_M2_bit_0_1 a H5 m2 m3). Assumption.
- Intro H5. Rewrite H5. Apply H. Rewrite <- (MapGet_M2_bit_0_0 a H5 m0 m1). Assumption.
- Rewrite <- (MapGet_M2_bit_0_0 a H5 m2 m3). Assumption.
- Qed.
-
- Lemma MapDelta_semantics_3_1 : (a0:ad) (y0:A) (m':Map) (a:ad) (y,y':A)
- (MapGet (M1 a0 y0) a)=(SOME y) -> (MapGet m' a)=(SOME y') ->
- (MapGet (MapDelta (M1 a0 y0) m') a)=NONE.
- Proof.
- Intros. Unfold MapDelta. Elim (sumbool_of_bool (ad_eq a0 a)). Intro H1.
- Rewrite (ad_eq_complete a0 a H1). Rewrite H0. Rewrite (MapRemove_semantics m' a a).
- Rewrite (ad_eq_correct a). Reflexivity.
- Intro H1. Rewrite (M1_semantics_2 a0 a y0 H1) in H. Discriminate H.
- Qed.
-
- Lemma MapDelta_semantics_3 : (m,m':Map) (a:ad) (y,y':A)
- (MapGet m a)=(SOME y) -> (MapGet m' a)=(SOME y') ->
- (MapGet (MapDelta m m') a)=NONE.
- Proof.
- Induction m. Intros. Discriminate H.
- Exact MapDelta_semantics_3_1.
- Induction m'. Intros. Discriminate H2.
- Intros. Rewrite (MapDelta_semantics_comm (M2 m0 m1) (M1 a a0) a1).
- Exact (MapDelta_semantics_3_1 a a0 (M2 m0 m1) a1 y' y H2 H1).
- Intros. Simpl. Rewrite (makeM2_M2 (MapDelta m0 m2) (MapDelta m1 m3) a).
- Rewrite MapGet_M2_bit_0_if. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H5. Rewrite H5.
- Apply (H0 m3 (ad_div_2 a) y y'). Rewrite <- (MapGet_M2_bit_0_1 a H5 m0 m1). Assumption.
- Rewrite <- (MapGet_M2_bit_0_1 a H5 m2 m3). Assumption.
- Intro H5. Rewrite H5. Apply (H m2 (ad_div_2 a) y y').
- Rewrite <- (MapGet_M2_bit_0_0 a H5 m0 m1). Assumption.
- Rewrite <- (MapGet_M2_bit_0_0 a H5 m2 m3). Assumption.
- Qed.
-
- Lemma MapDelta_semantics : (m,m':Map)
- (eqm (MapGet (MapDelta m m'))
- [a0:ad] Cases (MapGet m a0) (MapGet m' a0) of
- NONE (SOME y') => (SOME y')
- | (SOME y) NONE => (SOME y)
- | _ _ => NONE
- end).
- Proof.
- Unfold eqm. Intros. Elim (option_sum (MapGet m' a)). Intro H. Elim H. Intros a0 H0.
- Rewrite H0. Elim (option_sum (MapGet m a)). Intro H1. Elim H1. Intros a1 H2. Rewrite H2.
- Exact (MapDelta_semantics_3 m m' a a1 a0 H2 H0).
- Intro H1. Rewrite H1. Exact (MapDelta_semantics_2 m m' a a0 H1 H0).
- Intro H. Rewrite H. Elim (option_sum (MapGet m a)). Intro H0. Elim H0. Intros a0 H1.
- Rewrite H1. Rewrite (MapDelta_semantics_comm m m' a).
- Exact (MapDelta_semantics_2 m' m a a0 H H1).
- Intro H0. Rewrite H0. Exact (MapDelta_semantics_1 m m' a H0 H).
- Qed.
-
- Definition MapEmptyp := [m:Map]
- Cases m of
- M0 => true
- | _ => false
+ Fixpoint MapDelta (m:Map) : Map -> Map :=
+ match m with
+ | M0 => fun m':Map => m'
+ | M1 a y =>
+ fun m':Map =>
+ match MapGet m' a with
+ | NONE => MapPut m' a y
+ | _ => MapRemove m' a
+ end
+ | M2 m1 m2 =>
+ fun m':Map =>
+ match m' with
+ | M0 => m
+ | M1 a' y' =>
+ match MapGet m a' with
+ | NONE => MapPut m a' y'
+ | _ => MapRemove m a'
+ end
+ | M2 m'1 m'2 => makeM2 (MapDelta m1 m'1) (MapDelta m2 m'2)
+ end
end.
- Lemma MapEmptyp_correct : (MapEmptyp M0)=true.
- Proof.
- Reflexivity.
- Qed.
-
- Lemma MapEmptyp_complete : (m:Map) (MapEmptyp m)=true -> m=M0.
+ Lemma MapDelta_semantics_comm :
+ forall m m':Map, eqm (MapGet (MapDelta m m')) (MapGet (MapDelta m' m)).
+ Proof.
+ unfold eqm in |- *. simple induction m. simple induction m'; reflexivity.
+ simple induction m'. reflexivity.
+ unfold MapDelta in |- *. intros. elim (sumbool_of_bool (ad_eq a a1)). intro H.
+ rewrite <- (ad_eq_complete _ _ H). rewrite (M1_semantics_1 a a2).
+ rewrite (M1_semantics_1 a a0). simpl in |- *. rewrite (ad_eq_correct a). reflexivity.
+ intro H. rewrite (M1_semantics_2 a a1 a0 H). rewrite (ad_eq_comm a a1) in H.
+ rewrite (M1_semantics_2 a1 a a2 H). rewrite (MapPut_semantics (M1 a a0) a1 a2 a3).
+ rewrite (MapPut_semantics (M1 a1 a2) a a0 a3). elim (sumbool_of_bool (ad_eq a a3)).
+ intro H0. rewrite H0. rewrite (ad_eq_complete _ _ H0) in H. rewrite H.
+ rewrite (ad_eq_complete _ _ H0). rewrite (M1_semantics_1 a3 a0). reflexivity.
+ intro H0. rewrite H0. rewrite (M1_semantics_2 a a3 a0 H0).
+ elim (sumbool_of_bool (ad_eq a1 a3)). intro H1. rewrite H1.
+ rewrite (ad_eq_complete _ _ H1). exact (M1_semantics_1 a3 a2).
+ intro H1. rewrite H1. exact (M1_semantics_2 a1 a3 a2 H1).
+ intros. reflexivity.
+ simple induction m'. reflexivity.
+ reflexivity.
+ intros. simpl in |- *. rewrite (makeM2_M2 (MapDelta m0 m2) (MapDelta m1 m3) a).
+ rewrite (makeM2_M2 (MapDelta m2 m0) (MapDelta m3 m1) a).
+ rewrite (MapGet_M2_bit_0_if (MapDelta m0 m2) (MapDelta m1 m3) a).
+ rewrite (MapGet_M2_bit_0_if (MapDelta m2 m0) (MapDelta m3 m1) a).
+ rewrite (H0 m3 (ad_div_2 a)). rewrite (H m2 (ad_div_2 a)). reflexivity.
+ Qed.
+
+ Lemma MapDelta_semantics_1_1 :
+ forall (a:ad) (y:A) (m':Map) (a0:ad),
+ MapGet (M1 a y) a0 = NONE ->
+ MapGet m' a0 = NONE -> MapGet (MapDelta (M1 a y) m') a0 = NONE.
+ Proof.
+ intros. unfold MapDelta in |- *. elim (sumbool_of_bool (ad_eq a a0)). intro H1.
+ rewrite (ad_eq_complete _ _ H1) in H. rewrite (M1_semantics_1 a0 y) in H. discriminate H.
+ intro H1. case (MapGet m' a). rewrite (MapPut_semantics m' a y a0). rewrite H1. assumption.
+ rewrite (MapRemove_semantics m' a a0). rewrite H1. trivial.
+ Qed.
+
+ Lemma MapDelta_semantics_1 :
+ forall (m m':Map) (a:ad),
+ MapGet m a = NONE ->
+ MapGet m' a = NONE -> MapGet (MapDelta m m') a = NONE.
+ Proof.
+ simple induction m. trivial.
+ exact MapDelta_semantics_1_1.
+ simple induction m'. trivial.
+ intros. rewrite (MapDelta_semantics_comm (M2 m0 m1) (M1 a a0) a1).
+ apply MapDelta_semantics_1_1; trivial.
+ intros. simpl in |- *. rewrite (makeM2_M2 (MapDelta m0 m2) (MapDelta m1 m3) a).
+ rewrite MapGet_M2_bit_0_if. elim (sumbool_of_bool (ad_bit_0 a)). intro H5. rewrite H5.
+ apply H0. rewrite (MapGet_M2_bit_0_1 a H5 m0 m1) in H3. exact H3.
+ rewrite (MapGet_M2_bit_0_1 a H5 m2 m3) in H4. exact H4.
+ intro H5. rewrite H5. apply H. rewrite (MapGet_M2_bit_0_0 a H5 m0 m1) in H3. exact H3.
+ rewrite (MapGet_M2_bit_0_0 a H5 m2 m3) in H4. exact H4.
+ Qed.
+
+ Lemma MapDelta_semantics_2_1 :
+ forall (a:ad) (y:A) (m':Map) (a0:ad) (y0:A),
+ MapGet (M1 a y) a0 = NONE ->
+ MapGet m' a0 = SOME y0 -> MapGet (MapDelta (M1 a y) m') a0 = SOME y0.
+ Proof.
+ intros. unfold MapDelta in |- *. elim (sumbool_of_bool (ad_eq a a0)). intro H1.
+ rewrite (ad_eq_complete _ _ H1) in H. rewrite (M1_semantics_1 a0 y) in H. discriminate H.
+ intro H1. case (MapGet m' a). rewrite (MapPut_semantics m' a y a0). rewrite H1. assumption.
+ rewrite (MapRemove_semantics m' a a0). rewrite H1. trivial.
+ Qed.
+
+ Lemma MapDelta_semantics_2_2 :
+ forall (a:ad) (y:A) (m':Map) (a0:ad) (y0:A),
+ MapGet (M1 a y) a0 = SOME y0 ->
+ MapGet m' a0 = NONE -> MapGet (MapDelta (M1 a y) m') a0 = SOME y0.
+ Proof.
+ intros. unfold MapDelta in |- *. elim (sumbool_of_bool (ad_eq a a0)). intro H1.
+ rewrite (ad_eq_complete _ _ H1) in H. rewrite (ad_eq_complete _ _ H1).
+ rewrite H0. rewrite (MapPut_semantics m' a0 y a0). rewrite (ad_eq_correct a0).
+ rewrite (M1_semantics_1 a0 y) in H. simple inversion H. assumption.
+ intro H1. rewrite (M1_semantics_2 a a0 y H1) in H. discriminate H.
+ Qed.
+
+ Lemma MapDelta_semantics_2 :
+ forall (m m':Map) (a:ad) (y:A),
+ MapGet m a = NONE ->
+ MapGet m' a = SOME y -> MapGet (MapDelta m m') a = SOME y.
+ Proof.
+ simple induction m. trivial.
+ exact MapDelta_semantics_2_1.
+ simple induction m'. intros. discriminate H2.
+ intros. rewrite (MapDelta_semantics_comm (M2 m0 m1) (M1 a a0) a1).
+ apply MapDelta_semantics_2_2; assumption.
+ intros. simpl in |- *. rewrite (makeM2_M2 (MapDelta m0 m2) (MapDelta m1 m3) a).
+ rewrite MapGet_M2_bit_0_if. elim (sumbool_of_bool (ad_bit_0 a)). intro H5. rewrite H5.
+ apply H0. rewrite <- (MapGet_M2_bit_0_1 a H5 m0 m1). assumption.
+ rewrite <- (MapGet_M2_bit_0_1 a H5 m2 m3). assumption.
+ intro H5. rewrite H5. apply H. rewrite <- (MapGet_M2_bit_0_0 a H5 m0 m1). assumption.
+ rewrite <- (MapGet_M2_bit_0_0 a H5 m2 m3). assumption.
+ Qed.
+
+ Lemma MapDelta_semantics_3_1 :
+ forall (a0:ad) (y0:A) (m':Map) (a:ad) (y y':A),
+ MapGet (M1 a0 y0) a = SOME y ->
+ MapGet m' a = SOME y' -> MapGet (MapDelta (M1 a0 y0) m') a = NONE.
+ Proof.
+ intros. unfold MapDelta in |- *. elim (sumbool_of_bool (ad_eq a0 a)). intro H1.
+ rewrite (ad_eq_complete a0 a H1). rewrite H0. rewrite (MapRemove_semantics m' a a).
+ rewrite (ad_eq_correct a). reflexivity.
+ intro H1. rewrite (M1_semantics_2 a0 a y0 H1) in H. discriminate H.
+ Qed.
+
+ Lemma MapDelta_semantics_3 :
+ forall (m m':Map) (a:ad) (y y':A),
+ MapGet m a = SOME y ->
+ MapGet m' a = SOME y' -> MapGet (MapDelta m m') a = NONE.
+ Proof.
+ simple induction m. intros. discriminate H.
+ exact MapDelta_semantics_3_1.
+ simple induction m'. intros. discriminate H2.
+ intros. rewrite (MapDelta_semantics_comm (M2 m0 m1) (M1 a a0) a1).
+ exact (MapDelta_semantics_3_1 a a0 (M2 m0 m1) a1 y' y H2 H1).
+ intros. simpl in |- *. rewrite (makeM2_M2 (MapDelta m0 m2) (MapDelta m1 m3) a).
+ rewrite MapGet_M2_bit_0_if. elim (sumbool_of_bool (ad_bit_0 a)). intro H5. rewrite H5.
+ apply (H0 m3 (ad_div_2 a) y y'). rewrite <- (MapGet_M2_bit_0_1 a H5 m0 m1). assumption.
+ rewrite <- (MapGet_M2_bit_0_1 a H5 m2 m3). assumption.
+ intro H5. rewrite H5. apply (H m2 (ad_div_2 a) y y').
+ rewrite <- (MapGet_M2_bit_0_0 a H5 m0 m1). assumption.
+ rewrite <- (MapGet_M2_bit_0_0 a H5 m2 m3). assumption.
+ Qed.
+
+ Lemma MapDelta_semantics :
+ forall m m':Map,
+ eqm (MapGet (MapDelta m m'))
+ (fun a0:ad =>
+ match MapGet m a0, MapGet m' a0 with
+ | NONE, SOME y' => SOME y'
+ | SOME y, NONE => SOME y
+ | _, _ => NONE
+ end).
+ Proof.
+ unfold eqm in |- *. intros. elim (option_sum (MapGet m' a)). intro H. elim H. intros a0 H0.
+ rewrite H0. elim (option_sum (MapGet m a)). intro H1. elim H1. intros a1 H2. rewrite H2.
+ exact (MapDelta_semantics_3 m m' a a1 a0 H2 H0).
+ intro H1. rewrite H1. exact (MapDelta_semantics_2 m m' a a0 H1 H0).
+ intro H. rewrite H. elim (option_sum (MapGet m a)). intro H0. elim H0. intros a0 H1.
+ rewrite H1. rewrite (MapDelta_semantics_comm m m' a).
+ exact (MapDelta_semantics_2 m' m a a0 H H1).
+ intro H0. rewrite H0. exact (MapDelta_semantics_1 m m' a H0 H).
+ Qed.
+
+ Definition MapEmptyp (m:Map) := match m with
+ | M0 => true
+ | _ => false
+ end.
+
+ Lemma MapEmptyp_correct : MapEmptyp M0 = true.
Proof.
- Induction m; Trivial. Intros. Discriminate H.
- Intros. Discriminate H1.
+ reflexivity.
+ Qed.
+
+ Lemma MapEmptyp_complete : forall m:Map, MapEmptyp m = true -> m = M0.
+ Proof.
+ simple induction m; trivial. intros. discriminate H.
+ intros. discriminate H1.
Qed.
(** [MapSplit] not implemented: not the preferred way of recursing over Maps
(use [MapSweep], [MapCollect], or [MapFold] in Mapiter.v. *)
-End MapDefs.
+End MapDefs. \ No newline at end of file
diff --git a/theories/IntMap/Mapaxioms.v b/theories/IntMap/Mapaxioms.v
index 7ab131c77..874a4b9ef 100644
--- a/theories/IntMap/Mapaxioms.v
+++ b/theories/IntMap/Mapaxioms.v
@@ -7,664 +7,757 @@
(***********************************************************************)
(*i $Id$ i*)
-Require Bool.
-Require Sumbool.
-Require ZArith.
-Require Addr.
-Require Adist.
-Require Addec.
-Require Map.
-Require Fset.
+Require Import Bool.
+Require Import Sumbool.
+Require Import ZArith.
+Require Import Addr.
+Require Import Adist.
+Require Import Addec.
+Require Import Map.
+Require Import Fset.
Section MapAxioms.
- Variable A, B, C : Set.
+ Variables A B C : Set.
- Lemma eqm_sym : (f,f':ad->(option A)) (eqm A f f') -> (eqm A f' f).
+ Lemma eqm_sym : forall f f':ad -> option A, eqm A f f' -> eqm A f' f.
Proof.
- Unfold eqm. Intros. Rewrite H. Reflexivity.
+ unfold eqm in |- *. intros. rewrite H. reflexivity.
Qed.
- Lemma eqm_refl : (f:ad->(option A)) (eqm A f f).
+ Lemma eqm_refl : forall f:ad -> option A, eqm A f f.
Proof.
- Unfold eqm. Trivial.
+ unfold eqm in |- *. trivial.
Qed.
- Lemma eqm_trans : (f,f',f'':ad->(option A)) (eqm A f f') -> (eqm A f' f'') -> (eqm A f f'').
+ Lemma eqm_trans :
+ forall f f' f'':ad -> option A, eqm A f f' -> eqm A f' f'' -> eqm A f f''.
Proof.
- Unfold eqm. Intros. Rewrite H. Exact (H0 a).
+ unfold eqm in |- *. intros. rewrite H. exact (H0 a).
Qed.
- Definition eqmap := [m,m':(Map A)] (eqm A (MapGet A m) (MapGet A m')).
+ Definition eqmap (m m':Map A) := eqm A (MapGet A m) (MapGet A m').
- Lemma eqmap_sym : (m,m':(Map A)) (eqmap m m') -> (eqmap m' m).
+ Lemma eqmap_sym : forall m m':Map A, eqmap m m' -> eqmap m' m.
Proof.
- Intros. Unfold eqmap. Apply eqm_sym. Assumption.
+ intros. unfold eqmap in |- *. apply eqm_sym. assumption.
Qed.
- Lemma eqmap_refl : (m:(Map A)) (eqmap m m).
+ Lemma eqmap_refl : forall m:Map A, eqmap m m.
Proof.
- Intros. Unfold eqmap. Apply eqm_refl.
+ intros. unfold eqmap in |- *. apply eqm_refl.
Qed.
- Lemma eqmap_trans : (m,m',m'':(Map A)) (eqmap m m') -> (eqmap m' m'') -> (eqmap m m'').
+ Lemma eqmap_trans :
+ forall m m' m'':Map A, eqmap m m' -> eqmap m' m'' -> eqmap m m''.
Proof.
- Intros. Exact (eqm_trans (MapGet A m) (MapGet A m') (MapGet A m'') H H0).
+ intros. exact (eqm_trans (MapGet A m) (MapGet A m') (MapGet A m'') H H0).
Qed.
- Lemma MapPut_as_Merge : (m:(Map A)) (a:ad) (y:A)
- (eqmap (MapPut A m a y) (MapMerge A m (M1 A a y))).
+ Lemma MapPut_as_Merge :
+ forall (m:Map A) (a:ad) (y:A),
+ eqmap (MapPut A m a y) (MapMerge A m (M1 A a y)).
Proof.
- Unfold eqmap eqm. Intros. Rewrite (MapPut_semantics A m a y a0).
- Rewrite (MapMerge_semantics A m (M1 A a y) a0). Unfold 2 MapGet.
- Elim (sumbool_of_bool (ad_eq a a0)); Intro H; Rewrite H; Reflexivity.
+ unfold eqmap, eqm in |- *. intros. rewrite (MapPut_semantics A m a y a0).
+ rewrite (MapMerge_semantics A m (M1 A a y) a0). unfold MapGet at 2 in |- *.
+ elim (sumbool_of_bool (ad_eq a a0)); intro H; rewrite H; reflexivity.
Qed.
- Lemma MapPut_ext : (m,m':(Map A)) (eqmap m m') ->
- (a:ad) (y:A) (eqmap (MapPut A m a y) (MapPut A m' a y)).
+ Lemma MapPut_ext :
+ forall m m':Map A,
+ eqmap m m' ->
+ forall (a:ad) (y:A), eqmap (MapPut A m a y) (MapPut A m' a y).
Proof.
- Unfold eqmap eqm. Intros. Rewrite (MapPut_semantics A m' a y a0).
- Rewrite (MapPut_semantics A m a y a0).
- Case (ad_eq a a0); [ Reflexivity | Apply H ].
+ unfold eqmap, eqm in |- *. intros. rewrite (MapPut_semantics A m' a y a0).
+ rewrite (MapPut_semantics A m a y a0).
+ case (ad_eq a a0); [ reflexivity | apply H ].
Qed.
- Lemma MapPut_behind_as_Merge : (m:(Map A)) (a:ad) (y:A)
- (eqmap (MapPut_behind A m a y) (MapMerge A (M1 A a y) m)).
+ Lemma MapPut_behind_as_Merge :
+ forall (m:Map A) (a:ad) (y:A),
+ eqmap (MapPut_behind A m a y) (MapMerge A (M1 A a y) m).
Proof.
- Unfold eqmap eqm. Intros. Rewrite (MapPut_behind_semantics A m a y a0).
- Rewrite (MapMerge_semantics A (M1 A a y) m a0). Reflexivity.
+ unfold eqmap, eqm in |- *. intros. rewrite (MapPut_behind_semantics A m a y a0).
+ rewrite (MapMerge_semantics A (M1 A a y) m a0). reflexivity.
Qed.
- Lemma MapPut_behind_ext : (m,m':(Map A)) (eqmap m m') ->
- (a:ad) (y:A) (eqmap (MapPut_behind A m a y) (MapPut_behind A m' a y)).
+ Lemma MapPut_behind_ext :
+ forall m m':Map A,
+ eqmap m m' ->
+ forall (a:ad) (y:A),
+ eqmap (MapPut_behind A m a y) (MapPut_behind A m' a y).
Proof.
- Unfold eqmap eqm. Intros. Rewrite (MapPut_behind_semantics A m' a y a0).
- Rewrite (MapPut_behind_semantics A m a y a0). Rewrite (H a0). Reflexivity.
+ unfold eqmap, eqm in |- *. intros. rewrite (MapPut_behind_semantics A m' a y a0).
+ rewrite (MapPut_behind_semantics A m a y a0). rewrite (H a0). reflexivity.
Qed.
- Lemma MapMerge_empty_m_1 : (m:(Map A)) (MapMerge A (M0 A) m)=m.
+ Lemma MapMerge_empty_m_1 : forall m:Map A, MapMerge A (M0 A) m = m.
Proof.
- Trivial.
+ trivial.
Qed.
- Lemma MapMerge_empty_m : (m:(Map A)) (eqmap (MapMerge A (M0 A) m) m).
+ Lemma MapMerge_empty_m : forall m:Map A, eqmap (MapMerge A (M0 A) m) m.
Proof.
- Unfold eqmap eqm. Trivial.
+ unfold eqmap, eqm in |- *. trivial.
Qed.
- Lemma MapMerge_m_empty_1 : (m:(Map A)) (MapMerge A m (M0 A))=m.
+ Lemma MapMerge_m_empty_1 : forall m:Map A, MapMerge A m (M0 A) = m.
Proof.
- Induction m;Trivial.
+ simple induction m; trivial.
Qed.
- Lemma MapMerge_m_empty : (m:(Map A)) (eqmap (MapMerge A m (M0 A)) m).
+ Lemma MapMerge_m_empty : forall m:Map A, eqmap (MapMerge A m (M0 A)) m.
Proof.
- Unfold eqmap eqm. Intros. Rewrite MapMerge_m_empty_1. Reflexivity.
+ unfold eqmap, eqm in |- *. intros. rewrite MapMerge_m_empty_1. reflexivity.
Qed.
- Lemma MapMerge_empty_l : (m,m':(Map A)) (eqmap (MapMerge A m m') (M0 A)) ->
- (eqmap m (M0 A)).
+ Lemma MapMerge_empty_l :
+ forall m m':Map A, eqmap (MapMerge A m m') (M0 A) -> eqmap m (M0 A).
Proof.
- Unfold eqmap eqm. Intros. Cut (MapGet A (MapMerge A m m') a)=(MapGet A (M0 A) a).
- Rewrite (MapMerge_semantics A m m' a). Case (MapGet A m' a). Trivial.
- Intros. Discriminate H0.
- Exact (H a).
+ unfold eqmap, eqm in |- *. intros. cut (MapGet A (MapMerge A m m') a = MapGet A (M0 A) a).
+ rewrite (MapMerge_semantics A m m' a). case (MapGet A m' a). trivial.
+ intros. discriminate H0.
+ exact (H a).
Qed.
- Lemma MapMerge_empty_r : (m,m':(Map A)) (eqmap (MapMerge A m m') (M0 A)) ->
- (eqmap m' (M0 A)).
+ Lemma MapMerge_empty_r :
+ forall m m':Map A, eqmap (MapMerge A m m') (M0 A) -> eqmap m' (M0 A).
Proof.
- Unfold eqmap eqm. Intros. Cut (MapGet A (MapMerge A m m') a)=(MapGet A (M0 A) a).
- Rewrite (MapMerge_semantics A m m' a). Case (MapGet A m' a). Trivial.
- Intros. Discriminate H0.
- Exact (H a).
+ unfold eqmap, eqm in |- *. intros. cut (MapGet A (MapMerge A m m') a = MapGet A (M0 A) a).
+ rewrite (MapMerge_semantics A m m' a). case (MapGet A m' a). trivial.
+ intros. discriminate H0.
+ exact (H a).
Qed.
- Lemma MapMerge_assoc : (m,m',m'':(Map A)) (eqmap
- (MapMerge A (MapMerge A m m') m'')
- (MapMerge A m (MapMerge A m' m''))).
+ Lemma MapMerge_assoc :
+ forall m m' m'':Map A,
+ eqmap (MapMerge A (MapMerge A m m') m'')
+ (MapMerge A m (MapMerge A m' m'')).
Proof.
- Unfold eqmap eqm. Intros. Rewrite (MapMerge_semantics A (MapMerge A m m') m'' a).
- Rewrite (MapMerge_semantics A m (MapMerge A m' m'') a). Rewrite (MapMerge_semantics A m m' a).
- Rewrite (MapMerge_semantics A m' m'' a).
- Case (MapGet A m'' a); Case (MapGet A m' a); Trivial.
+ unfold eqmap, eqm in |- *. intros. rewrite (MapMerge_semantics A (MapMerge A m m') m'' a).
+ rewrite (MapMerge_semantics A m (MapMerge A m' m'') a). rewrite (MapMerge_semantics A m m' a).
+ rewrite (MapMerge_semantics A m' m'' a).
+ case (MapGet A m'' a); case (MapGet A m' a); trivial.
Qed.
- Lemma MapMerge_idempotent : (m:(Map A)) (eqmap (MapMerge A m m) m).
+ Lemma MapMerge_idempotent : forall m:Map A, eqmap (MapMerge A m m) m.
Proof.
- Unfold eqmap eqm. Intros. Rewrite (MapMerge_semantics A m m a).
- Case (MapGet A m a); Trivial.
+ unfold eqmap, eqm in |- *. intros. rewrite (MapMerge_semantics A m m a).
+ case (MapGet A m a); trivial.
Qed.
- Lemma MapMerge_ext : (m1,m2,m'1,m'2:(Map A))
- (eqmap m1 m'1) -> (eqmap m2 m'2) ->
- (eqmap (MapMerge A m1 m2) (MapMerge A m'1 m'2)).
+ Lemma MapMerge_ext :
+ forall m1 m2 m'1 m'2:Map A,
+ eqmap m1 m'1 ->
+ eqmap m2 m'2 -> eqmap (MapMerge A m1 m2) (MapMerge A m'1 m'2).
Proof.
- Unfold eqmap eqm. Intros. Rewrite (MapMerge_semantics A m1 m2 a).
- Rewrite (MapMerge_semantics A m'1 m'2 a). Rewrite (H a). Rewrite (H0 a). Reflexivity.
+ unfold eqmap, eqm in |- *. intros. rewrite (MapMerge_semantics A m1 m2 a).
+ rewrite (MapMerge_semantics A m'1 m'2 a). rewrite (H a). rewrite (H0 a). reflexivity.
Qed.
- Lemma MapMerge_ext_l : (m1,m'1,m2:(Map A))
- (eqmap m1 m'1) -> (eqmap (MapMerge A m1 m2) (MapMerge A m'1 m2)).
+ Lemma MapMerge_ext_l :
+ forall m1 m'1 m2:Map A,
+ eqmap m1 m'1 -> eqmap (MapMerge A m1 m2) (MapMerge A m'1 m2).
Proof.
- Intros. Apply MapMerge_ext. Assumption.
- Apply eqmap_refl.
+ intros. apply MapMerge_ext. assumption.
+ apply eqmap_refl.
Qed.
- Lemma MapMerge_ext_r : (m1,m2,m'2:(Map A))
- (eqmap m2 m'2) -> (eqmap (MapMerge A m1 m2) (MapMerge A m1 m'2)).
+ Lemma MapMerge_ext_r :
+ forall m1 m2 m'2:Map A,
+ eqmap m2 m'2 -> eqmap (MapMerge A m1 m2) (MapMerge A m1 m'2).
Proof.
- Intros. Apply MapMerge_ext. Apply eqmap_refl.
- Assumption.
+ intros. apply MapMerge_ext. apply eqmap_refl.
+ assumption.
Qed.
- Lemma MapMerge_RestrTo_l : (m,m',m'':(Map A))
- (eqmap (MapMerge A (MapDomRestrTo A A m m') m'')
- (MapDomRestrTo A A (MapMerge A m m'') (MapMerge A m' m''))).
+ Lemma MapMerge_RestrTo_l :
+ forall m m' m'':Map A,
+ eqmap (MapMerge A (MapDomRestrTo A A m m') m'')
+ (MapDomRestrTo A A (MapMerge A m m'') (MapMerge A m' m'')).
Proof.
- Unfold eqmap eqm. Intros. Rewrite (MapMerge_semantics A (MapDomRestrTo A A m m') m'' a).
- Rewrite (MapDomRestrTo_semantics A A m m' a).
- Rewrite (MapDomRestrTo_semantics A A (MapMerge A m m'') (MapMerge A m' m'') a).
- Rewrite (MapMerge_semantics A m' m'' a). Rewrite (MapMerge_semantics A m m'' a).
- Case (MapGet A m'' a); Case (MapGet A m' a); Reflexivity.
+ unfold eqmap, eqm in |- *. intros. rewrite (MapMerge_semantics A (MapDomRestrTo A A m m') m'' a).
+ rewrite (MapDomRestrTo_semantics A A m m' a).
+ rewrite
+ (MapDomRestrTo_semantics A A (MapMerge A m m'') (MapMerge A m' m'') a)
+ .
+ rewrite (MapMerge_semantics A m' m'' a). rewrite (MapMerge_semantics A m m'' a).
+ case (MapGet A m'' a); case (MapGet A m' a); reflexivity.
Qed.
- Lemma MapRemove_as_RestrBy : (m:(Map A)) (a:ad) (y:B)
- (eqmap (MapRemove A m a) (MapDomRestrBy A B m (M1 B a y))).
+ Lemma MapRemove_as_RestrBy :
+ forall (m:Map A) (a:ad) (y:B),
+ eqmap (MapRemove A m a) (MapDomRestrBy A B m (M1 B a y)).
Proof.
- Unfold eqmap eqm. Intros. Rewrite (MapRemove_semantics A m a a0).
- Rewrite (MapDomRestrBy_semantics A B m (M1 B a y) a0). Elim (sumbool_of_bool (ad_eq a a0)).
- Intro H. Rewrite H. Rewrite (ad_eq_complete a a0 H). Rewrite (M1_semantics_1 B a0 y).
- Reflexivity.
- Intro H. Rewrite H. Rewrite (M1_semantics_2 B a a0 y H). Reflexivity.
+ unfold eqmap, eqm in |- *. intros. rewrite (MapRemove_semantics A m a a0).
+ rewrite (MapDomRestrBy_semantics A B m (M1 B a y) a0). elim (sumbool_of_bool (ad_eq a a0)).
+ intro H. rewrite H. rewrite (ad_eq_complete a a0 H). rewrite (M1_semantics_1 B a0 y).
+ reflexivity.
+ intro H. rewrite H. rewrite (M1_semantics_2 B a a0 y H). reflexivity.
Qed.
- Lemma MapRemove_ext : (m,m':(Map A)) (eqmap m m') ->
- (a:ad) (eqmap (MapRemove A m a) (MapRemove A m' a)).
+ Lemma MapRemove_ext :
+ forall m m':Map A,
+ eqmap m m' -> forall a:ad, eqmap (MapRemove A m a) (MapRemove A m' a).
Proof.
- Unfold eqmap eqm. Intros. Rewrite (MapRemove_semantics A m' a a0).
- Rewrite (MapRemove_semantics A m a a0).
- Case (ad_eq a a0); [ Reflexivity | Apply H ].
+ unfold eqmap, eqm in |- *. intros. rewrite (MapRemove_semantics A m' a a0).
+ rewrite (MapRemove_semantics A m a a0).
+ case (ad_eq a a0); [ reflexivity | apply H ].
Qed.
- Lemma MapDomRestrTo_empty_m_1 :
- (m:(Map B)) (MapDomRestrTo A B (M0 A) m)=(M0 A).
+ Lemma MapDomRestrTo_empty_m_1 :
+ forall m:Map B, MapDomRestrTo A B (M0 A) m = M0 A.
Proof.
- Trivial.
+ trivial.
Qed.
- Lemma MapDomRestrTo_empty_m :
- (m:(Map B)) (eqmap (MapDomRestrTo A B (M0 A) m) (M0 A)).
+ Lemma MapDomRestrTo_empty_m :
+ forall m:Map B, eqmap (MapDomRestrTo A B (M0 A) m) (M0 A).
Proof.
- Unfold eqmap eqm. Trivial.
+ unfold eqmap, eqm in |- *. trivial.
Qed.
- Lemma MapDomRestrTo_m_empty_1 :
- (m:(Map A)) (MapDomRestrTo A B m (M0 B))=(M0 A).
+ Lemma MapDomRestrTo_m_empty_1 :
+ forall m:Map A, MapDomRestrTo A B m (M0 B) = M0 A.
Proof.
- Induction m;Trivial.
+ simple induction m; trivial.
Qed.
- Lemma MapDomRestrTo_m_empty :
- (m:(Map A)) (eqmap (MapDomRestrTo A B m (M0 B)) (M0 A)).
+ Lemma MapDomRestrTo_m_empty :
+ forall m:Map A, eqmap (MapDomRestrTo A B m (M0 B)) (M0 A).
Proof.
- Unfold eqmap eqm. Intros. Rewrite (MapDomRestrTo_m_empty_1 m). Reflexivity.
+ unfold eqmap, eqm in |- *. intros. rewrite (MapDomRestrTo_m_empty_1 m). reflexivity.
Qed.
- Lemma MapDomRestrTo_assoc : (m:(Map A)) (m':(Map B)) (m'':(Map C))
- (eqmap (MapDomRestrTo A C (MapDomRestrTo A B m m') m'')
- (MapDomRestrTo A B m (MapDomRestrTo B C m' m''))).
+ Lemma MapDomRestrTo_assoc :
+ forall (m:Map A) (m':Map B) (m'':Map C),
+ eqmap (MapDomRestrTo A C (MapDomRestrTo A B m m') m'')
+ (MapDomRestrTo A B m (MapDomRestrTo B C m' m'')).
Proof.
- Unfold eqmap eqm. Intros.
- Rewrite (MapDomRestrTo_semantics A C (MapDomRestrTo A B m m') m'' a).
- Rewrite (MapDomRestrTo_semantics A B m m' a).
- Rewrite (MapDomRestrTo_semantics A B m (MapDomRestrTo B C m' m'') a).
- Rewrite (MapDomRestrTo_semantics B C m' m'' a).
- Case (MapGet C m'' a); Case (MapGet B m' a); Trivial.
+ unfold eqmap, eqm in |- *. intros.
+ rewrite (MapDomRestrTo_semantics A C (MapDomRestrTo A B m m') m'' a).
+ rewrite (MapDomRestrTo_semantics A B m m' a).
+ rewrite (MapDomRestrTo_semantics A B m (MapDomRestrTo B C m' m'') a).
+ rewrite (MapDomRestrTo_semantics B C m' m'' a).
+ case (MapGet C m'' a); case (MapGet B m' a); trivial.
Qed.
- Lemma MapDomRestrTo_idempotent : (m:(Map A)) (eqmap (MapDomRestrTo A A m m) m).
+ Lemma MapDomRestrTo_idempotent :
+ forall m:Map A, eqmap (MapDomRestrTo A A m m) m.
Proof.
- Unfold eqmap eqm. Intros. Rewrite (MapDomRestrTo_semantics A A m m a).
- Case (MapGet A m a); Trivial.
+ unfold eqmap, eqm in |- *. intros. rewrite (MapDomRestrTo_semantics A A m m a).
+ case (MapGet A m a); trivial.
Qed.
- Lemma MapDomRestrTo_Dom : (m:(Map A)) (m':(Map B))
- (eqmap (MapDomRestrTo A B m m') (MapDomRestrTo A unit m (MapDom B m'))).
+ Lemma MapDomRestrTo_Dom :
+ forall (m:Map A) (m':Map B),
+ eqmap (MapDomRestrTo A B m m') (MapDomRestrTo A unit m (MapDom B m')).
Proof.
- Unfold eqmap eqm. Intros. Rewrite (MapDomRestrTo_semantics A B m m' a).
- Rewrite (MapDomRestrTo_semantics A unit m (MapDom B m') a).
- Elim (sumbool_of_bool (in_FSet a (MapDom B m'))). Intro H.
- Elim (MapDom_semantics_2 B m' a H). Intros y H0. Rewrite H0. Unfold in_FSet in_dom in H.
- Generalize H. Case (MapGet unit (MapDom B m') a); Trivial. Intro H1. Discriminate H1.
- Intro H. Rewrite (MapDom_semantics_4 B m' a H). Unfold in_FSet in_dom in H.
- Generalize H. Case (MapGet unit (MapDom B m') a). Trivial.
- Intros H0 H1. Discriminate H1.
+ unfold eqmap, eqm in |- *. intros. rewrite (MapDomRestrTo_semantics A B m m' a).
+ rewrite (MapDomRestrTo_semantics A unit m (MapDom B m') a).
+ elim (sumbool_of_bool (in_FSet a (MapDom B m'))). intro H.
+ elim (MapDom_semantics_2 B m' a H). intros y H0. rewrite H0. unfold in_FSet, in_dom in H.
+ generalize H. case (MapGet unit (MapDom B m') a); trivial. intro H1. discriminate H1.
+ intro H. rewrite (MapDom_semantics_4 B m' a H). unfold in_FSet, in_dom in H.
+ generalize H. case (MapGet unit (MapDom B m') a). trivial.
+ intros H0 H1. discriminate H1.
Qed.
- Lemma MapDomRestrBy_empty_m_1 :
- (m:(Map B)) (MapDomRestrBy A B (M0 A) m)=(M0 A).
+ Lemma MapDomRestrBy_empty_m_1 :
+ forall m:Map B, MapDomRestrBy A B (M0 A) m = M0 A.
Proof.
- Trivial.
+ trivial.
Qed.
- Lemma MapDomRestrBy_empty_m :
- (m:(Map B)) (eqmap (MapDomRestrBy A B (M0 A) m) (M0 A)).
+ Lemma MapDomRestrBy_empty_m :
+ forall m:Map B, eqmap (MapDomRestrBy A B (M0 A) m) (M0 A).
Proof.
- Unfold eqmap eqm. Trivial.
+ unfold eqmap, eqm in |- *. trivial.
Qed.
- Lemma MapDomRestrBy_m_empty_1 : (m:(Map A)) (MapDomRestrBy A B m (M0 B))=m.
+ Lemma MapDomRestrBy_m_empty_1 :
+ forall m:Map A, MapDomRestrBy A B m (M0 B) = m.
Proof.
- Induction m;Trivial.
+ simple induction m; trivial.
Qed.
- Lemma MapDomRestrBy_m_empty : (m:(Map A)) (eqmap (MapDomRestrBy A B m (M0 B)) m).
+ Lemma MapDomRestrBy_m_empty :
+ forall m:Map A, eqmap (MapDomRestrBy A B m (M0 B)) m.
Proof.
- Unfold eqmap eqm. Intros. Rewrite (MapDomRestrBy_m_empty_1 m). Reflexivity.
+ unfold eqmap, eqm in |- *. intros. rewrite (MapDomRestrBy_m_empty_1 m). reflexivity.
Qed.
- Lemma MapDomRestrBy_Dom : (m:(Map A)) (m':(Map B))
- (eqmap (MapDomRestrBy A B m m') (MapDomRestrBy A unit m (MapDom B m'))).
+ Lemma MapDomRestrBy_Dom :
+ forall (m:Map A) (m':Map B),
+ eqmap (MapDomRestrBy A B m m') (MapDomRestrBy A unit m (MapDom B m')).
Proof.
- Unfold eqmap eqm. Intros. Rewrite (MapDomRestrBy_semantics A B m m' a).
- Rewrite (MapDomRestrBy_semantics A unit m (MapDom B m') a).
- Elim (sumbool_of_bool (in_FSet a (MapDom B m'))). Intro H.
- Elim (MapDom_semantics_2 B m' a H). Intros y H0. Rewrite H0.
- Unfold in_FSet in_dom in H. Generalize H. Case (MapGet unit (MapDom B m') a); Trivial.
- Intro H1. Discriminate H1.
- Intro H. Rewrite (MapDom_semantics_4 B m' a H). Unfold in_FSet in_dom in H.
- Generalize H. Case (MapGet unit (MapDom B m') a). Trivial.
- Intros H0 H1. Discriminate H1.
+ unfold eqmap, eqm in |- *. intros. rewrite (MapDomRestrBy_semantics A B m m' a).
+ rewrite (MapDomRestrBy_semantics A unit m (MapDom B m') a).
+ elim (sumbool_of_bool (in_FSet a (MapDom B m'))). intro H.
+ elim (MapDom_semantics_2 B m' a H). intros y H0. rewrite H0.
+ unfold in_FSet, in_dom in H. generalize H. case (MapGet unit (MapDom B m') a); trivial.
+ intro H1. discriminate H1.
+ intro H. rewrite (MapDom_semantics_4 B m' a H). unfold in_FSet, in_dom in H.
+ generalize H. case (MapGet unit (MapDom B m') a). trivial.
+ intros H0 H1. discriminate H1.
Qed.
- Lemma MapDomRestrBy_m_m_1 : (m:(Map A)) (eqmap (MapDomRestrBy A A m m) (M0 A)).
+ Lemma MapDomRestrBy_m_m_1 :
+ forall m:Map A, eqmap (MapDomRestrBy A A m m) (M0 A).
Proof.
- Unfold eqmap eqm. Intros. Rewrite (MapDomRestrBy_semantics A A m m a).
- Case (MapGet A m a); Trivial.
+ unfold eqmap, eqm in |- *. intros. rewrite (MapDomRestrBy_semantics A A m m a).
+ case (MapGet A m a); trivial.
Qed.
- Lemma MapDomRestrBy_By : (m:(Map A)) (m':(Map B)) (m'':(Map B))
- (eqmap (MapDomRestrBy A B (MapDomRestrBy A B m m') m'')
- (MapDomRestrBy A B m (MapMerge B m' m''))).
+ Lemma MapDomRestrBy_By :
+ forall (m:Map A) (m' m'':Map B),
+ eqmap (MapDomRestrBy A B (MapDomRestrBy A B m m') m'')
+ (MapDomRestrBy A B m (MapMerge B m' m'')).
Proof.
- Unfold eqmap eqm. Intros.
- Rewrite (MapDomRestrBy_semantics A B (MapDomRestrBy A B m m') m'' a).
- Rewrite (MapDomRestrBy_semantics A B m m' a).
- Rewrite (MapDomRestrBy_semantics A B m (MapMerge B m' m'') a).
- Rewrite (MapMerge_semantics B m' m'' a).
- Case (MapGet B m'' a); Case (MapGet B m' a); Trivial.
+ unfold eqmap, eqm in |- *. intros.
+ rewrite (MapDomRestrBy_semantics A B (MapDomRestrBy A B m m') m'' a).
+ rewrite (MapDomRestrBy_semantics A B m m' a).
+ rewrite (MapDomRestrBy_semantics A B m (MapMerge B m' m'') a).
+ rewrite (MapMerge_semantics B m' m'' a).
+ case (MapGet B m'' a); case (MapGet B m' a); trivial.
Qed.
- Lemma MapDomRestrBy_By_comm : (m:(Map A)) (m':(Map B)) (m'':(Map C))
- (eqmap (MapDomRestrBy A C (MapDomRestrBy A B m m') m'')
- (MapDomRestrBy A B (MapDomRestrBy A C m m'') m')).
+ Lemma MapDomRestrBy_By_comm :
+ forall (m:Map A) (m':Map B) (m'':Map C),
+ eqmap (MapDomRestrBy A C (MapDomRestrBy A B m m') m'')
+ (MapDomRestrBy A B (MapDomRestrBy A C m m'') m').
Proof.
- Unfold eqmap eqm. Intros.
- Rewrite (MapDomRestrBy_semantics A C (MapDomRestrBy A B m m') m'' a).
- Rewrite (MapDomRestrBy_semantics A B m m' a).
- Rewrite (MapDomRestrBy_semantics A B (MapDomRestrBy A C m m'') m' a).
- Rewrite (MapDomRestrBy_semantics A C m m'' a).
- Case (MapGet C m'' a); Case (MapGet B m' a); Trivial.
+ unfold eqmap, eqm in |- *. intros.
+ rewrite (MapDomRestrBy_semantics A C (MapDomRestrBy A B m m') m'' a).
+ rewrite (MapDomRestrBy_semantics A B m m' a).
+ rewrite (MapDomRestrBy_semantics A B (MapDomRestrBy A C m m'') m' a).
+ rewrite (MapDomRestrBy_semantics A C m m'' a).
+ case (MapGet C m'' a); case (MapGet B m' a); trivial.
Qed.
- Lemma MapDomRestrBy_To : (m:(Map A)) (m':(Map B)) (m'':(Map C))
- (eqmap (MapDomRestrBy A C (MapDomRestrTo A B m m') m'')
- (MapDomRestrTo A B m (MapDomRestrBy B C m' m''))).
+ Lemma MapDomRestrBy_To :
+ forall (m:Map A) (m':Map B) (m'':Map C),
+ eqmap (MapDomRestrBy A C (MapDomRestrTo A B m m') m'')
+ (MapDomRestrTo A B m (MapDomRestrBy B C m' m'')).
Proof.
- Unfold eqmap eqm. Intros.
- Rewrite (MapDomRestrBy_semantics A C (MapDomRestrTo A B m m') m'' a).
- Rewrite (MapDomRestrTo_semantics A B m m' a).
- Rewrite (MapDomRestrTo_semantics A B m (MapDomRestrBy B C m' m'') a).
- Rewrite (MapDomRestrBy_semantics B C m' m'' a).
- Case (MapGet C m'' a); Case (MapGet B m' a); Trivial.
+ unfold eqmap, eqm in |- *. intros.
+ rewrite (MapDomRestrBy_semantics A C (MapDomRestrTo A B m m') m'' a).
+ rewrite (MapDomRestrTo_semantics A B m m' a).
+ rewrite (MapDomRestrTo_semantics A B m (MapDomRestrBy B C m' m'') a).
+ rewrite (MapDomRestrBy_semantics B C m' m'' a).
+ case (MapGet C m'' a); case (MapGet B m' a); trivial.
Qed.
- Lemma MapDomRestrBy_To_comm : (m:(Map A)) (m':(Map B)) (m'':(Map C))
- (eqmap (MapDomRestrBy A C (MapDomRestrTo A B m m') m'')
- (MapDomRestrTo A B (MapDomRestrBy A C m m'') m')).
+ Lemma MapDomRestrBy_To_comm :
+ forall (m:Map A) (m':Map B) (m'':Map C),
+ eqmap (MapDomRestrBy A C (MapDomRestrTo A B m m') m'')
+ (MapDomRestrTo A B (MapDomRestrBy A C m m'') m').
Proof.
- Unfold eqmap eqm. Intros.
- Rewrite (MapDomRestrBy_semantics A C (MapDomRestrTo A B m m') m'' a).
- Rewrite (MapDomRestrTo_semantics A B m m' a).
- Rewrite (MapDomRestrTo_semantics A B (MapDomRestrBy A C m m'') m' a).
- Rewrite (MapDomRestrBy_semantics A C m m'' a).
- Case (MapGet C m'' a); Case (MapGet B m' a); Trivial.
+ unfold eqmap, eqm in |- *. intros.
+ rewrite (MapDomRestrBy_semantics A C (MapDomRestrTo A B m m') m'' a).
+ rewrite (MapDomRestrTo_semantics A B m m' a).
+ rewrite (MapDomRestrTo_semantics A B (MapDomRestrBy A C m m'') m' a).
+ rewrite (MapDomRestrBy_semantics A C m m'' a).
+ case (MapGet C m'' a); case (MapGet B m' a); trivial.
Qed.
- Lemma MapDomRestrTo_By : (m:(Map A)) (m':(Map B)) (m'':(Map C))
- (eqmap (MapDomRestrTo A C (MapDomRestrBy A B m m') m'')
- (MapDomRestrTo A C m (MapDomRestrBy C B m'' m'))).
+ Lemma MapDomRestrTo_By :
+ forall (m:Map A) (m':Map B) (m'':Map C),
+ eqmap (MapDomRestrTo A C (MapDomRestrBy A B m m') m'')
+ (MapDomRestrTo A C m (MapDomRestrBy C B m'' m')).
Proof.
- Unfold eqmap eqm. Intros.
- Rewrite (MapDomRestrTo_semantics A C (MapDomRestrBy A B m m') m'' a).
- Rewrite (MapDomRestrBy_semantics A B m m' a).
- Rewrite (MapDomRestrTo_semantics A C m (MapDomRestrBy C B m'' m') a).
- Rewrite (MapDomRestrBy_semantics C B m'' m' a).
- Case (MapGet C m'' a); Case (MapGet B m' a); Trivial.
+ unfold eqmap, eqm in |- *. intros.
+ rewrite (MapDomRestrTo_semantics A C (MapDomRestrBy A B m m') m'' a).
+ rewrite (MapDomRestrBy_semantics A B m m' a).
+ rewrite (MapDomRestrTo_semantics A C m (MapDomRestrBy C B m'' m') a).
+ rewrite (MapDomRestrBy_semantics C B m'' m' a).
+ case (MapGet C m'' a); case (MapGet B m' a); trivial.
Qed.
- Lemma MapDomRestrTo_By_comm : (m:(Map A)) (m':(Map B)) (m'':(Map C))
- (eqmap (MapDomRestrTo A C (MapDomRestrBy A B m m') m'')
- (MapDomRestrBy A B (MapDomRestrTo A C m m'') m')).
+ Lemma MapDomRestrTo_By_comm :
+ forall (m:Map A) (m':Map B) (m'':Map C),
+ eqmap (MapDomRestrTo A C (MapDomRestrBy A B m m') m'')
+ (MapDomRestrBy A B (MapDomRestrTo A C m m'') m').
Proof.
- Unfold eqmap eqm. Intros.
- Rewrite (MapDomRestrTo_semantics A C (MapDomRestrBy A B m m') m'' a).
- Rewrite (MapDomRestrBy_semantics A B m m' a).
- Rewrite (MapDomRestrBy_semantics A B (MapDomRestrTo A C m m'') m' a).
- Rewrite (MapDomRestrTo_semantics A C m m'' a).
- Case (MapGet C m'' a); Case (MapGet B m' a); Trivial.
+ unfold eqmap, eqm in |- *. intros.
+ rewrite (MapDomRestrTo_semantics A C (MapDomRestrBy A B m m') m'' a).
+ rewrite (MapDomRestrBy_semantics A B m m' a).
+ rewrite (MapDomRestrBy_semantics A B (MapDomRestrTo A C m m'') m' a).
+ rewrite (MapDomRestrTo_semantics A C m m'' a).
+ case (MapGet C m'' a); case (MapGet B m' a); trivial.
Qed.
- Lemma MapDomRestrTo_To_comm : (m:(Map A)) (m':(Map B)) (m'':(Map C))
- (eqmap (MapDomRestrTo A C (MapDomRestrTo A B m m') m'')
- (MapDomRestrTo A B (MapDomRestrTo A C m m'') m')).
+ Lemma MapDomRestrTo_To_comm :
+ forall (m:Map A) (m':Map B) (m'':Map C),
+ eqmap (MapDomRestrTo A C (MapDomRestrTo A B m m') m'')
+ (MapDomRestrTo A B (MapDomRestrTo A C m m'') m').
Proof.
- Unfold eqmap eqm. Intros.
- Rewrite (MapDomRestrTo_semantics A C (MapDomRestrTo A B m m') m'' a).
- Rewrite (MapDomRestrTo_semantics A B m m' a).
- Rewrite (MapDomRestrTo_semantics A B (MapDomRestrTo A C m m'') m' a).
- Rewrite (MapDomRestrTo_semantics A C m m'' a).
- Case (MapGet C m'' a); Case (MapGet B m' a); Trivial.
+ unfold eqmap, eqm in |- *. intros.
+ rewrite (MapDomRestrTo_semantics A C (MapDomRestrTo A B m m') m'' a).
+ rewrite (MapDomRestrTo_semantics A B m m' a).
+ rewrite (MapDomRestrTo_semantics A B (MapDomRestrTo A C m m'') m' a).
+ rewrite (MapDomRestrTo_semantics A C m m'' a).
+ case (MapGet C m'' a); case (MapGet B m' a); trivial.
Qed.
- Lemma MapMerge_DomRestrTo : (m,m':(Map A)) (m'':(Map B))
- (eqmap (MapDomRestrTo A B (MapMerge A m m') m'')
- (MapMerge A (MapDomRestrTo A B m m'') (MapDomRestrTo A B m' m''))).
+ Lemma MapMerge_DomRestrTo :
+ forall (m m':Map A) (m'':Map B),
+ eqmap (MapDomRestrTo A B (MapMerge A m m') m'')
+ (MapMerge A (MapDomRestrTo A B m m'') (MapDomRestrTo A B m' m'')).
Proof.
- Unfold eqmap eqm. Intros.
- Rewrite (MapDomRestrTo_semantics A B (MapMerge A m m') m'' a).
- Rewrite (MapMerge_semantics A m m' a).
- Rewrite (MapMerge_semantics A (MapDomRestrTo A B m m'') (MapDomRestrTo A B m' m'') a).
- Rewrite (MapDomRestrTo_semantics A B m' m'' a).
- Rewrite (MapDomRestrTo_semantics A B m m'' a).
- Case (MapGet B m'' a); Case (MapGet A m' a); Trivial.
+ unfold eqmap, eqm in |- *. intros.
+ rewrite (MapDomRestrTo_semantics A B (MapMerge A m m') m'' a).
+ rewrite (MapMerge_semantics A m m' a).
+ rewrite
+ (MapMerge_semantics A (MapDomRestrTo A B m m'')
+ (MapDomRestrTo A B m' m'') a).
+ rewrite (MapDomRestrTo_semantics A B m' m'' a).
+ rewrite (MapDomRestrTo_semantics A B m m'' a).
+ case (MapGet B m'' a); case (MapGet A m' a); trivial.
Qed.
- Lemma MapMerge_DomRestrBy : (m,m':(Map A)) (m'':(Map B))
- (eqmap (MapDomRestrBy A B (MapMerge A m m') m'')
- (MapMerge A (MapDomRestrBy A B m m'') (MapDomRestrBy A B m' m''))).
+ Lemma MapMerge_DomRestrBy :
+ forall (m m':Map A) (m'':Map B),
+ eqmap (MapDomRestrBy A B (MapMerge A m m') m'')
+ (MapMerge A (MapDomRestrBy A B m m'') (MapDomRestrBy A B m' m'')).
Proof.
- Unfold eqmap eqm. Intros.
- Rewrite (MapDomRestrBy_semantics A B (MapMerge A m m') m'' a).
- Rewrite (MapMerge_semantics A m m' a).
- Rewrite (MapMerge_semantics A (MapDomRestrBy A B m m'') (MapDomRestrBy A B m' m'') a).
- Rewrite (MapDomRestrBy_semantics A B m' m'' a).
- Rewrite (MapDomRestrBy_semantics A B m m'' a).
- Case (MapGet B m'' a); Case (MapGet A m' a); Trivial.
+ unfold eqmap, eqm in |- *. intros.
+ rewrite (MapDomRestrBy_semantics A B (MapMerge A m m') m'' a).
+ rewrite (MapMerge_semantics A m m' a).
+ rewrite
+ (MapMerge_semantics A (MapDomRestrBy A B m m'')
+ (MapDomRestrBy A B m' m'') a).
+ rewrite (MapDomRestrBy_semantics A B m' m'' a).
+ rewrite (MapDomRestrBy_semantics A B m m'' a).
+ case (MapGet B m'' a); case (MapGet A m' a); trivial.
Qed.
- Lemma MapDelta_empty_m_1 : (m:(Map A)) (MapDelta A (M0 A) m)=m.
+ Lemma MapDelta_empty_m_1 : forall m:Map A, MapDelta A (M0 A) m = m.
Proof.
- Trivial.
+ trivial.
Qed.
- Lemma MapDelta_empty_m : (m:(Map A)) (eqmap (MapDelta A (M0 A) m) m).
+ Lemma MapDelta_empty_m : forall m:Map A, eqmap (MapDelta A (M0 A) m) m.
Proof.
- Unfold eqmap eqm. Trivial.
+ unfold eqmap, eqm in |- *. trivial.
Qed.
- Lemma MapDelta_m_empty_1 : (m:(Map A)) (MapDelta A m (M0 A))=m.
+ Lemma MapDelta_m_empty_1 : forall m:Map A, MapDelta A m (M0 A) = m.
Proof.
- Induction m;Trivial.
+ simple induction m; trivial.
Qed.
- Lemma MapDelta_m_empty : (m:(Map A)) (eqmap (MapDelta A m (M0 A)) m).
+ Lemma MapDelta_m_empty : forall m:Map A, eqmap (MapDelta A m (M0 A)) m.
Proof.
- Unfold eqmap eqm. Intros. Rewrite MapDelta_m_empty_1. Reflexivity.
+ unfold eqmap, eqm in |- *. intros. rewrite MapDelta_m_empty_1. reflexivity.
Qed.
- Lemma MapDelta_nilpotent : (m:(Map A)) (eqmap (MapDelta A m m) (M0 A)).
+ Lemma MapDelta_nilpotent : forall m:Map A, eqmap (MapDelta A m m) (M0 A).
Proof.
- Unfold eqmap eqm. Intros. Rewrite (MapDelta_semantics A m m a).
- Case (MapGet A m a); Trivial.
+ unfold eqmap, eqm in |- *. intros. rewrite (MapDelta_semantics A m m a).
+ case (MapGet A m a); trivial.
Qed.
- Lemma MapDelta_as_Merge : (m,m':(Map A)) (eqmap (MapDelta A m m')
- (MapMerge A (MapDomRestrBy A A m m') (MapDomRestrBy A A m' m))).
+ Lemma MapDelta_as_Merge :
+ forall m m':Map A,
+ eqmap (MapDelta A m m')
+ (MapMerge A (MapDomRestrBy A A m m') (MapDomRestrBy A A m' m)).
Proof.
- Unfold eqmap eqm. Intros.
- Rewrite (MapDelta_semantics A m m' a).
- Rewrite (MapMerge_semantics A (MapDomRestrBy A A m m') (MapDomRestrBy A A m' m) a).
- Rewrite (MapDomRestrBy_semantics A A m' m a).
- Rewrite (MapDomRestrBy_semantics A A m m' a).
- Case (MapGet A m a); Case (MapGet A m' a); Trivial.
+ unfold eqmap, eqm in |- *. intros.
+ rewrite (MapDelta_semantics A m m' a).
+ rewrite
+ (MapMerge_semantics A (MapDomRestrBy A A m m') (
+ MapDomRestrBy A A m' m) a).
+ rewrite (MapDomRestrBy_semantics A A m' m a).
+ rewrite (MapDomRestrBy_semantics A A m m' a).
+ case (MapGet A m a); case (MapGet A m' a); trivial.
Qed.
- Lemma MapDelta_as_DomRestrBy : (m,m':(Map A)) (eqmap (MapDelta A m m')
- (MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m m'))).
+ Lemma MapDelta_as_DomRestrBy :
+ forall m m':Map A,
+ eqmap (MapDelta A m m')
+ (MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m m')).
Proof.
- Unfold eqmap eqm. Intros. Rewrite (MapDelta_semantics A m m' a).
- Rewrite (MapDomRestrBy_semantics A A (MapMerge A m m') (MapDomRestrTo A A m m') a).
- Rewrite (MapDomRestrTo_semantics A A m m' a). Rewrite (MapMerge_semantics A m m' a).
- Case (MapGet A m a); Case (MapGet A m' a); Trivial.
+ unfold eqmap, eqm in |- *. intros. rewrite (MapDelta_semantics A m m' a).
+ rewrite
+ (MapDomRestrBy_semantics A A (MapMerge A m m') (
+ MapDomRestrTo A A m m') a).
+ rewrite (MapDomRestrTo_semantics A A m m' a). rewrite (MapMerge_semantics A m m' a).
+ case (MapGet A m a); case (MapGet A m' a); trivial.
Qed.
- Lemma MapDelta_as_DomRestrBy_2 : (m,m':(Map A)) (eqmap (MapDelta A m m')
- (MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m' m))).
+ Lemma MapDelta_as_DomRestrBy_2 :
+ forall m m':Map A,
+ eqmap (MapDelta A m m')
+ (MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m' m)).
Proof.
- Unfold eqmap eqm. Intros. Rewrite (MapDelta_semantics A m m' a).
- Rewrite (MapDomRestrBy_semantics A A (MapMerge A m m') (MapDomRestrTo A A m' m) a).
- Rewrite (MapDomRestrTo_semantics A A m' m a). Rewrite (MapMerge_semantics A m m' a).
- Case (MapGet A m a); Case (MapGet A m' a); Trivial.
+ unfold eqmap, eqm in |- *. intros. rewrite (MapDelta_semantics A m m' a).
+ rewrite
+ (MapDomRestrBy_semantics A A (MapMerge A m m') (
+ MapDomRestrTo A A m' m) a).
+ rewrite (MapDomRestrTo_semantics A A m' m a). rewrite (MapMerge_semantics A m m' a).
+ case (MapGet A m a); case (MapGet A m' a); trivial.
Qed.
- Lemma MapDelta_sym : (m,m':(Map A)) (eqmap (MapDelta A m m') (MapDelta A m' m)).
+ Lemma MapDelta_sym :
+ forall m m':Map A, eqmap (MapDelta A m m') (MapDelta A m' m).
Proof.
- Unfold eqmap eqm. Intros. Rewrite (MapDelta_semantics A m m' a).
- Rewrite (MapDelta_semantics A m' m a).
- Case (MapGet A m a); Case (MapGet A m' a); Trivial.
+ unfold eqmap, eqm in |- *. intros. rewrite (MapDelta_semantics A m m' a).
+ rewrite (MapDelta_semantics A m' m a).
+ case (MapGet A m a); case (MapGet A m' a); trivial.
Qed.
- Lemma MapDelta_ext : (m1,m2,m'1,m'2:(Map A))
- (eqmap m1 m'1) -> (eqmap m2 m'2) ->
- (eqmap (MapDelta A m1 m2) (MapDelta A m'1 m'2)).
+ Lemma MapDelta_ext :
+ forall m1 m2 m'1 m'2:Map A,
+ eqmap m1 m'1 ->
+ eqmap m2 m'2 -> eqmap (MapDelta A m1 m2) (MapDelta A m'1 m'2).
Proof.
- Unfold eqmap eqm. Intros. Rewrite (MapDelta_semantics A m1 m2 a).
- Rewrite (MapDelta_semantics A m'1 m'2 a). Rewrite (H a). Rewrite (H0 a). Reflexivity.
+ unfold eqmap, eqm in |- *. intros. rewrite (MapDelta_semantics A m1 m2 a).
+ rewrite (MapDelta_semantics A m'1 m'2 a). rewrite (H a). rewrite (H0 a). reflexivity.
Qed.
- Lemma MapDelta_ext_l : (m1,m'1,m2:(Map A))
- (eqmap m1 m'1) -> (eqmap (MapDelta A m1 m2) (MapDelta A m'1 m2)).
+ Lemma MapDelta_ext_l :
+ forall m1 m'1 m2:Map A,
+ eqmap m1 m'1 -> eqmap (MapDelta A m1 m2) (MapDelta A m'1 m2).
Proof.
- Intros. Apply MapDelta_ext. Assumption.
- Apply eqmap_refl.
+ intros. apply MapDelta_ext. assumption.
+ apply eqmap_refl.
Qed.
- Lemma MapDelta_ext_r : (m1,m2,m'2:(Map A))
- (eqmap m2 m'2) -> (eqmap (MapDelta A m1 m2) (MapDelta A m1 m'2)).
+ Lemma MapDelta_ext_r :
+ forall m1 m2 m'2:Map A,
+ eqmap m2 m'2 -> eqmap (MapDelta A m1 m2) (MapDelta A m1 m'2).
Proof.
- Intros. Apply MapDelta_ext. Apply eqmap_refl.
- Assumption.
+ intros. apply MapDelta_ext. apply eqmap_refl.
+ assumption.
Qed.
- Lemma MapDom_Split_1 : (m:(Map A)) (m':(Map B))
- (eqmap m (MapMerge A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m'))).
+ Lemma MapDom_Split_1 :
+ forall (m:Map A) (m':Map B),
+ eqmap m (MapMerge A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m')).
Proof.
- Unfold eqmap eqm. Intros.
- Rewrite (MapMerge_semantics A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m') a).
- Rewrite (MapDomRestrBy_semantics A B m m' a).
- Rewrite (MapDomRestrTo_semantics A B m m' a).
- Case (MapGet B m' a); Case (MapGet A m a); Trivial.
+ unfold eqmap, eqm in |- *. intros.
+ rewrite
+ (MapMerge_semantics A (MapDomRestrTo A B m m') (
+ MapDomRestrBy A B m m') a).
+ rewrite (MapDomRestrBy_semantics A B m m' a).
+ rewrite (MapDomRestrTo_semantics A B m m' a).
+ case (MapGet B m' a); case (MapGet A m a); trivial.
Qed.
- Lemma MapDom_Split_2 : (m:(Map A)) (m':(Map B))
- (eqmap m (MapMerge A (MapDomRestrBy A B m m') (MapDomRestrTo A B m m'))).
- Proof.
- Unfold eqmap eqm. Intros.
- Rewrite (MapMerge_semantics A (MapDomRestrBy A B m m') (MapDomRestrTo A B m m') a).
- Rewrite (MapDomRestrBy_semantics A B m m' a).
- Rewrite (MapDomRestrTo_semantics A B m m' a).
- Case (MapGet B m' a); Case (MapGet A m a); Trivial.
- Qed.
-
- Lemma MapDom_Split_3 : (m:(Map A)) (m':(Map B))
- (eqmap (MapDomRestrTo A A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m'))
- (M0 A)).
- Proof.
- Unfold eqmap eqm. Intros.
- Rewrite (MapDomRestrTo_semantics A A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m') a).
- Rewrite (MapDomRestrBy_semantics A B m m' a).
- Rewrite (MapDomRestrTo_semantics A B m m' a).
- Case (MapGet B m' a); Case (MapGet A m a); Trivial.
+ Lemma MapDom_Split_2 :
+ forall (m:Map A) (m':Map B),
+ eqmap m (MapMerge A (MapDomRestrBy A B m m') (MapDomRestrTo A B m m')).
+ Proof.
+ unfold eqmap, eqm in |- *. intros.
+ rewrite
+ (MapMerge_semantics A (MapDomRestrBy A B m m') (
+ MapDomRestrTo A B m m') a).
+ rewrite (MapDomRestrBy_semantics A B m m' a).
+ rewrite (MapDomRestrTo_semantics A B m m' a).
+ case (MapGet B m' a); case (MapGet A m a); trivial.
+ Qed.
+
+ Lemma MapDom_Split_3 :
+ forall (m:Map A) (m':Map B),
+ eqmap
+ (MapDomRestrTo A A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m'))
+ (M0 A).
+ Proof.
+ unfold eqmap, eqm in |- *. intros.
+ rewrite
+ (MapDomRestrTo_semantics A A (MapDomRestrTo A B m m')
+ (MapDomRestrBy A B m m') a).
+ rewrite (MapDomRestrBy_semantics A B m m' a).
+ rewrite (MapDomRestrTo_semantics A B m m' a).
+ case (MapGet B m' a); case (MapGet A m a); trivial.
Qed.
End MapAxioms.
-Lemma MapDomRestrTo_ext : (A,B:Set)
- (m1:(Map A)) (m2:(Map B)) (m'1:(Map A)) (m'2:(Map B))
- (eqmap A m1 m'1) -> (eqmap B m2 m'2) ->
- (eqmap A (MapDomRestrTo A B m1 m2) (MapDomRestrTo A B m'1 m'2)).
+Lemma MapDomRestrTo_ext :
+ forall (A B:Set) (m1:Map A) (m2:Map B) (m'1:Map A)
+ (m'2:Map B),
+ eqmap A m1 m'1 ->
+ eqmap B m2 m'2 ->
+ eqmap A (MapDomRestrTo A B m1 m2) (MapDomRestrTo A B m'1 m'2).
Proof.
- Unfold eqmap eqm. Intros. Rewrite (MapDomRestrTo_semantics A B m1 m2 a).
- Rewrite (MapDomRestrTo_semantics A B m'1 m'2 a). Rewrite (H a). Rewrite (H0 a). Reflexivity.
+ unfold eqmap, eqm in |- *. intros. rewrite (MapDomRestrTo_semantics A B m1 m2 a).
+ rewrite (MapDomRestrTo_semantics A B m'1 m'2 a). rewrite (H a). rewrite (H0 a). reflexivity.
Qed.
-Lemma MapDomRestrTo_ext_l : (A,B:Set) (m1:(Map A)) (m2:(Map B)) (m'1:(Map A))
- (eqmap A m1 m'1) ->
- (eqmap A (MapDomRestrTo A B m1 m2) (MapDomRestrTo A B m'1 m2)).
+Lemma MapDomRestrTo_ext_l :
+ forall (A B:Set) (m1:Map A) (m2:Map B) (m'1:Map A),
+ eqmap A m1 m'1 ->
+ eqmap A (MapDomRestrTo A B m1 m2) (MapDomRestrTo A B m'1 m2).
Proof.
- Intros. Apply MapDomRestrTo_ext; [ Assumption | Apply eqmap_refl ].
+ intros. apply MapDomRestrTo_ext; [ assumption | apply eqmap_refl ].
Qed.
-Lemma MapDomRestrTo_ext_r : (A,B:Set) (m1:(Map A)) (m2:(Map B)) (m'2:(Map B))
- (eqmap B m2 m'2) ->
- (eqmap A (MapDomRestrTo A B m1 m2) (MapDomRestrTo A B m1 m'2)).
+Lemma MapDomRestrTo_ext_r :
+ forall (A B:Set) (m1:Map A) (m2 m'2:Map B),
+ eqmap B m2 m'2 ->
+ eqmap A (MapDomRestrTo A B m1 m2) (MapDomRestrTo A B m1 m'2).
Proof.
- Intros. Apply MapDomRestrTo_ext; [ Apply eqmap_refl | Assumption ].
+ intros. apply MapDomRestrTo_ext; [ apply eqmap_refl | assumption ].
Qed.
-Lemma MapDomRestrBy_ext : (A,B:Set)
- (m1:(Map A)) (m2:(Map B)) (m'1:(Map A)) (m'2:(Map B))
- (eqmap A m1 m'1) -> (eqmap B m2 m'2) ->
- (eqmap A (MapDomRestrBy A B m1 m2) (MapDomRestrBy A B m'1 m'2)).
+Lemma MapDomRestrBy_ext :
+ forall (A B:Set) (m1:Map A) (m2:Map B) (m'1:Map A)
+ (m'2:Map B),
+ eqmap A m1 m'1 ->
+ eqmap B m2 m'2 ->
+ eqmap A (MapDomRestrBy A B m1 m2) (MapDomRestrBy A B m'1 m'2).
Proof.
- Unfold eqmap eqm. Intros. Rewrite (MapDomRestrBy_semantics A B m1 m2 a).
- Rewrite (MapDomRestrBy_semantics A B m'1 m'2 a). Rewrite (H a). Rewrite (H0 a). Reflexivity.
+ unfold eqmap, eqm in |- *. intros. rewrite (MapDomRestrBy_semantics A B m1 m2 a).
+ rewrite (MapDomRestrBy_semantics A B m'1 m'2 a). rewrite (H a). rewrite (H0 a). reflexivity.
Qed.
-Lemma MapDomRestrBy_ext_l : (A,B:Set) (m1:(Map A)) (m2:(Map B)) (m'1:(Map A))
- (eqmap A m1 m'1) ->
- (eqmap A (MapDomRestrBy A B m1 m2) (MapDomRestrBy A B m'1 m2)).
+Lemma MapDomRestrBy_ext_l :
+ forall (A B:Set) (m1:Map A) (m2:Map B) (m'1:Map A),
+ eqmap A m1 m'1 ->
+ eqmap A (MapDomRestrBy A B m1 m2) (MapDomRestrBy A B m'1 m2).
Proof.
- Intros. Apply MapDomRestrBy_ext; [ Assumption | Apply eqmap_refl ].
+ intros. apply MapDomRestrBy_ext; [ assumption | apply eqmap_refl ].
Qed.
-Lemma MapDomRestrBy_ext_r : (A,B:Set) (m1:(Map A)) (m2:(Map B)) (m'2:(Map B))
- (eqmap B m2 m'2) ->
- (eqmap A (MapDomRestrBy A B m1 m2) (MapDomRestrBy A B m1 m'2)).
+Lemma MapDomRestrBy_ext_r :
+ forall (A B:Set) (m1:Map A) (m2 m'2:Map B),
+ eqmap B m2 m'2 ->
+ eqmap A (MapDomRestrBy A B m1 m2) (MapDomRestrBy A B m1 m'2).
Proof.
- Intros. Apply MapDomRestrBy_ext; [ Apply eqmap_refl | Assumption ].
+ intros. apply MapDomRestrBy_ext; [ apply eqmap_refl | assumption ].
Qed.
-Lemma MapDomRestrBy_m_m : (A:Set) (m:(Map A))
- (eqmap A (MapDomRestrBy A unit m (MapDom A m)) (M0 A)).
+Lemma MapDomRestrBy_m_m :
+ forall (A:Set) (m:Map A),
+ eqmap A (MapDomRestrBy A unit m (MapDom A m)) (M0 A).
Proof.
- Intros. Apply eqmap_trans with m':=(MapDomRestrBy A A m m). Apply eqmap_sym.
- Apply MapDomRestrBy_Dom.
- Apply MapDomRestrBy_m_m_1.
+ intros. apply eqmap_trans with (m' := MapDomRestrBy A A m m). apply eqmap_sym.
+ apply MapDomRestrBy_Dom.
+ apply MapDomRestrBy_m_m_1.
Qed.
-Lemma FSetDelta_assoc : (s,s',s'':FSet)
- (eqmap unit (MapDelta ? (MapDelta ? s s') s'') (MapDelta ? s (MapDelta ? s' s''))).
+Lemma FSetDelta_assoc :
+ forall s s' s'':FSet,
+ eqmap unit (MapDelta _ (MapDelta _ s s') s'')
+ (MapDelta _ s (MapDelta _ s' s'')).
Proof.
- Unfold eqmap eqm. Intros. Rewrite (MapDelta_semantics unit (MapDelta unit s s') s'' a).
- Rewrite (MapDelta_semantics unit s s' a).
- Rewrite (MapDelta_semantics unit s (MapDelta unit s' s'') a).
- Rewrite (MapDelta_semantics unit s' s'' a).
- Case (MapGet ? s a); Case (MapGet ? s' a); Case (MapGet ? s'' a); Trivial.
- Intros. Elim u. Elim u1. Reflexivity.
+ unfold eqmap, eqm in |- *. intros. rewrite (MapDelta_semantics unit (MapDelta unit s s') s'' a).
+ rewrite (MapDelta_semantics unit s s' a).
+ rewrite (MapDelta_semantics unit s (MapDelta unit s' s'') a).
+ rewrite (MapDelta_semantics unit s' s'' a).
+ case (MapGet _ s a); case (MapGet _ s' a); case (MapGet _ s'' a); trivial.
+ intros. elim u. elim u1. reflexivity.
Qed.
-Lemma FSet_ext : (s,s':FSet) ((a:ad) (in_FSet a s)=(in_FSet a s')) -> (eqmap unit s s').
+Lemma FSet_ext :
+ forall s s':FSet,
+ (forall a:ad, in_FSet a s = in_FSet a s') -> eqmap unit s s'.
Proof.
- Unfold in_FSet eqmap eqm. Intros. Elim (sumbool_of_bool (in_dom ? a s)). Intro H0.
- Elim (in_dom_some ? s a H0). Intros y H1. Rewrite (H a) in H0. Elim (in_dom_some ? s' a H0).
- Intros y' H2. Rewrite H1. Rewrite H2. Elim y. Elim y'. Reflexivity.
- Intro H0. Rewrite (in_dom_none ? s a H0). Rewrite (H a) in H0. Rewrite (in_dom_none ? s' a H0).
- Reflexivity.
+ unfold in_FSet, eqmap, eqm in |- *. intros. elim (sumbool_of_bool (in_dom _ a s)). intro H0.
+ elim (in_dom_some _ s a H0). intros y H1. rewrite (H a) in H0. elim (in_dom_some _ s' a H0).
+ intros y' H2. rewrite H1. rewrite H2. elim y. elim y'. reflexivity.
+ intro H0. rewrite (in_dom_none _ s a H0). rewrite (H a) in H0. rewrite (in_dom_none _ s' a H0).
+ reflexivity.
Qed.
-Lemma FSetUnion_comm : (s,s':FSet) (eqmap unit (FSetUnion s s') (FSetUnion s' s)).
+Lemma FSetUnion_comm :
+ forall s s':FSet, eqmap unit (FSetUnion s s') (FSetUnion s' s).
Proof.
- Intros. Apply FSet_ext. Intro. Rewrite in_FSet_union. Rewrite in_FSet_union. Apply orb_sym.
+ intros. apply FSet_ext. intro. rewrite in_FSet_union. rewrite in_FSet_union. apply orb_comm.
Qed.
-Lemma FSetUnion_assoc : (s,s',s'':FSet) (eqmap unit
- (FSetUnion (FSetUnion s s') s'') (FSetUnion s (FSetUnion s' s''))).
+Lemma FSetUnion_assoc :
+ forall s s' s'':FSet,
+ eqmap unit (FSetUnion (FSetUnion s s') s'')
+ (FSetUnion s (FSetUnion s' s'')).
Proof.
- Exact (MapMerge_assoc unit).
+ exact (MapMerge_assoc unit).
Qed.
-Lemma FSetUnion_M0_s : (s:FSet) (eqmap unit (FSetUnion (M0 unit) s) s).
+Lemma FSetUnion_M0_s : forall s:FSet, eqmap unit (FSetUnion (M0 unit) s) s.
Proof.
- Exact (MapMerge_empty_m unit).
+ exact (MapMerge_empty_m unit).
Qed.
-Lemma FSetUnion_s_M0 : (s:FSet) (eqmap unit (FSetUnion s (M0 unit)) s).
+Lemma FSetUnion_s_M0 : forall s:FSet, eqmap unit (FSetUnion s (M0 unit)) s.
Proof.
- Exact (MapMerge_m_empty unit).
+ exact (MapMerge_m_empty unit).
Qed.
-Lemma FSetUnion_idempotent : (s:FSet) (eqmap unit (FSetUnion s s) s).
+Lemma FSetUnion_idempotent : forall s:FSet, eqmap unit (FSetUnion s s) s.
Proof.
- Exact (MapMerge_idempotent unit).
+ exact (MapMerge_idempotent unit).
Qed.
-Lemma FSetInter_comm : (s,s':FSet) (eqmap unit (FSetInter s s') (FSetInter s' s)).
+Lemma FSetInter_comm :
+ forall s s':FSet, eqmap unit (FSetInter s s') (FSetInter s' s).
Proof.
- Intros. Apply FSet_ext. Intro. Rewrite in_FSet_inter. Rewrite in_FSet_inter. Apply andb_sym.
+ intros. apply FSet_ext. intro. rewrite in_FSet_inter. rewrite in_FSet_inter. apply andb_comm.
Qed.
-Lemma FSetInter_assoc : (s,s',s'':FSet) (eqmap unit
- (FSetInter (FSetInter s s') s'') (FSetInter s (FSetInter s' s''))).
+Lemma FSetInter_assoc :
+ forall s s' s'':FSet,
+ eqmap unit (FSetInter (FSetInter s s') s'')
+ (FSetInter s (FSetInter s' s'')).
Proof.
- Exact (MapDomRestrTo_assoc unit unit unit).
+ exact (MapDomRestrTo_assoc unit unit unit).
Qed.
-Lemma FSetInter_M0_s : (s:FSet) (eqmap unit (FSetInter (M0 unit) s) (M0 unit)).
+Lemma FSetInter_M0_s :
+ forall s:FSet, eqmap unit (FSetInter (M0 unit) s) (M0 unit).
Proof.
- Exact (MapDomRestrTo_empty_m unit unit).
+ exact (MapDomRestrTo_empty_m unit unit).
Qed.
-Lemma FSetInter_s_M0 : (s:FSet) (eqmap unit (FSetInter s (M0 unit)) (M0 unit)).
+Lemma FSetInter_s_M0 :
+ forall s:FSet, eqmap unit (FSetInter s (M0 unit)) (M0 unit).
Proof.
- Exact (MapDomRestrTo_m_empty unit unit).
+ exact (MapDomRestrTo_m_empty unit unit).
Qed.
-Lemma FSetInter_idempotent : (s:FSet) (eqmap unit (FSetInter s s) s).
+Lemma FSetInter_idempotent : forall s:FSet, eqmap unit (FSetInter s s) s.
Proof.
- Exact (MapDomRestrTo_idempotent unit).
+ exact (MapDomRestrTo_idempotent unit).
Qed.
-Lemma FSetUnion_Inter_l : (s,s',s'':FSet) (eqmap unit
- (FSetUnion (FSetInter s s') s'') (FSetInter (FSetUnion s s'') (FSetUnion s' s''))).
+Lemma FSetUnion_Inter_l :
+ forall s s' s'':FSet,
+ eqmap unit (FSetUnion (FSetInter s s') s'')
+ (FSetInter (FSetUnion s s'') (FSetUnion s' s'')).
Proof.
- Intros. Apply FSet_ext. Intro. Rewrite in_FSet_union. Rewrite in_FSet_inter.
- Rewrite in_FSet_inter. Rewrite in_FSet_union. Rewrite in_FSet_union.
- Case (in_FSet a s); Case (in_FSet a s'); Case (in_FSet a s''); Reflexivity.
+ intros. apply FSet_ext. intro. rewrite in_FSet_union. rewrite in_FSet_inter.
+ rewrite in_FSet_inter. rewrite in_FSet_union. rewrite in_FSet_union.
+ case (in_FSet a s); case (in_FSet a s'); case (in_FSet a s''); reflexivity.
Qed.
-Lemma FSetUnion_Inter_r : (s,s',s'':FSet) (eqmap unit
- (FSetUnion s (FSetInter s' s'')) (FSetInter (FSetUnion s s') (FSetUnion s s''))).
+Lemma FSetUnion_Inter_r :
+ forall s s' s'':FSet,
+ eqmap unit (FSetUnion s (FSetInter s' s''))
+ (FSetInter (FSetUnion s s') (FSetUnion s s'')).
Proof.
- Intros. Apply FSet_ext. Intro. Rewrite in_FSet_union. Rewrite in_FSet_inter.
- Rewrite in_FSet_inter. Rewrite in_FSet_union. Rewrite in_FSet_union.
- Case (in_FSet a s); Case (in_FSet a s'); Case (in_FSet a s''); Reflexivity.
+ intros. apply FSet_ext. intro. rewrite in_FSet_union. rewrite in_FSet_inter.
+ rewrite in_FSet_inter. rewrite in_FSet_union. rewrite in_FSet_union.
+ case (in_FSet a s); case (in_FSet a s'); case (in_FSet a s''); reflexivity.
Qed.
-Lemma FSetInter_Union_l : (s,s',s'':FSet) (eqmap unit
- (FSetInter (FSetUnion s s') s'') (FSetUnion (FSetInter s s'') (FSetInter s' s''))).
+Lemma FSetInter_Union_l :
+ forall s s' s'':FSet,
+ eqmap unit (FSetInter (FSetUnion s s') s'')
+ (FSetUnion (FSetInter s s'') (FSetInter s' s'')).
Proof.
- Intros. Apply FSet_ext. Intro. Rewrite in_FSet_inter. Rewrite in_FSet_union.
- Rewrite in_FSet_union. Rewrite in_FSet_inter. Rewrite in_FSet_inter.
- Case (in_FSet a s); Case (in_FSet a s'); Case (in_FSet a s''); Reflexivity.
+ intros. apply FSet_ext. intro. rewrite in_FSet_inter. rewrite in_FSet_union.
+ rewrite in_FSet_union. rewrite in_FSet_inter. rewrite in_FSet_inter.
+ case (in_FSet a s); case (in_FSet a s'); case (in_FSet a s''); reflexivity.
Qed.
-Lemma FSetInter_Union_r : (s,s',s'':FSet) (eqmap unit
- (FSetInter s (FSetUnion s' s'')) (FSetUnion (FSetInter s s') (FSetInter s s''))).
+Lemma FSetInter_Union_r :
+ forall s s' s'':FSet,
+ eqmap unit (FSetInter s (FSetUnion s' s''))
+ (FSetUnion (FSetInter s s') (FSetInter s s'')).
Proof.
- Intros. Apply FSet_ext. Intro. Rewrite in_FSet_inter. Rewrite in_FSet_union.
- Rewrite in_FSet_union. Rewrite in_FSet_inter. Rewrite in_FSet_inter.
- Case (in_FSet a s); Case (in_FSet a s'); Case (in_FSet a s''); Reflexivity.
-Qed.
+ intros. apply FSet_ext. intro. rewrite in_FSet_inter. rewrite in_FSet_union.
+ rewrite in_FSet_union. rewrite in_FSet_inter. rewrite in_FSet_inter.
+ case (in_FSet a s); case (in_FSet a s'); case (in_FSet a s''); reflexivity.
+Qed. \ No newline at end of file
diff --git a/theories/IntMap/Mapc.v b/theories/IntMap/Mapc.v
index b7cede944..8420ba381 100644
--- a/theories/IntMap/Mapc.v
+++ b/theories/IntMap/Mapc.v
@@ -7,451 +7,536 @@
(***********************************************************************)
(*i $Id$ i*)
-Require Bool.
-Require Sumbool.
-Require Arith.
-Require ZArith.
-Require Addr.
-Require Adist.
-Require Addec.
-Require Map.
-Require Mapaxioms.
-Require Fset.
-Require Mapiter.
-Require Mapsubset.
-Require PolyList.
-Require Lsort.
-Require Mapcard.
-Require Mapcanon.
+Require Import Bool.
+Require Import Sumbool.
+Require Import Arith.
+Require Import ZArith.
+Require Import Addr.
+Require Import Adist.
+Require Import Addec.
+Require Import Map.
+Require Import Mapaxioms.
+Require Import Fset.
+Require Import Mapiter.
+Require Import Mapsubset.
+Require Import List.
+Require Import Lsort.
+Require Import Mapcard.
+Require Import Mapcanon.
Section MapC.
- Variable A, B, C : Set.
+ Variables A B C : Set.
- Lemma MapPut_as_Merge_c : (m:(Map A)) (mapcanon A m) ->
- (a:ad) (y:A) (MapPut A m a y)=(MapMerge A m (M1 A a y)).
+ Lemma MapPut_as_Merge_c :
+ forall m:Map A,
+ mapcanon A m ->
+ forall (a:ad) (y:A), MapPut A m a y = MapMerge A m (M1 A a y).
Proof.
- Intros. Apply mapcanon_unique. Exact (MapPut_canon A m H a y).
- Apply MapMerge_canon. Assumption.
- Apply M1_canon.
- Apply MapPut_as_Merge.
+ intros. apply mapcanon_unique. exact (MapPut_canon A m H a y).
+ apply MapMerge_canon. assumption.
+ apply M1_canon.
+ apply MapPut_as_Merge.
Qed.
- Lemma MapPut_behind_as_Merge_c : (m:(Map A)) (mapcanon A m) ->
- (a:ad) (y:A) (MapPut_behind A m a y)=(MapMerge A (M1 A a y) m).
+ Lemma MapPut_behind_as_Merge_c :
+ forall m:Map A,
+ mapcanon A m ->
+ forall (a:ad) (y:A), MapPut_behind A m a y = MapMerge A (M1 A a y) m.
Proof.
- Intros. Apply mapcanon_unique. Exact (MapPut_behind_canon A m H a y).
- Apply MapMerge_canon. Apply M1_canon.
- Assumption.
- Apply MapPut_behind_as_Merge.
+ intros. apply mapcanon_unique. exact (MapPut_behind_canon A m H a y).
+ apply MapMerge_canon. apply M1_canon.
+ assumption.
+ apply MapPut_behind_as_Merge.
Qed.
- Lemma MapMerge_empty_m_c : (m:(Map A)) (MapMerge A (M0 A) m)=m.
+ Lemma MapMerge_empty_m_c : forall m:Map A, MapMerge A (M0 A) m = m.
Proof.
- Trivial.
+ trivial.
Qed.
- Lemma MapMerge_assoc_c : (m,m',m'':(Map A))
- (mapcanon A m) -> (mapcanon A m') -> (mapcanon A m'') ->
- (MapMerge A (MapMerge A m m') m'')=(MapMerge A m (MapMerge A m' m'')).
+ Lemma MapMerge_assoc_c :
+ forall m m' m'':Map A,
+ mapcanon A m ->
+ mapcanon A m' ->
+ mapcanon A m'' ->
+ MapMerge A (MapMerge A m m') m'' = MapMerge A m (MapMerge A m' m'').
Proof.
- Intros. Apply mapcanon_unique.
- (Apply MapMerge_canon; Try Assumption). (Apply MapMerge_canon; Try Assumption).
- (Apply MapMerge_canon; Try Assumption). (Apply MapMerge_canon; Try Assumption).
- Apply MapMerge_assoc.
+ intros. apply mapcanon_unique.
+ apply MapMerge_canon; try assumption. apply MapMerge_canon; try assumption.
+ apply MapMerge_canon; try assumption. apply MapMerge_canon; try assumption.
+ apply MapMerge_assoc.
Qed.
- Lemma MapMerge_idempotent_c : (m:(Map A)) (mapcanon A m) -> (MapMerge A m m)=m.
+ Lemma MapMerge_idempotent_c :
+ forall m:Map A, mapcanon A m -> MapMerge A m m = m.
Proof.
- Intros. Apply mapcanon_unique. (Apply MapMerge_canon; Assumption).
- Assumption.
- Apply MapMerge_idempotent.
+ intros. apply mapcanon_unique. apply MapMerge_canon; assumption.
+ assumption.
+ apply MapMerge_idempotent.
Qed.
- Lemma MapMerge_RestrTo_l_c : (m,m',m'':(Map A))
- (mapcanon A m) -> (mapcanon A m'') ->
- (MapMerge A (MapDomRestrTo A A m m') m'')=
- (MapDomRestrTo A A (MapMerge A m m'') (MapMerge A m' m'')).
+ Lemma MapMerge_RestrTo_l_c :
+ forall m m' m'':Map A,
+ mapcanon A m ->
+ mapcanon A m'' ->
+ MapMerge A (MapDomRestrTo A A m m') m'' =
+ MapDomRestrTo A A (MapMerge A m m'') (MapMerge A m' m'').
Proof.
- Intros. Apply mapcanon_unique. Apply MapMerge_canon. Apply MapDomRestrTo_canon; Assumption.
- Assumption.
- Apply MapDomRestrTo_canon; Apply MapMerge_canon; Assumption.
- Apply MapMerge_RestrTo_l.
+ intros. apply mapcanon_unique. apply MapMerge_canon. apply MapDomRestrTo_canon; assumption.
+ assumption.
+ apply MapDomRestrTo_canon; apply MapMerge_canon; assumption.
+ apply MapMerge_RestrTo_l.
Qed.
- Lemma MapRemove_as_RestrBy_c : (m:(Map A)) (mapcanon A m) ->
- (a:ad) (y:B) (MapRemove A m a)=(MapDomRestrBy A B m (M1 B a y)).
+ Lemma MapRemove_as_RestrBy_c :
+ forall m:Map A,
+ mapcanon A m ->
+ forall (a:ad) (y:B), MapRemove A m a = MapDomRestrBy A B m (M1 B a y).
Proof.
- Intros. Apply mapcanon_unique. (Apply MapRemove_canon; Assumption).
- (Apply MapDomRestrBy_canon; Assumption).
- Apply MapRemove_as_RestrBy.
+ intros. apply mapcanon_unique. apply MapRemove_canon; assumption.
+ apply MapDomRestrBy_canon; assumption.
+ apply MapRemove_as_RestrBy.
Qed.
- Lemma MapDomRestrTo_assoc_c : (m:(Map A)) (m':(Map B)) (m'':(Map C))
- (mapcanon A m) ->
- (MapDomRestrTo A C (MapDomRestrTo A B m m') m'')=
- (MapDomRestrTo A B m (MapDomRestrTo B C m' m'')).
+ Lemma MapDomRestrTo_assoc_c :
+ forall (m:Map A) (m':Map B) (m'':Map C),
+ mapcanon A m ->
+ MapDomRestrTo A C (MapDomRestrTo A B m m') m'' =
+ MapDomRestrTo A B m (MapDomRestrTo B C m' m'').
Proof.
- Intros. Apply mapcanon_unique. (Apply MapDomRestrTo_canon; Try Assumption).
- (Apply MapDomRestrTo_canon; Try Assumption).
- (Apply MapDomRestrTo_canon; Try Assumption).
- Apply MapDomRestrTo_assoc.
+ intros. apply mapcanon_unique. apply MapDomRestrTo_canon; try assumption.
+ apply MapDomRestrTo_canon; try assumption.
+ apply MapDomRestrTo_canon; try assumption.
+ apply MapDomRestrTo_assoc.
Qed.
- Lemma MapDomRestrTo_idempotent_c : (m:(Map A)) (mapcanon A m) ->
- (MapDomRestrTo A A m m)=m.
+ Lemma MapDomRestrTo_idempotent_c :
+ forall m:Map A, mapcanon A m -> MapDomRestrTo A A m m = m.
Proof.
- Intros. Apply mapcanon_unique. (Apply MapDomRestrTo_canon; Assumption).
- Assumption.
- Apply MapDomRestrTo_idempotent.
+ intros. apply mapcanon_unique. apply MapDomRestrTo_canon; assumption.
+ assumption.
+ apply MapDomRestrTo_idempotent.
Qed.
- Lemma MapDomRestrTo_Dom_c : (m:(Map A)) (m':(Map B)) (mapcanon A m) ->
- (MapDomRestrTo A B m m')=(MapDomRestrTo A unit m (MapDom B m')).
+ Lemma MapDomRestrTo_Dom_c :
+ forall (m:Map A) (m':Map B),
+ mapcanon A m ->
+ MapDomRestrTo A B m m' = MapDomRestrTo A unit m (MapDom B m').
Proof.
- Intros. Apply mapcanon_unique. (Apply MapDomRestrTo_canon; Assumption).
- (Apply MapDomRestrTo_canon; Assumption).
- Apply MapDomRestrTo_Dom.
+ intros. apply mapcanon_unique. apply MapDomRestrTo_canon; assumption.
+ apply MapDomRestrTo_canon; assumption.
+ apply MapDomRestrTo_Dom.
Qed.
- Lemma MapDomRestrBy_Dom_c : (m:(Map A)) (m':(Map B)) (mapcanon A m) ->
- (MapDomRestrBy A B m m')=(MapDomRestrBy A unit m (MapDom B m')).
+ Lemma MapDomRestrBy_Dom_c :
+ forall (m:Map A) (m':Map B),
+ mapcanon A m ->
+ MapDomRestrBy A B m m' = MapDomRestrBy A unit m (MapDom B m').
Proof.
- Intros. Apply mapcanon_unique. Apply MapDomRestrBy_canon; Assumption.
- Apply MapDomRestrBy_canon; Assumption.
- Apply MapDomRestrBy_Dom.
+ intros. apply mapcanon_unique. apply MapDomRestrBy_canon; assumption.
+ apply MapDomRestrBy_canon; assumption.
+ apply MapDomRestrBy_Dom.
Qed.
- Lemma MapDomRestrBy_By_c : (m:(Map A)) (m':(Map B)) (m'':(Map B))
- (mapcanon A m) ->
- (MapDomRestrBy A B (MapDomRestrBy A B m m') m'')=
- (MapDomRestrBy A B m (MapMerge B m' m'')).
+ Lemma MapDomRestrBy_By_c :
+ forall (m:Map A) (m' m'':Map B),
+ mapcanon A m ->
+ MapDomRestrBy A B (MapDomRestrBy A B m m') m'' =
+ MapDomRestrBy A B m (MapMerge B m' m'').
Proof.
- Intros. Apply mapcanon_unique. (Apply MapDomRestrBy_canon; Try Assumption).
- (Apply MapDomRestrBy_canon; Try Assumption).
- (Apply MapDomRestrBy_canon; Try Assumption).
- Apply MapDomRestrBy_By.
+ intros. apply mapcanon_unique. apply MapDomRestrBy_canon; try assumption.
+ apply MapDomRestrBy_canon; try assumption.
+ apply MapDomRestrBy_canon; try assumption.
+ apply MapDomRestrBy_By.
Qed.
- Lemma MapDomRestrBy_By_comm_c : (m:(Map A)) (m':(Map B)) (m'':(Map C))
- (mapcanon A m) ->
- (MapDomRestrBy A C (MapDomRestrBy A B m m') m'')=
- (MapDomRestrBy A B (MapDomRestrBy A C m m'') m').
+ Lemma MapDomRestrBy_By_comm_c :
+ forall (m:Map A) (m':Map B) (m'':Map C),
+ mapcanon A m ->
+ MapDomRestrBy A C (MapDomRestrBy A B m m') m'' =
+ MapDomRestrBy A B (MapDomRestrBy A C m m'') m'.
Proof.
- Intros. Apply mapcanon_unique. Apply MapDomRestrBy_canon.
- (Apply MapDomRestrBy_canon; Assumption).
- Apply MapDomRestrBy_canon. (Apply MapDomRestrBy_canon; Assumption).
- Apply MapDomRestrBy_By_comm.
+ intros. apply mapcanon_unique. apply MapDomRestrBy_canon.
+ apply MapDomRestrBy_canon; assumption.
+ apply MapDomRestrBy_canon. apply MapDomRestrBy_canon; assumption.
+ apply MapDomRestrBy_By_comm.
Qed.
- Lemma MapDomRestrBy_To_c : (m:(Map A)) (m':(Map B)) (m'':(Map C))
- (mapcanon A m) ->
- (MapDomRestrBy A C (MapDomRestrTo A B m m') m'')=
- (MapDomRestrTo A B m (MapDomRestrBy B C m' m'')).
+ Lemma MapDomRestrBy_To_c :
+ forall (m:Map A) (m':Map B) (m'':Map C),
+ mapcanon A m ->
+ MapDomRestrBy A C (MapDomRestrTo A B m m') m'' =
+ MapDomRestrTo A B m (MapDomRestrBy B C m' m'').
Proof.
- Intros. Apply mapcanon_unique. Apply MapDomRestrBy_canon.
- (Apply MapDomRestrTo_canon; Assumption).
- (Apply MapDomRestrTo_canon; Assumption).
- Apply MapDomRestrBy_To.
+ intros. apply mapcanon_unique. apply MapDomRestrBy_canon.
+ apply MapDomRestrTo_canon; assumption.
+ apply MapDomRestrTo_canon; assumption.
+ apply MapDomRestrBy_To.
Qed.
- Lemma MapDomRestrBy_To_comm_c : (m:(Map A)) (m':(Map B)) (m'':(Map C))
- (mapcanon A m) ->
- (MapDomRestrBy A C (MapDomRestrTo A B m m') m'')=
- (MapDomRestrTo A B (MapDomRestrBy A C m m'') m').
+ Lemma MapDomRestrBy_To_comm_c :
+ forall (m:Map A) (m':Map B) (m'':Map C),
+ mapcanon A m ->
+ MapDomRestrBy A C (MapDomRestrTo A B m m') m'' =
+ MapDomRestrTo A B (MapDomRestrBy A C m m'') m'.
Proof.
- Intros. Apply mapcanon_unique. Apply MapDomRestrBy_canon.
- Apply MapDomRestrTo_canon; Assumption.
- Apply MapDomRestrTo_canon. Apply MapDomRestrBy_canon; Assumption.
- Apply MapDomRestrBy_To_comm.
+ intros. apply mapcanon_unique. apply MapDomRestrBy_canon.
+ apply MapDomRestrTo_canon; assumption.
+ apply MapDomRestrTo_canon. apply MapDomRestrBy_canon; assumption.
+ apply MapDomRestrBy_To_comm.
Qed.
- Lemma MapDomRestrTo_By_c : (m:(Map A)) (m':(Map B)) (m'':(Map C))
- (mapcanon A m) ->
- (MapDomRestrTo A C (MapDomRestrBy A B m m') m'')=
- (MapDomRestrTo A C m (MapDomRestrBy C B m'' m')).
+ Lemma MapDomRestrTo_By_c :
+ forall (m:Map A) (m':Map B) (m'':Map C),
+ mapcanon A m ->
+ MapDomRestrTo A C (MapDomRestrBy A B m m') m'' =
+ MapDomRestrTo A C m (MapDomRestrBy C B m'' m').
Proof.
- Intros. Apply mapcanon_unique. Apply MapDomRestrTo_canon.
- Apply MapDomRestrBy_canon; Assumption.
- Apply MapDomRestrTo_canon; Assumption.
- Apply MapDomRestrTo_By.
+ intros. apply mapcanon_unique. apply MapDomRestrTo_canon.
+ apply MapDomRestrBy_canon; assumption.
+ apply MapDomRestrTo_canon; assumption.
+ apply MapDomRestrTo_By.
Qed.
- Lemma MapDomRestrTo_By_comm_c : (m:(Map A)) (m':(Map B)) (m'':(Map C))
- (mapcanon A m) ->
- (MapDomRestrTo A C (MapDomRestrBy A B m m') m'')=
- (MapDomRestrBy A B (MapDomRestrTo A C m m'') m').
+ Lemma MapDomRestrTo_By_comm_c :
+ forall (m:Map A) (m':Map B) (m'':Map C),
+ mapcanon A m ->
+ MapDomRestrTo A C (MapDomRestrBy A B m m') m'' =
+ MapDomRestrBy A B (MapDomRestrTo A C m m'') m'.
Proof.
- Intros. Apply mapcanon_unique. Apply MapDomRestrTo_canon.
- (Apply MapDomRestrBy_canon; Assumption).
- Apply MapDomRestrBy_canon. (Apply MapDomRestrTo_canon; Assumption).
- Apply MapDomRestrTo_By_comm.
+ intros. apply mapcanon_unique. apply MapDomRestrTo_canon.
+ apply MapDomRestrBy_canon; assumption.
+ apply MapDomRestrBy_canon. apply MapDomRestrTo_canon; assumption.
+ apply MapDomRestrTo_By_comm.
Qed.
- Lemma MapDomRestrTo_To_comm_c : (m:(Map A)) (m':(Map B)) (m'':(Map C))
- (mapcanon A m) ->
- (MapDomRestrTo A C (MapDomRestrTo A B m m') m'')=
- (MapDomRestrTo A B (MapDomRestrTo A C m m'') m').
+ Lemma MapDomRestrTo_To_comm_c :
+ forall (m:Map A) (m':Map B) (m'':Map C),
+ mapcanon A m ->
+ MapDomRestrTo A C (MapDomRestrTo A B m m') m'' =
+ MapDomRestrTo A B (MapDomRestrTo A C m m'') m'.
Proof.
- Intros. Apply mapcanon_unique. Apply MapDomRestrTo_canon.
- Apply MapDomRestrTo_canon; Assumption.
- Apply MapDomRestrTo_canon. Apply MapDomRestrTo_canon; Assumption.
- Apply MapDomRestrTo_To_comm.
+ intros. apply mapcanon_unique. apply MapDomRestrTo_canon.
+ apply MapDomRestrTo_canon; assumption.
+ apply MapDomRestrTo_canon. apply MapDomRestrTo_canon; assumption.
+ apply MapDomRestrTo_To_comm.
Qed.
- Lemma MapMerge_DomRestrTo_c : (m,m':(Map A)) (m'':(Map B))
- (mapcanon A m) -> (mapcanon A m') ->
- (MapDomRestrTo A B (MapMerge A m m') m'')=
- (MapMerge A (MapDomRestrTo A B m m'') (MapDomRestrTo A B m' m'')).
+ Lemma MapMerge_DomRestrTo_c :
+ forall (m m':Map A) (m'':Map B),
+ mapcanon A m ->
+ mapcanon A m' ->
+ MapDomRestrTo A B (MapMerge A m m') m'' =
+ MapMerge A (MapDomRestrTo A B m m'') (MapDomRestrTo A B m' m'').
Proof.
- Intros. Apply mapcanon_unique. Apply MapDomRestrTo_canon.
- (Apply MapMerge_canon; Assumption).
- Apply MapMerge_canon. (Apply MapDomRestrTo_canon; Assumption).
- (Apply MapDomRestrTo_canon; Assumption).
- Apply MapMerge_DomRestrTo.
+ intros. apply mapcanon_unique. apply MapDomRestrTo_canon.
+ apply MapMerge_canon; assumption.
+ apply MapMerge_canon. apply MapDomRestrTo_canon; assumption.
+ apply MapDomRestrTo_canon; assumption.
+ apply MapMerge_DomRestrTo.
Qed.
- Lemma MapMerge_DomRestrBy_c : (m,m':(Map A)) (m'':(Map B))
- (mapcanon A m) -> (mapcanon A m') ->
- (MapDomRestrBy A B (MapMerge A m m') m'')=
- (MapMerge A (MapDomRestrBy A B m m'') (MapDomRestrBy A B m' m'')).
+ Lemma MapMerge_DomRestrBy_c :
+ forall (m m':Map A) (m'':Map B),
+ mapcanon A m ->
+ mapcanon A m' ->
+ MapDomRestrBy A B (MapMerge A m m') m'' =
+ MapMerge A (MapDomRestrBy A B m m'') (MapDomRestrBy A B m' m'').
Proof.
- Intros. Apply mapcanon_unique. Apply MapDomRestrBy_canon. Apply MapMerge_canon; Assumption.
- Apply MapMerge_canon. Apply MapDomRestrBy_canon; Assumption.
- Apply MapDomRestrBy_canon; Assumption.
- Apply MapMerge_DomRestrBy.
+ intros. apply mapcanon_unique. apply MapDomRestrBy_canon. apply MapMerge_canon; assumption.
+ apply MapMerge_canon. apply MapDomRestrBy_canon; assumption.
+ apply MapDomRestrBy_canon; assumption.
+ apply MapMerge_DomRestrBy.
Qed.
- Lemma MapDelta_nilpotent_c : (m:(Map A)) (mapcanon A m) ->
- (MapDelta A m m)=(M0 A).
+ Lemma MapDelta_nilpotent_c :
+ forall m:Map A, mapcanon A m -> MapDelta A m m = M0 A.
Proof.
- Intros. Apply mapcanon_unique. (Apply MapDelta_canon; Assumption).
- Apply M0_canon.
- Apply MapDelta_nilpotent.
+ intros. apply mapcanon_unique. apply MapDelta_canon; assumption.
+ apply M0_canon.
+ apply MapDelta_nilpotent.
Qed.
- Lemma MapDelta_as_Merge_c : (m,m':(Map A))
- (mapcanon A m) -> (mapcanon A m') ->
- (MapDelta A m m')=
- (MapMerge A (MapDomRestrBy A A m m') (MapDomRestrBy A A m' m)).
+ Lemma MapDelta_as_Merge_c :
+ forall m m':Map A,
+ mapcanon A m ->
+ mapcanon A m' ->
+ MapDelta A m m' =
+ MapMerge A (MapDomRestrBy A A m m') (MapDomRestrBy A A m' m).
Proof.
- Intros. Apply mapcanon_unique. (Apply MapDelta_canon; Assumption).
- (Apply MapMerge_canon; Apply MapDomRestrBy_canon; Assumption).
- Apply MapDelta_as_Merge.
+ intros. apply mapcanon_unique. apply MapDelta_canon; assumption.
+ apply MapMerge_canon; apply MapDomRestrBy_canon; assumption.
+ apply MapDelta_as_Merge.
Qed.
- Lemma MapDelta_as_DomRestrBy_c : (m,m':(Map A))
- (mapcanon A m) -> (mapcanon A m') ->
- (MapDelta A m m')=
- (MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m m')).
+ Lemma MapDelta_as_DomRestrBy_c :
+ forall m m':Map A,
+ mapcanon A m ->
+ mapcanon A m' ->
+ MapDelta A m m' =
+ MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m m').
Proof.
- Intros. Apply mapcanon_unique. Apply MapDelta_canon; Assumption.
- Apply MapDomRestrBy_canon. (Apply MapMerge_canon; Assumption).
- Apply MapDelta_as_DomRestrBy.
+ intros. apply mapcanon_unique. apply MapDelta_canon; assumption.
+ apply MapDomRestrBy_canon. apply MapMerge_canon; assumption.
+ apply MapDelta_as_DomRestrBy.
Qed.
- Lemma MapDelta_as_DomRestrBy_2_c : (m,m':(Map A))
- (mapcanon A m) -> (mapcanon A m') ->
- (MapDelta A m m')=
- (MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m' m)).
+ Lemma MapDelta_as_DomRestrBy_2_c :
+ forall m m':Map A,
+ mapcanon A m ->
+ mapcanon A m' ->
+ MapDelta A m m' =
+ MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m' m).
Proof.
- Intros. Apply mapcanon_unique. (Apply MapDelta_canon; Assumption).
- Apply MapDomRestrBy_canon. Apply MapMerge_canon; Assumption.
- Apply MapDelta_as_DomRestrBy_2.
+ intros. apply mapcanon_unique. apply MapDelta_canon; assumption.
+ apply MapDomRestrBy_canon. apply MapMerge_canon; assumption.
+ apply MapDelta_as_DomRestrBy_2.
Qed.
- Lemma MapDelta_sym_c : (m,m':(Map A))
- (mapcanon A m) -> (mapcanon A m') -> (MapDelta A m m')=(MapDelta A m' m).
+ Lemma MapDelta_sym_c :
+ forall m m':Map A,
+ mapcanon A m -> mapcanon A m' -> MapDelta A m m' = MapDelta A m' m.
Proof.
- Intros. Apply mapcanon_unique. (Apply MapDelta_canon; Assumption).
- (Apply MapDelta_canon; Assumption). Apply MapDelta_sym.
+ intros. apply mapcanon_unique. apply MapDelta_canon; assumption.
+ apply MapDelta_canon; assumption. apply MapDelta_sym.
Qed.
- Lemma MapDom_Split_1_c : (m:(Map A)) (m':(Map B)) (mapcanon A m) ->
- m=(MapMerge A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m')).
+ Lemma MapDom_Split_1_c :
+ forall (m:Map A) (m':Map B),
+ mapcanon A m ->
+ m = MapMerge A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m').
Proof.
- Intros. Apply mapcanon_unique. Assumption.
- Apply MapMerge_canon. Apply MapDomRestrTo_canon; Assumption.
- Apply MapDomRestrBy_canon; Assumption.
- Apply MapDom_Split_1.
+ intros. apply mapcanon_unique. assumption.
+ apply MapMerge_canon. apply MapDomRestrTo_canon; assumption.
+ apply MapDomRestrBy_canon; assumption.
+ apply MapDom_Split_1.
Qed.
- Lemma MapDom_Split_2_c : (m:(Map A)) (m':(Map B)) (mapcanon A m) ->
- m=(MapMerge A (MapDomRestrBy A B m m') (MapDomRestrTo A B m m')).
+ Lemma MapDom_Split_2_c :
+ forall (m:Map A) (m':Map B),
+ mapcanon A m ->
+ m = MapMerge A (MapDomRestrBy A B m m') (MapDomRestrTo A B m m').
Proof.
- Intros. Apply mapcanon_unique. Assumption.
- Apply MapMerge_canon. (Apply MapDomRestrBy_canon; Assumption).
- (Apply MapDomRestrTo_canon; Assumption).
- Apply MapDom_Split_2.
+ intros. apply mapcanon_unique. assumption.
+ apply MapMerge_canon. apply MapDomRestrBy_canon; assumption.
+ apply MapDomRestrTo_canon; assumption.
+ apply MapDom_Split_2.
Qed.
- Lemma MapDom_Split_3_c : (m:(Map A)) (m':(Map B)) (mapcanon A m) ->
- (MapDomRestrTo A A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m'))=
- (M0 A).
+ Lemma MapDom_Split_3_c :
+ forall (m:Map A) (m':Map B),
+ mapcanon A m ->
+ MapDomRestrTo A A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m') =
+ M0 A.
Proof.
- Intros. Apply mapcanon_unique. Apply MapDomRestrTo_canon.
- Apply MapDomRestrTo_canon; Assumption.
- Apply M0_canon.
- Apply MapDom_Split_3.
+ intros. apply mapcanon_unique. apply MapDomRestrTo_canon.
+ apply MapDomRestrTo_canon; assumption.
+ apply M0_canon.
+ apply MapDom_Split_3.
Qed.
- Lemma Map_of_alist_of_Map_c : (m:(Map A)) (mapcanon A m) ->
- (Map_of_alist A (alist_of_Map A m))=m.
+ Lemma Map_of_alist_of_Map_c :
+ forall m:Map A, mapcanon A m -> Map_of_alist A (alist_of_Map A m) = m.
Proof.
- Intros. (Apply mapcanon_unique; Try Assumption). Apply Map_of_alist_canon.
- Apply Map_of_alist_of_Map.
+ intros. apply mapcanon_unique; try assumption. apply Map_of_alist_canon.
+ apply Map_of_alist_of_Map.
Qed.
- Lemma alist_of_Map_of_alist_c : (l:(alist A)) (alist_sorted_2 A l) ->
- (alist_of_Map A (Map_of_alist A l))=l.
+ Lemma alist_of_Map_of_alist_c :
+ forall l:alist A,
+ alist_sorted_2 A l -> alist_of_Map A (Map_of_alist A l) = l.
Proof.
- Intros. Apply alist_canonical. Apply alist_of_Map_of_alist.
- Apply alist_of_Map_sorts2.
- Assumption.
+ intros. apply alist_canonical. apply alist_of_Map_of_alist.
+ apply alist_of_Map_sorts2.
+ assumption.
Qed.
- Lemma MapSubset_antisym_c : (m:(Map A)) (m':(Map B))
- (mapcanon A m) -> (mapcanon B m') ->
- (MapSubset A B m m') -> (MapSubset B A m' m) -> (MapDom A m)=(MapDom B m').
+ Lemma MapSubset_antisym_c :
+ forall (m:Map A) (m':Map B),
+ mapcanon A m ->
+ mapcanon B m' ->
+ MapSubset A B m m' -> MapSubset B A m' m -> MapDom A m = MapDom B m'.
Proof.
- Intros. Apply (mapcanon_unique unit). (Apply MapDom_canon; Assumption).
- (Apply MapDom_canon; Assumption).
- (Apply MapSubset_antisym; Assumption).
+ intros. apply (mapcanon_unique unit). apply MapDom_canon; assumption.
+ apply MapDom_canon; assumption.
+ apply MapSubset_antisym; assumption.
Qed.
- Lemma FSubset_antisym_c : (s,s':FSet) (mapcanon unit s) -> (mapcanon unit s') ->
- (MapSubset ? ? s s') -> (MapSubset ? ? s' s) -> s=s'.
+ Lemma FSubset_antisym_c :
+ forall s s':FSet,
+ mapcanon unit s ->
+ mapcanon unit s' -> MapSubset _ _ s s' -> MapSubset _ _ s' s -> s = s'.
Proof.
- Intros. Apply (mapcanon_unique unit); Try Assumption. Apply FSubset_antisym; Assumption.
+ intros. apply (mapcanon_unique unit); try assumption. apply FSubset_antisym; assumption.
Qed.
- Lemma MapDisjoint_empty_c : (m:(Map A)) (mapcanon A m) ->
- (MapDisjoint A A m m) -> m=(M0 A).
+ Lemma MapDisjoint_empty_c :
+ forall m:Map A, mapcanon A m -> MapDisjoint A A m m -> m = M0 A.
Proof.
- Intros. Apply mapcanon_unique; Try Assumption; Try Apply M0_canon.
- Apply MapDisjoint_empty; Assumption.
+ intros. apply mapcanon_unique; try assumption; try apply M0_canon.
+ apply MapDisjoint_empty; assumption.
Qed.
- Lemma MapDelta_disjoint_c : (m,m':(Map A)) (mapcanon A m) -> (mapcanon A m') ->
- (MapDisjoint A A m m') -> (MapDelta A m m')=(MapMerge A m m').
+ Lemma MapDelta_disjoint_c :
+ forall m m':Map A,
+ mapcanon A m ->
+ mapcanon A m' ->
+ MapDisjoint A A m m' -> MapDelta A m m' = MapMerge A m m'.
Proof.
- Intros. Apply mapcanon_unique. (Apply MapDelta_canon; Assumption).
- (Apply MapMerge_canon; Assumption). Apply MapDelta_disjoint; Assumption.
+ intros. apply mapcanon_unique. apply MapDelta_canon; assumption.
+ apply MapMerge_canon; assumption. apply MapDelta_disjoint; assumption.
Qed.
End MapC.
-Lemma FSetDelta_assoc_c : (s,s',s'':FSet)
- (mapcanon unit s) -> (mapcanon unit s') -> (mapcanon unit s'') ->
- (MapDelta ? (MapDelta ? s s') s'')=(MapDelta ? s (MapDelta ? s' s'')).
+Lemma FSetDelta_assoc_c :
+ forall s s' s'':FSet,
+ mapcanon unit s ->
+ mapcanon unit s' ->
+ mapcanon unit s'' ->
+ MapDelta _ (MapDelta _ s s') s'' = MapDelta _ s (MapDelta _ s' s'').
Proof.
- Intros. Apply (mapcanon_unique unit). Apply MapDelta_canon. (Apply MapDelta_canon; Assumption).
- Assumption.
- Apply MapDelta_canon. Assumption.
- (Apply MapDelta_canon; Assumption).
- Apply FSetDelta_assoc; Assumption.
+ intros. apply (mapcanon_unique unit). apply MapDelta_canon. apply MapDelta_canon; assumption.
+ assumption.
+ apply MapDelta_canon. assumption.
+ apply MapDelta_canon; assumption.
+ apply FSetDelta_assoc; assumption.
Qed.
-Lemma FSet_ext_c : (s,s':FSet) (mapcanon unit s) -> (mapcanon unit s') ->
- ((a:ad) (in_FSet a s)=(in_FSet a s')) -> s=s'.
+Lemma FSet_ext_c :
+ forall s s':FSet,
+ mapcanon unit s ->
+ mapcanon unit s' -> (forall a:ad, in_FSet a s = in_FSet a s') -> s = s'.
Proof.
- Intros. (Apply (mapcanon_unique unit); Try Assumption). Apply FSet_ext. Assumption.
+ intros. apply (mapcanon_unique unit); try assumption. apply FSet_ext. assumption.
Qed.
-Lemma FSetUnion_comm_c : (s,s':FSet) (mapcanon unit s) -> (mapcanon unit s') ->
- (FSetUnion s s')=(FSetUnion s' s).
+Lemma FSetUnion_comm_c :
+ forall s s':FSet,
+ mapcanon unit s -> mapcanon unit s' -> FSetUnion s s' = FSetUnion s' s.
Proof.
- Intros.
- Apply (mapcanon_unique unit); Try (Unfold FSetUnion; Apply MapMerge_canon; Assumption).
- Apply FSetUnion_comm.
+ intros.
+ apply (mapcanon_unique unit);
+ try (unfold FSetUnion in |- *; apply MapMerge_canon; assumption).
+ apply FSetUnion_comm.
Qed.
-Lemma FSetUnion_assoc_c : (s,s',s'':FSet)
- (mapcanon unit s) -> (mapcanon unit s') -> (mapcanon unit s'') ->
- (FSetUnion (FSetUnion s s') s'')=(FSetUnion s (FSetUnion s' s'')).
+Lemma FSetUnion_assoc_c :
+ forall s s' s'':FSet,
+ mapcanon unit s ->
+ mapcanon unit s' ->
+ mapcanon unit s'' ->
+ FSetUnion (FSetUnion s s') s'' = FSetUnion s (FSetUnion s' s'').
Proof.
- Exact (MapMerge_assoc_c unit).
+ exact (MapMerge_assoc_c unit).
Qed.
-Lemma FSetUnion_M0_s_c : (s:FSet) (FSetUnion (M0 unit) s)=s.
+Lemma FSetUnion_M0_s_c : forall s:FSet, FSetUnion (M0 unit) s = s.
Proof.
- Exact (MapMerge_empty_m_c unit).
+ exact (MapMerge_empty_m_c unit).
Qed.
-Lemma FSetUnion_s_M0_c : (s:FSet) (FSetUnion s (M0 unit))=s.
+Lemma FSetUnion_s_M0_c : forall s:FSet, FSetUnion s (M0 unit) = s.
Proof.
- Exact (MapMerge_m_empty_1 unit).
+ exact (MapMerge_m_empty_1 unit).
Qed.
-Lemma FSetUnion_idempotent : (s:FSet) (mapcanon unit s) -> (FSetUnion s s)=s.
+Lemma FSetUnion_idempotent :
+ forall s:FSet, mapcanon unit s -> FSetUnion s s = s.
Proof.
- Exact (MapMerge_idempotent_c unit).
+ exact (MapMerge_idempotent_c unit).
Qed.
-Lemma FSetInter_comm_c : (s,s':FSet) (mapcanon unit s) -> (mapcanon unit s') ->
- (FSetInter s s')=(FSetInter s' s).
+Lemma FSetInter_comm_c :
+ forall s s':FSet,
+ mapcanon unit s -> mapcanon unit s' -> FSetInter s s' = FSetInter s' s.
Proof.
- Intros.
- Apply (mapcanon_unique unit); Try (Unfold FSetInter; Apply MapDomRestrTo_canon; Assumption).
- Apply FSetInter_comm.
+ intros.
+ apply (mapcanon_unique unit);
+ try (unfold FSetInter in |- *; apply MapDomRestrTo_canon; assumption).
+ apply FSetInter_comm.
Qed.
-Lemma FSetInter_assoc_c : (s,s',s'':FSet)
- (mapcanon unit s) ->
- (FSetInter (FSetInter s s') s'')=(FSetInter s (FSetInter s' s'')).
+Lemma FSetInter_assoc_c :
+ forall s s' s'':FSet,
+ mapcanon unit s ->
+ FSetInter (FSetInter s s') s'' = FSetInter s (FSetInter s' s'').
Proof.
- Exact (MapDomRestrTo_assoc_c unit unit unit).
+ exact (MapDomRestrTo_assoc_c unit unit unit).
Qed.
-Lemma FSetInter_M0_s_c : (s:FSet) (FSetInter (M0 unit) s)=(M0 unit).
+Lemma FSetInter_M0_s_c : forall s:FSet, FSetInter (M0 unit) s = M0 unit.
Proof.
- Trivial.
+ trivial.
Qed.
-Lemma FSetInter_s_M0_c : (s:FSet) (FSetInter s (M0 unit))=(M0 unit).
+Lemma FSetInter_s_M0_c : forall s:FSet, FSetInter s (M0 unit) = M0 unit.
Proof.
- Exact (MapDomRestrTo_m_empty_1 unit unit).
+ exact (MapDomRestrTo_m_empty_1 unit unit).
Qed.
-Lemma FSetInter_idempotent : (s:FSet) (mapcanon unit s) -> (FSetInter s s)=s.
+Lemma FSetInter_idempotent :
+ forall s:FSet, mapcanon unit s -> FSetInter s s = s.
Proof.
- Exact (MapDomRestrTo_idempotent_c unit).
+ exact (MapDomRestrTo_idempotent_c unit).
Qed.
-Lemma FSetUnion_Inter_l_c : (s,s',s'':FSet) (mapcanon unit s) -> (mapcanon unit s'') ->
- (FSetUnion (FSetInter s s') s'')=(FSetInter (FSetUnion s s'') (FSetUnion s' s'')).
+Lemma FSetUnion_Inter_l_c :
+ forall s s' s'':FSet,
+ mapcanon unit s ->
+ mapcanon unit s'' ->
+ FSetUnion (FSetInter s s') s'' =
+ FSetInter (FSetUnion s s'') (FSetUnion s' s'').
Proof.
- Intros. Apply (mapcanon_unique unit). Unfold FSetUnion. (Apply MapMerge_canon; Try Assumption).
- Unfold FSetInter. (Apply MapDomRestrTo_canon; Assumption).
- Unfold FSetInter; Unfold FSetUnion; Apply MapDomRestrTo_canon; Apply MapMerge_canon; Assumption.
- Apply FSetUnion_Inter_l.
+ intros. apply (mapcanon_unique unit). unfold FSetUnion in |- *. apply MapMerge_canon; try assumption.
+ unfold FSetInter in |- *. apply MapDomRestrTo_canon; assumption.
+ unfold FSetInter in |- *; unfold FSetUnion in |- *;
+ apply MapDomRestrTo_canon; apply MapMerge_canon;
+ assumption.
+ apply FSetUnion_Inter_l.
Qed.
-Lemma FSetUnion_Inter_r : (s,s',s'':FSet) (mapcanon unit s) -> (mapcanon unit s') ->
- (FSetUnion s (FSetInter s' s''))=(FSetInter (FSetUnion s s') (FSetUnion s s'')).
+Lemma FSetUnion_Inter_r :
+ forall s s' s'':FSet,
+ mapcanon unit s ->
+ mapcanon unit s' ->
+ FSetUnion s (FSetInter s' s'') =
+ FSetInter (FSetUnion s s') (FSetUnion s s'').
Proof.
- Intros. Apply (mapcanon_unique unit). Unfold FSetUnion. (Apply MapMerge_canon; Try Assumption).
- Unfold FSetInter. (Apply MapDomRestrTo_canon; Assumption).
- Unfold FSetInter; Unfold FSetUnion; Apply MapDomRestrTo_canon; Apply MapMerge_canon; Assumption.
- Apply FSetUnion_Inter_r.
+ intros. apply (mapcanon_unique unit). unfold FSetUnion in |- *. apply MapMerge_canon; try assumption.
+ unfold FSetInter in |- *. apply MapDomRestrTo_canon; assumption.
+ unfold FSetInter in |- *; unfold FSetUnion in |- *;
+ apply MapDomRestrTo_canon; apply MapMerge_canon;
+ assumption.
+ apply FSetUnion_Inter_r.
Qed.
-Lemma FSetInter_Union_l_c : (s,s',s'':FSet) (mapcanon unit s) -> (mapcanon unit s') ->
- (FSetInter (FSetUnion s s') s'')=(FSetUnion (FSetInter s s'') (FSetInter s' s'')).
+Lemma FSetInter_Union_l_c :
+ forall s s' s'':FSet,
+ mapcanon unit s ->
+ mapcanon unit s' ->
+ FSetInter (FSetUnion s s') s'' =
+ FSetUnion (FSetInter s s'') (FSetInter s' s'').
Proof.
- Intros. Apply (mapcanon_unique unit). Unfold FSetInter.
- Apply MapDomRestrTo_canon; Try Assumption. Unfold FSetUnion.
- Apply MapMerge_canon; Assumption.
- Unfold FSetUnion; Unfold FSetInter; Apply MapMerge_canon; Apply MapDomRestrTo_canon;
- Assumption.
- Apply FSetInter_Union_l.
+ intros. apply (mapcanon_unique unit). unfold FSetInter in |- *.
+ apply MapDomRestrTo_canon; try assumption. unfold FSetUnion in |- *.
+ apply MapMerge_canon; assumption.
+ unfold FSetUnion in |- *; unfold FSetInter in |- *; apply MapMerge_canon;
+ apply MapDomRestrTo_canon; assumption.
+ apply FSetInter_Union_l.
Qed.
-Lemma FSetInter_Union_r : (s,s',s'':FSet) (mapcanon unit s) -> (mapcanon unit s') ->
- (FSetInter s (FSetUnion s' s''))=(FSetUnion (FSetInter s s') (FSetInter s s'')).
+Lemma FSetInter_Union_r :
+ forall s s' s'':FSet,
+ mapcanon unit s ->
+ mapcanon unit s' ->
+ FSetInter s (FSetUnion s' s'') =
+ FSetUnion (FSetInter s s') (FSetInter s s'').
Proof.
- Intros. Apply (mapcanon_unique unit). Unfold FSetInter.
- Apply MapDomRestrTo_canon; Try Assumption.
- Unfold FSetUnion. Apply MapMerge_canon; Unfold FSetInter; Apply MapDomRestrTo_canon; Assumption.
- Apply FSetInter_Union_r.
-Qed.
+ intros. apply (mapcanon_unique unit). unfold FSetInter in |- *.
+ apply MapDomRestrTo_canon; try assumption.
+ unfold FSetUnion in |- *. apply MapMerge_canon; unfold FSetInter in |- *; apply MapDomRestrTo_canon;
+ assumption.
+ apply FSetInter_Union_r.
+Qed. \ No newline at end of file
diff --git a/theories/IntMap/Mapcanon.v b/theories/IntMap/Mapcanon.v
index b98e9b233..70966c60d 100644
--- a/theories/IntMap/Mapcanon.v
+++ b/theories/IntMap/Mapcanon.v
@@ -7,316 +7,328 @@
(***********************************************************************)
(*i $Id$ i*)
-Require Bool.
-Require Sumbool.
-Require Arith.
-Require ZArith.
-Require Addr.
-Require Adist.
-Require Addec.
-Require Map.
-Require Mapaxioms.
-Require Mapiter.
-Require Fset.
-Require PolyList.
-Require Lsort.
-Require Mapsubset.
-Require Mapcard.
+Require Import Bool.
+Require Import Sumbool.
+Require Import Arith.
+Require Import ZArith.
+Require Import Addr.
+Require Import Adist.
+Require Import Addec.
+Require Import Map.
+Require Import Mapaxioms.
+Require Import Mapiter.
+Require Import Fset.
+Require Import List.
+Require Import Lsort.
+Require Import Mapsubset.
+Require Import Mapcard.
Section MapCanon.
Variable A : Set.
- Inductive mapcanon : (Map A) -> Prop :=
- M0_canon : (mapcanon (M0 A))
- | M1_canon : (a:ad) (y:A) (mapcanon (M1 A a y))
- | M2_canon : (m1,m2:(Map A)) (mapcanon m1) -> (mapcanon m2) ->
- (le (2) (MapCard A (M2 A m1 m2))) -> (mapcanon (M2 A m1 m2)).
+ Inductive mapcanon : Map A -> Prop :=
+ | M0_canon : mapcanon (M0 A)
+ | M1_canon : forall (a:ad) (y:A), mapcanon (M1 A a y)
+ | M2_canon :
+ forall m1 m2:Map A,
+ mapcanon m1 ->
+ mapcanon m2 -> 2 <= MapCard A (M2 A m1 m2) -> mapcanon (M2 A m1 m2).
- Lemma mapcanon_M2 :
- (m1,m2:(Map A)) (mapcanon (M2 A m1 m2)) -> (le (2) (MapCard A (M2 A m1 m2))).
+ Lemma mapcanon_M2 :
+ forall m1 m2:Map A, mapcanon (M2 A m1 m2) -> 2 <= MapCard A (M2 A m1 m2).
Proof.
- Intros. Inversion H. Assumption.
+ intros. inversion H. assumption.
Qed.
- Lemma mapcanon_M2_1 : (m1,m2:(Map A)) (mapcanon (M2 A m1 m2)) -> (mapcanon m1).
+ Lemma mapcanon_M2_1 :
+ forall m1 m2:Map A, mapcanon (M2 A m1 m2) -> mapcanon m1.
Proof.
- Intros. Inversion H. Assumption.
+ intros. inversion H. assumption.
Qed.
- Lemma mapcanon_M2_2 : (m1,m2:(Map A)) (mapcanon (M2 A m1 m2)) -> (mapcanon m2).
+ Lemma mapcanon_M2_2 :
+ forall m1 m2:Map A, mapcanon (M2 A m1 m2) -> mapcanon m2.
Proof.
- Intros. Inversion H. Assumption.
+ intros. inversion H. assumption.
Qed.
- Lemma M2_eqmap_1 : (m0,m1,m2,m3:(Map A))
- (eqmap A (M2 A m0 m1) (M2 A m2 m3)) -> (eqmap A m0 m2).
+ Lemma M2_eqmap_1 :
+ forall m0 m1 m2 m3:Map A,
+ eqmap A (M2 A m0 m1) (M2 A m2 m3) -> eqmap A m0 m2.
Proof.
- Unfold eqmap eqm. Intros. Rewrite <- (ad_double_div_2 a).
- Rewrite <- (MapGet_M2_bit_0_0 A ? (ad_double_bit_0 a) m0 m1).
- Rewrite <- (MapGet_M2_bit_0_0 A ? (ad_double_bit_0 a) m2 m3).
- Exact (H (ad_double a)).
+ unfold eqmap, eqm in |- *. intros. rewrite <- (ad_double_div_2 a).
+ rewrite <- (MapGet_M2_bit_0_0 A _ (ad_double_bit_0 a) m0 m1).
+ rewrite <- (MapGet_M2_bit_0_0 A _ (ad_double_bit_0 a) m2 m3).
+ exact (H (ad_double a)).
Qed.
- Lemma M2_eqmap_2 : (m0,m1,m2,m3:(Map A))
- (eqmap A (M2 A m0 m1) (M2 A m2 m3)) -> (eqmap A m1 m3).
+ Lemma M2_eqmap_2 :
+ forall m0 m1 m2 m3:Map A,
+ eqmap A (M2 A m0 m1) (M2 A m2 m3) -> eqmap A m1 m3.
Proof.
- Unfold eqmap eqm. Intros. Rewrite <- (ad_double_plus_un_div_2 a).
- Rewrite <- (MapGet_M2_bit_0_1 A ? (ad_double_plus_un_bit_0 a) m0 m1).
- Rewrite <- (MapGet_M2_bit_0_1 A ? (ad_double_plus_un_bit_0 a) m2 m3).
- Exact (H (ad_double_plus_un a)).
+ unfold eqmap, eqm in |- *. intros. rewrite <- (ad_double_plus_un_div_2 a).
+ rewrite <- (MapGet_M2_bit_0_1 A _ (ad_double_plus_un_bit_0 a) m0 m1).
+ rewrite <- (MapGet_M2_bit_0_1 A _ (ad_double_plus_un_bit_0 a) m2 m3).
+ exact (H (ad_double_plus_un a)).
Qed.
- Lemma mapcanon_unique : (m,m':(Map A)) (mapcanon m) -> (mapcanon m') ->
- (eqmap A m m') -> m=m'.
+ Lemma mapcanon_unique :
+ forall m m':Map A, mapcanon m -> mapcanon m' -> eqmap A m m' -> m = m'.
Proof.
- Induction m. Induction m'. Trivial.
- Intros a y H H0 H1. Cut (NONE A)=(MapGet A (M1 A a y) a). Simpl. Rewrite (ad_eq_correct a).
- Intro. Discriminate H2.
- Exact (H1 a).
- Intros. Cut (le (2) (MapCard A (M0 A))). Intro. Elim (le_Sn_O ? H4).
- Rewrite (MapCard_ext A ? ? H3). Exact (mapcanon_M2 ? ? H2).
- Intros a y. Induction m'. Intros. Cut (MapGet A (M1 A a y) a)=(NONE A). Simpl.
- Rewrite (ad_eq_correct a). Intro. Discriminate H2.
- Exact (H1 a).
- Intros a0 y0 H H0 H1. Cut (MapGet A (M1 A a y) a)=(MapGet A (M1 A a0 y0) a). Simpl.
- Rewrite (ad_eq_correct a). Intro. Elim (sumbool_of_bool (ad_eq a0 a)). Intro H3.
- Rewrite H3 in H2. Inversion H2. Rewrite (ad_eq_complete ? ? H3). Reflexivity.
- Intro H3. Rewrite H3 in H2. Discriminate H2.
- Exact (H1 a).
- Intros. Cut (le (2) (MapCard A (M1 A a y))). Intro. Elim (le_Sn_O ? (le_S_n ? ? H4)).
- Rewrite (MapCard_ext A ? ? H3). Exact (mapcanon_M2 ? ? H2).
- Induction m'. Intros. Cut (le (2) (MapCard A (M0 A))). Intro. Elim (le_Sn_O ? H4).
- Rewrite <- (MapCard_ext A ? ? H3). Exact (mapcanon_M2 ? ? H1).
- Intros a y H1 H2 H3. Cut (le (2) (MapCard A (M1 A a y))). Intro.
- Elim (le_Sn_O ? (le_S_n ? ? H4)).
- Rewrite <- (MapCard_ext A ? ? H3). Exact (mapcanon_M2 ? ? H1).
- Intros. Rewrite (H m2). Rewrite (H0 m3). Reflexivity.
- Exact (mapcanon_M2_2 ? ? H3).
- Exact (mapcanon_M2_2 ? ? H4).
- Exact (M2_eqmap_2 ? ? ? ? H5).
- Exact (mapcanon_M2_1 ? ? H3).
- Exact (mapcanon_M2_1 ? ? H4).
- Exact (M2_eqmap_1 ? ? ? ? H5).
+ simple induction m. simple induction m'. trivial.
+ intros a y H H0 H1. cut (NONE A = MapGet A (M1 A a y) a). simpl in |- *. rewrite (ad_eq_correct a).
+ intro. discriminate H2.
+ exact (H1 a).
+ intros. cut (2 <= MapCard A (M0 A)). intro. elim (le_Sn_O _ H4).
+ rewrite (MapCard_ext A _ _ H3). exact (mapcanon_M2 _ _ H2).
+ intros a y. simple induction m'. intros. cut (MapGet A (M1 A a y) a = NONE A). simpl in |- *.
+ rewrite (ad_eq_correct a). intro. discriminate H2.
+ exact (H1 a).
+ intros a0 y0 H H0 H1. cut (MapGet A (M1 A a y) a = MapGet A (M1 A a0 y0) a). simpl in |- *.
+ rewrite (ad_eq_correct a). intro. elim (sumbool_of_bool (ad_eq a0 a)). intro H3.
+ rewrite H3 in H2. inversion H2. rewrite (ad_eq_complete _ _ H3). reflexivity.
+ intro H3. rewrite H3 in H2. discriminate H2.
+ exact (H1 a).
+ intros. cut (2 <= MapCard A (M1 A a y)). intro. elim (le_Sn_O _ (le_S_n _ _ H4)).
+ rewrite (MapCard_ext A _ _ H3). exact (mapcanon_M2 _ _ H2).
+ simple induction m'. intros. cut (2 <= MapCard A (M0 A)). intro. elim (le_Sn_O _ H4).
+ rewrite <- (MapCard_ext A _ _ H3). exact (mapcanon_M2 _ _ H1).
+ intros a y H1 H2 H3. cut (2 <= MapCard A (M1 A a y)). intro.
+ elim (le_Sn_O _ (le_S_n _ _ H4)).
+ rewrite <- (MapCard_ext A _ _ H3). exact (mapcanon_M2 _ _ H1).
+ intros. rewrite (H m2). rewrite (H0 m3). reflexivity.
+ exact (mapcanon_M2_2 _ _ H3).
+ exact (mapcanon_M2_2 _ _ H4).
+ exact (M2_eqmap_2 _ _ _ _ H5).
+ exact (mapcanon_M2_1 _ _ H3).
+ exact (mapcanon_M2_1 _ _ H4).
+ exact (M2_eqmap_1 _ _ _ _ H5).
Qed.
- Lemma MapPut1_canon :
- (p:positive) (a,a':ad) (y,y':A) (mapcanon (MapPut1 A a y a' y' p)).
+ Lemma MapPut1_canon :
+ forall (p:positive) (a a':ad) (y y':A), mapcanon (MapPut1 A a y a' y' p).
Proof.
- Induction p. Simpl. Intros. Case (ad_bit_0 a). Apply M2_canon. Apply M1_canon.
- Apply M1_canon.
- Apply le_n.
- Apply M2_canon. Apply M1_canon.
- Apply M1_canon.
- Apply le_n.
- Simpl. Intros. Case (ad_bit_0 a). Apply M2_canon. Apply M0_canon.
- Apply H.
- Simpl. Rewrite MapCard_Put1_equals_2. Apply le_n.
- Apply M2_canon. Apply H.
- Apply M0_canon.
- Simpl. Rewrite MapCard_Put1_equals_2. Apply le_n.
- Simpl. Simpl. Intros. Case (ad_bit_0 a). Apply M2_canon. Apply M1_canon.
- Apply M1_canon.
- Simpl. Apply le_n.
- Apply M2_canon. Apply M1_canon.
- Apply M1_canon.
- Simpl. Apply le_n.
+ simple induction p. simpl in |- *. intros. case (ad_bit_0 a). apply M2_canon. apply M1_canon.
+ apply M1_canon.
+ apply le_n.
+ apply M2_canon. apply M1_canon.
+ apply M1_canon.
+ apply le_n.
+ simpl in |- *. intros. case (ad_bit_0 a). apply M2_canon. apply M0_canon.
+ apply H.
+ simpl in |- *. rewrite MapCard_Put1_equals_2. apply le_n.
+ apply M2_canon. apply H.
+ apply M0_canon.
+ simpl in |- *. rewrite MapCard_Put1_equals_2. apply le_n.
+ simpl in |- *. simpl in |- *. intros. case (ad_bit_0 a). apply M2_canon. apply M1_canon.
+ apply M1_canon.
+ simpl in |- *. apply le_n.
+ apply M2_canon. apply M1_canon.
+ apply M1_canon.
+ simpl in |- *. apply le_n.
Qed.
- Lemma MapPut_canon :
- (m:(Map A)) (mapcanon m) -> (a:ad) (y:A) (mapcanon (MapPut A m a y)).
+ Lemma MapPut_canon :
+ forall m:Map A,
+ mapcanon m -> forall (a:ad) (y:A), mapcanon (MapPut A m a y).
Proof.
- Induction m. Intros. Simpl. Apply M1_canon.
- Intros a0 y0 H a y. Simpl. Case (ad_xor a0 a). Apply M1_canon.
- Intro. Apply MapPut1_canon.
- Intros. Simpl. Elim a. Apply M2_canon. Apply H. Exact (mapcanon_M2_1 m0 m1 H1).
- Exact (mapcanon_M2_2 m0 m1 H1).
- Simpl. Apply le_trans with m:=(plus (MapCard A m0) (MapCard A m1)). Exact (mapcanon_M2 ? ? H1).
- Apply le_plus_plus. Exact (MapCard_Put_lb A m0 ad_z y).
- Apply le_n.
- Intro. Case p. Intro. Apply M2_canon. Exact (mapcanon_M2_1 m0 m1 H1).
- Apply H0. Exact (mapcanon_M2_2 m0 m1 H1).
- Simpl. Apply le_trans with m:=(plus (MapCard A m0) (MapCard A m1)).
- Exact (mapcanon_M2 m0 m1 H1).
- Apply le_reg_l. Exact (MapCard_Put_lb A m1 (ad_x p0) y).
- Intro. Apply M2_canon. Apply H. Exact (mapcanon_M2_1 m0 m1 H1).
- Exact (mapcanon_M2_2 m0 m1 H1).
- Simpl. Apply le_trans with m:=(plus (MapCard A m0) (MapCard A m1)).
- Exact (mapcanon_M2 m0 m1 H1).
- Apply le_reg_r. Exact (MapCard_Put_lb A m0 (ad_x p0) y).
- Apply M2_canon. Apply (mapcanon_M2_1 m0 m1 H1).
- Apply H0. Apply (mapcanon_M2_2 m0 m1 H1).
- Simpl. Apply le_trans with m:=(plus (MapCard A m0) (MapCard A m1)).
- Exact (mapcanon_M2 m0 m1 H1).
- Apply le_reg_l. Exact (MapCard_Put_lb A m1 ad_z y).
+ simple induction m. intros. simpl in |- *. apply M1_canon.
+ intros a0 y0 H a y. simpl in |- *. case (ad_xor a0 a). apply M1_canon.
+ intro. apply MapPut1_canon.
+ intros. simpl in |- *. elim a. apply M2_canon. apply H. exact (mapcanon_M2_1 m0 m1 H1).
+ exact (mapcanon_M2_2 m0 m1 H1).
+ simpl in |- *. apply le_trans with (m := MapCard A m0 + MapCard A m1). exact (mapcanon_M2 _ _ H1).
+ apply plus_le_compat. exact (MapCard_Put_lb A m0 ad_z y).
+ apply le_n.
+ intro. case p. intro. apply M2_canon. exact (mapcanon_M2_1 m0 m1 H1).
+ apply H0. exact (mapcanon_M2_2 m0 m1 H1).
+ simpl in |- *. apply le_trans with (m := MapCard A m0 + MapCard A m1).
+ exact (mapcanon_M2 m0 m1 H1).
+ apply plus_le_compat_l. exact (MapCard_Put_lb A m1 (ad_x p0) y).
+ intro. apply M2_canon. apply H. exact (mapcanon_M2_1 m0 m1 H1).
+ exact (mapcanon_M2_2 m0 m1 H1).
+ simpl in |- *. apply le_trans with (m := MapCard A m0 + MapCard A m1).
+ exact (mapcanon_M2 m0 m1 H1).
+ apply plus_le_compat_r. exact (MapCard_Put_lb A m0 (ad_x p0) y).
+ apply M2_canon. apply (mapcanon_M2_1 m0 m1 H1).
+ apply H0. apply (mapcanon_M2_2 m0 m1 H1).
+ simpl in |- *. apply le_trans with (m := MapCard A m0 + MapCard A m1).
+ exact (mapcanon_M2 m0 m1 H1).
+ apply plus_le_compat_l. exact (MapCard_Put_lb A m1 ad_z y).
Qed.
- Lemma MapPut_behind_canon : (m:(Map A)) (mapcanon m) ->
- (a:ad) (y:A) (mapcanon (MapPut_behind A m a y)).
+ Lemma MapPut_behind_canon :
+ forall m:Map A,
+ mapcanon m -> forall (a:ad) (y:A), mapcanon (MapPut_behind A m a y).
Proof.
- Induction m. Intros. Simpl. Apply M1_canon.
- Intros a0 y0 H a y. Simpl. Case (ad_xor a0 a). Apply M1_canon.
- Intro. Apply MapPut1_canon.
- Intros. Simpl. Elim a. Apply M2_canon. Apply H. Exact (mapcanon_M2_1 m0 m1 H1).
- Exact (mapcanon_M2_2 m0 m1 H1).
- Simpl. Apply le_trans with m:=(plus (MapCard A m0) (MapCard A m1)). Exact (mapcanon_M2 ? ? H1).
- Apply le_plus_plus. Rewrite MapCard_Put_behind_Put. Exact (MapCard_Put_lb A m0 ad_z y).
- Apply le_n.
- Intro. Case p. Intro. Apply M2_canon. Exact (mapcanon_M2_1 m0 m1 H1).
- Apply H0. Exact (mapcanon_M2_2 m0 m1 H1).
- Simpl. Apply le_trans with m:=(plus (MapCard A m0) (MapCard A m1)).
- Exact (mapcanon_M2 m0 m1 H1).
- Apply le_reg_l. Rewrite MapCard_Put_behind_Put. Exact (MapCard_Put_lb A m1 (ad_x p0) y).
- Intro. Apply M2_canon. Apply H. Exact (mapcanon_M2_1 m0 m1 H1).
- Exact (mapcanon_M2_2 m0 m1 H1).
- Simpl. Apply le_trans with m:=(plus (MapCard A m0) (MapCard A m1)).
- Exact (mapcanon_M2 m0 m1 H1).
- Apply le_reg_r. Rewrite MapCard_Put_behind_Put. Exact (MapCard_Put_lb A m0 (ad_x p0) y).
- Apply M2_canon. Apply (mapcanon_M2_1 m0 m1 H1).
- Apply H0. Apply (mapcanon_M2_2 m0 m1 H1).
- Simpl. Apply le_trans with m:=(plus (MapCard A m0) (MapCard A m1)).
- Exact (mapcanon_M2 m0 m1 H1).
- Apply le_reg_l. Rewrite MapCard_Put_behind_Put. Exact (MapCard_Put_lb A m1 ad_z y).
+ simple induction m. intros. simpl in |- *. apply M1_canon.
+ intros a0 y0 H a y. simpl in |- *. case (ad_xor a0 a). apply M1_canon.
+ intro. apply MapPut1_canon.
+ intros. simpl in |- *. elim a. apply M2_canon. apply H. exact (mapcanon_M2_1 m0 m1 H1).
+ exact (mapcanon_M2_2 m0 m1 H1).
+ simpl in |- *. apply le_trans with (m := MapCard A m0 + MapCard A m1). exact (mapcanon_M2 _ _ H1).
+ apply plus_le_compat. rewrite MapCard_Put_behind_Put. exact (MapCard_Put_lb A m0 ad_z y).
+ apply le_n.
+ intro. case p. intro. apply M2_canon. exact (mapcanon_M2_1 m0 m1 H1).
+ apply H0. exact (mapcanon_M2_2 m0 m1 H1).
+ simpl in |- *. apply le_trans with (m := MapCard A m0 + MapCard A m1).
+ exact (mapcanon_M2 m0 m1 H1).
+ apply plus_le_compat_l. rewrite MapCard_Put_behind_Put. exact (MapCard_Put_lb A m1 (ad_x p0) y).
+ intro. apply M2_canon. apply H. exact (mapcanon_M2_1 m0 m1 H1).
+ exact (mapcanon_M2_2 m0 m1 H1).
+ simpl in |- *. apply le_trans with (m := MapCard A m0 + MapCard A m1).
+ exact (mapcanon_M2 m0 m1 H1).
+ apply plus_le_compat_r. rewrite MapCard_Put_behind_Put. exact (MapCard_Put_lb A m0 (ad_x p0) y).
+ apply M2_canon. apply (mapcanon_M2_1 m0 m1 H1).
+ apply H0. apply (mapcanon_M2_2 m0 m1 H1).
+ simpl in |- *. apply le_trans with (m := MapCard A m0 + MapCard A m1).
+ exact (mapcanon_M2 m0 m1 H1).
+ apply plus_le_compat_l. rewrite MapCard_Put_behind_Put. exact (MapCard_Put_lb A m1 ad_z y).
Qed.
- Lemma makeM2_canon :
- (m,m':(Map A)) (mapcanon m) -> (mapcanon m') -> (mapcanon (makeM2 A m m')).
+ Lemma makeM2_canon :
+ forall m m':Map A, mapcanon m -> mapcanon m' -> mapcanon (makeM2 A m m').
Proof.
- Intro. Case m. Intro. Case m'. Intros. Exact M0_canon.
- Intros a y H H0. Exact (M1_canon (ad_double_plus_un a) y).
- Intros. Simpl. (Apply M2_canon; Try Assumption). Exact (mapcanon_M2 m0 m1 H0).
- Intros a y m'. Case m'. Intros. Exact (M1_canon (ad_double a) y).
- Intros a0 y0 H H0. Simpl. (Apply M2_canon; Try Assumption). Apply le_n.
- Intros. Simpl. (Apply M2_canon; Try Assumption).
- Apply le_trans with m:=(MapCard A (M2 A m0 m1)). Exact (mapcanon_M2 ? ? H0).
- Exact (le_plus_r (MapCard A (M1 A a y)) (MapCard A (M2 A m0 m1))).
- Simpl. Intros. (Apply M2_canon; Try Assumption).
- Apply le_trans with m:=(MapCard A (M2 A m0 m1)). Exact (mapcanon_M2 ? ? H).
- Exact (le_plus_l (MapCard A (M2 A m0 m1)) (MapCard A m')).
+ intro. case m. intro. case m'. intros. exact M0_canon.
+ intros a y H H0. exact (M1_canon (ad_double_plus_un a) y).
+ intros. simpl in |- *. apply M2_canon; try assumption. exact (mapcanon_M2 m0 m1 H0).
+ intros a y m'. case m'. intros. exact (M1_canon (ad_double a) y).
+ intros a0 y0 H H0. simpl in |- *. apply M2_canon; try assumption. apply le_n.
+ intros. simpl in |- *. apply M2_canon; try assumption.
+ apply le_trans with (m := MapCard A (M2 A m0 m1)). exact (mapcanon_M2 _ _ H0).
+ exact (le_plus_r (MapCard A (M1 A a y)) (MapCard A (M2 A m0 m1))).
+ simpl in |- *. intros. apply M2_canon; try assumption.
+ apply le_trans with (m := MapCard A (M2 A m0 m1)). exact (mapcanon_M2 _ _ H).
+ exact (le_plus_l (MapCard A (M2 A m0 m1)) (MapCard A m')).
Qed.
- Fixpoint MapCanonicalize [m:(Map A)] : (Map A) :=
- Cases m of
- (M2 m0 m1) => (makeM2 A (MapCanonicalize m0) (MapCanonicalize m1))
- | _ => m
- end.
+ Fixpoint MapCanonicalize (m:Map A) : Map A :=
+ match m with
+ | M2 m0 m1 => makeM2 A (MapCanonicalize m0) (MapCanonicalize m1)
+ | _ => m
+ end.
- Lemma mapcanon_exists_1 : (m:(Map A)) (eqmap A m (MapCanonicalize m)).
+ Lemma mapcanon_exists_1 : forall m:Map A, eqmap A m (MapCanonicalize m).
Proof.
- Induction m. Apply eqmap_refl.
- Intros. Apply eqmap_refl.
- Intros. Simpl. Unfold eqmap eqm. Intro.
- Rewrite (makeM2_M2 A (MapCanonicalize m0) (MapCanonicalize m1) a).
- Rewrite MapGet_M2_bit_0_if. Rewrite MapGet_M2_bit_0_if.
- Rewrite <- (H (ad_div_2 a)). Rewrite <- (H0 (ad_div_2 a)). Reflexivity.
+ simple induction m. apply eqmap_refl.
+ intros. apply eqmap_refl.
+ intros. simpl in |- *. unfold eqmap, eqm in |- *. intro.
+ rewrite (makeM2_M2 A (MapCanonicalize m0) (MapCanonicalize m1) a).
+ rewrite MapGet_M2_bit_0_if. rewrite MapGet_M2_bit_0_if.
+ rewrite <- (H (ad_div_2 a)). rewrite <- (H0 (ad_div_2 a)). reflexivity.
Qed.
- Lemma mapcanon_exists_2 : (m:(Map A)) (mapcanon (MapCanonicalize m)).
+ Lemma mapcanon_exists_2 : forall m:Map A, mapcanon (MapCanonicalize m).
Proof.
- Induction m. Apply M0_canon.
- Intros. Simpl. Apply M1_canon.
- Intros. Simpl. (Apply makeM2_canon; Assumption).
+ simple induction m. apply M0_canon.
+ intros. simpl in |- *. apply M1_canon.
+ intros. simpl in |- *. apply makeM2_canon; assumption.
Qed.
- Lemma mapcanon_exists :
- (m:(Map A)) {m':(Map A) | (eqmap A m m') /\ (mapcanon m')}.
+ Lemma mapcanon_exists :
+ forall m:Map A, {m' : Map A | eqmap A m m' /\ mapcanon m'}.
Proof.
- Intro. Split with (MapCanonicalize m). Split. Apply mapcanon_exists_1.
- Apply mapcanon_exists_2.
+ intro. split with (MapCanonicalize m). split. apply mapcanon_exists_1.
+ apply mapcanon_exists_2.
Qed.
- Lemma MapRemove_canon :
- (m:(Map A)) (mapcanon m) -> (a:ad) (mapcanon (MapRemove A m a)).
+ Lemma MapRemove_canon :
+ forall m:Map A, mapcanon m -> forall a:ad, mapcanon (MapRemove A m a).
Proof.
- Induction m. Intros. Exact M0_canon.
- Intros a y H a0. Simpl. Case (ad_eq a a0). Exact M0_canon.
- Assumption.
- Intros. Simpl. Case (ad_bit_0 a). Apply makeM2_canon. Exact (mapcanon_M2_1 ? ? H1).
- Apply H0. Exact (mapcanon_M2_2 ? ? H1).
- Apply makeM2_canon. Apply H. Exact (mapcanon_M2_1 ? ? H1).
- Exact (mapcanon_M2_2 ? ? H1).
+ simple induction m. intros. exact M0_canon.
+ intros a y H a0. simpl in |- *. case (ad_eq a a0). exact M0_canon.
+ assumption.
+ intros. simpl in |- *. case (ad_bit_0 a). apply makeM2_canon. exact (mapcanon_M2_1 _ _ H1).
+ apply H0. exact (mapcanon_M2_2 _ _ H1).
+ apply makeM2_canon. apply H. exact (mapcanon_M2_1 _ _ H1).
+ exact (mapcanon_M2_2 _ _ H1).
Qed.
- Lemma MapMerge_canon : (m,m':(Map A)) (mapcanon m) -> (mapcanon m') ->
- (mapcanon (MapMerge A m m')).
+ Lemma MapMerge_canon :
+ forall m m':Map A, mapcanon m -> mapcanon m' -> mapcanon (MapMerge A m m').
Proof.
- Induction m. Intros. Exact H0.
- Simpl. Intros a y m' H H0. Exact (MapPut_behind_canon m' H0 a y).
- Induction m'. Intros. Exact H1.
- Intros a y H1 H2. Unfold MapMerge. Exact (MapPut_canon ? H1 a y).
- Intros. Simpl. Apply M2_canon. Apply H. Exact (mapcanon_M2_1 ? ? H3).
- Exact (mapcanon_M2_1 ? ? H4).
- Apply H0. Exact (mapcanon_M2_2 ? ? H3).
- Exact (mapcanon_M2_2 ? ? H4).
- Change (le (2) (MapCard A (MapMerge A (M2 A m0 m1) (M2 A m2 m3)))).
- Apply le_trans with m:=(MapCard A (M2 A m0 m1)). Exact (mapcanon_M2 ? ? H3).
- Exact (MapMerge_Card_lb_l A (M2 A m0 m1) (M2 A m2 m3)).
+ simple induction m. intros. exact H0.
+ simpl in |- *. intros a y m' H H0. exact (MapPut_behind_canon m' H0 a y).
+ simple induction m'. intros. exact H1.
+ intros a y H1 H2. unfold MapMerge in |- *. exact (MapPut_canon _ H1 a y).
+ intros. simpl in |- *. apply M2_canon. apply H. exact (mapcanon_M2_1 _ _ H3).
+ exact (mapcanon_M2_1 _ _ H4).
+ apply H0. exact (mapcanon_M2_2 _ _ H3).
+ exact (mapcanon_M2_2 _ _ H4).
+ change (2 <= MapCard A (MapMerge A (M2 A m0 m1) (M2 A m2 m3))) in |- *.
+ apply le_trans with (m := MapCard A (M2 A m0 m1)). exact (mapcanon_M2 _ _ H3).
+ exact (MapMerge_Card_lb_l A (M2 A m0 m1) (M2 A m2 m3)).
Qed.
- Lemma MapDelta_canon : (m,m':(Map A)) (mapcanon m) -> (mapcanon m') ->
- (mapcanon (MapDelta A m m')).
+ Lemma MapDelta_canon :
+ forall m m':Map A, mapcanon m -> mapcanon m' -> mapcanon (MapDelta A m m').
Proof.
- Induction m. Intros. Exact H0.
- Simpl. Intros a y m' H H0. Case (MapGet A m' a). Exact (MapPut_canon m' H0 a y).
- Intro. Exact (MapRemove_canon m' H0 a).
- Induction m'. Intros. Exact H1.
- Unfold MapDelta. Intros a y H1 H2. Case (MapGet A (M2 A m0 m1) a).
- Exact (MapPut_canon ? H1 a y).
- Intro. Exact (MapRemove_canon ? H1 a).
- Intros. Simpl. Apply makeM2_canon. Apply H. Exact (mapcanon_M2_1 ? ? H3).
- Exact (mapcanon_M2_1 ? ? H4).
- Apply H0. Exact (mapcanon_M2_2 ? ? H3).
- Exact (mapcanon_M2_2 ? ? H4).
+ simple induction m. intros. exact H0.
+ simpl in |- *. intros a y m' H H0. case (MapGet A m' a). exact (MapPut_canon m' H0 a y).
+ intro. exact (MapRemove_canon m' H0 a).
+ simple induction m'. intros. exact H1.
+ unfold MapDelta in |- *. intros a y H1 H2. case (MapGet A (M2 A m0 m1) a).
+ exact (MapPut_canon _ H1 a y).
+ intro. exact (MapRemove_canon _ H1 a).
+ intros. simpl in |- *. apply makeM2_canon. apply H. exact (mapcanon_M2_1 _ _ H3).
+ exact (mapcanon_M2_1 _ _ H4).
+ apply H0. exact (mapcanon_M2_2 _ _ H3).
+ exact (mapcanon_M2_2 _ _ H4).
Qed.
Variable B : Set.
- Lemma MapDomRestrTo_canon : (m:(Map A)) (mapcanon m) ->
- (m':(Map B)) (mapcanon (MapDomRestrTo A B m m')).
+ Lemma MapDomRestrTo_canon :
+ forall m:Map A,
+ mapcanon m -> forall m':Map B, mapcanon (MapDomRestrTo A B m m').
Proof.
- Induction m. Intros. Exact M0_canon.
- Simpl. Intros a y H m'. Case (MapGet B m' a). Exact M0_canon.
- Intro. Apply M1_canon.
- Induction m'. Exact M0_canon.
- Unfold MapDomRestrTo. Intros a y. Case (MapGet A (M2 A m0 m1) a). Exact M0_canon.
- Intro. Apply M1_canon.
- Intros. Simpl. Apply makeM2_canon. Apply H. Exact (mapcanon_M2_1 m0 m1 H1).
- Apply H0. Exact (mapcanon_M2_2 m0 m1 H1).
+ simple induction m. intros. exact M0_canon.
+ simpl in |- *. intros a y H m'. case (MapGet B m' a). exact M0_canon.
+ intro. apply M1_canon.
+ simple induction m'. exact M0_canon.
+ unfold MapDomRestrTo in |- *. intros a y. case (MapGet A (M2 A m0 m1) a). exact M0_canon.
+ intro. apply M1_canon.
+ intros. simpl in |- *. apply makeM2_canon. apply H. exact (mapcanon_M2_1 m0 m1 H1).
+ apply H0. exact (mapcanon_M2_2 m0 m1 H1).
Qed.
- Lemma MapDomRestrBy_canon : (m:(Map A)) (mapcanon m) ->
- (m':(Map B)) (mapcanon (MapDomRestrBy A B m m')).
+ Lemma MapDomRestrBy_canon :
+ forall m:Map A,
+ mapcanon m -> forall m':Map B, mapcanon (MapDomRestrBy A B m m').
Proof.
- Induction m. Intros. Exact M0_canon.
- Simpl. Intros a y H m'. Case (MapGet B m' a). Assumption.
- Intro. Exact M0_canon.
- Induction m'. Exact H1.
- Intros a y. Simpl. Case (ad_bit_0 a). Apply makeM2_canon. Exact (mapcanon_M2_1 ? ? H1).
- Apply MapRemove_canon. Exact (mapcanon_M2_2 ? ? H1).
- Apply makeM2_canon. Apply MapRemove_canon. Exact (mapcanon_M2_1 ? ? H1).
- Exact (mapcanon_M2_2 ? ? H1).
- Intros. Simpl. Apply makeM2_canon. Apply H. Exact (mapcanon_M2_1 ? ? H1).
- Apply H0. Exact (mapcanon_M2_2 ? ? H1).
+ simple induction m. intros. exact M0_canon.
+ simpl in |- *. intros a y H m'. case (MapGet B m' a). assumption.
+ intro. exact M0_canon.
+ simple induction m'. exact H1.
+ intros a y. simpl in |- *. case (ad_bit_0 a). apply makeM2_canon. exact (mapcanon_M2_1 _ _ H1).
+ apply MapRemove_canon. exact (mapcanon_M2_2 _ _ H1).
+ apply makeM2_canon. apply MapRemove_canon. exact (mapcanon_M2_1 _ _ H1).
+ exact (mapcanon_M2_2 _ _ H1).
+ intros. simpl in |- *. apply makeM2_canon. apply H. exact (mapcanon_M2_1 _ _ H1).
+ apply H0. exact (mapcanon_M2_2 _ _ H1).
Qed.
- Lemma Map_of_alist_canon : (l:(alist A)) (mapcanon (Map_of_alist A l)).
+ Lemma Map_of_alist_canon : forall l:alist A, mapcanon (Map_of_alist A l).
Proof.
- Induction l. Exact M0_canon.
- Intro r. Elim r. Intros a y l0 H. Simpl. Apply MapPut_canon. Assumption.
+ simple induction l. exact M0_canon.
+ intro r. elim r. intros a y l0 H. simpl in |- *. apply MapPut_canon. assumption.
Qed.
- Lemma MapSubset_c_1 : (m:(Map A)) (m':(Map B)) (mapcanon m) ->
- (MapSubset A B m m') -> (MapDomRestrBy A B m m')=(M0 A).
+ Lemma MapSubset_c_1 :
+ forall (m:Map A) (m':Map B),
+ mapcanon m -> MapSubset A B m m' -> MapDomRestrBy A B m m' = M0 A.
Proof.
- Intros. Apply mapcanon_unique. Apply MapDomRestrBy_canon. Assumption.
- Apply M0_canon.
- Exact (MapSubset_imp_2 ? ? m m' H0).
+ intros. apply mapcanon_unique. apply MapDomRestrBy_canon. assumption.
+ apply M0_canon.
+ exact (MapSubset_imp_2 _ _ m m' H0).
Qed.
- Lemma MapSubset_c_2 : (m:(Map A)) (m':(Map B))
- (MapDomRestrBy A B m m')=(M0 A) -> (MapSubset A B m m').
+ Lemma MapSubset_c_2 :
+ forall (m:Map A) (m':Map B),
+ MapDomRestrBy A B m m' = M0 A -> MapSubset A B m m'.
Proof.
- Intros. Apply MapSubset_2_imp. Unfold MapSubset_2. Rewrite H. Apply eqmap_refl.
+ intros. apply MapSubset_2_imp. unfold MapSubset_2 in |- *. rewrite H. apply eqmap_refl.
Qed.
End MapCanon.
@@ -325,52 +337,63 @@ Section FSetCanon.
Variable A : Set.
- Lemma MapDom_canon : (m:(Map A)) (mapcanon A m) -> (mapcanon unit (MapDom A m)).
+ Lemma MapDom_canon :
+ forall m:Map A, mapcanon A m -> mapcanon unit (MapDom A m).
Proof.
- Induction m. Intro. Exact (M0_canon unit).
- Intros a y H. Exact (M1_canon unit a ?).
- Intros. Simpl. Apply M2_canon. Apply H. Exact (mapcanon_M2_1 A ? ? H1).
- Apply H0. Exact (mapcanon_M2_2 A ? ? H1).
- Change (le (2) (MapCard unit (MapDom A (M2 A m0 m1)))). Rewrite <- MapCard_Dom.
- Exact (mapcanon_M2 A ? ? H1).
+ simple induction m. intro. exact (M0_canon unit).
+ intros a y H. exact (M1_canon unit a _).
+ intros. simpl in |- *. apply M2_canon. apply H. exact (mapcanon_M2_1 A _ _ H1).
+ apply H0. exact (mapcanon_M2_2 A _ _ H1).
+ change (2 <= MapCard unit (MapDom A (M2 A m0 m1))) in |- *. rewrite <- MapCard_Dom.
+ exact (mapcanon_M2 A _ _ H1).
Qed.
End FSetCanon.
Section MapFoldCanon.
- Variable A, B : Set.
-
- Lemma MapFold_canon_1 : (m0:(Map B)) (mapcanon B m0) ->
- (op : (Map B) -> (Map B) -> (Map B))
- ((m1:(Map B)) (mapcanon B m1) -> (m2:(Map B)) (mapcanon B m2) ->
- (mapcanon B (op m1 m2))) ->
- (f : ad->A->(Map B)) ((a:ad) (y:A) (mapcanon B (f a y))) ->
- (m:(Map A)) (pf : ad->ad) (mapcanon B (MapFold1 A (Map B) m0 op f pf m)).
+ Variables A B : Set.
+
+ Lemma MapFold_canon_1 :
+ forall m0:Map B,
+ mapcanon B m0 ->
+ forall op:Map B -> Map B -> Map B,
+ (forall m1:Map B,
+ mapcanon B m1 ->
+ forall m2:Map B, mapcanon B m2 -> mapcanon B (op m1 m2)) ->
+ forall f:ad -> A -> Map B,
+ (forall (a:ad) (y:A), mapcanon B (f a y)) ->
+ forall (m:Map A) (pf:ad -> ad),
+ mapcanon B (MapFold1 A (Map B) m0 op f pf m).
Proof.
- Induction m. Intro. Exact H.
- Intros a y pf. Simpl. Apply H1.
- Intros. Simpl. Apply H0. Apply H2.
- Apply H3.
+ simple induction m. intro. exact H.
+ intros a y pf. simpl in |- *. apply H1.
+ intros. simpl in |- *. apply H0. apply H2.
+ apply H3.
Qed.
- Lemma MapFold_canon : (m0:(Map B)) (mapcanon B m0) ->
- (op : (Map B) -> (Map B) -> (Map B))
- ((m1:(Map B)) (mapcanon B m1) -> (m2:(Map B)) (mapcanon B m2) ->
- (mapcanon B (op m1 m2))) ->
- (f : ad->A->(Map B)) ((a:ad) (y:A) (mapcanon B (f a y))) ->
- (m:(Map A)) (mapcanon B (MapFold A (Map B) m0 op f m)).
+ Lemma MapFold_canon :
+ forall m0:Map B,
+ mapcanon B m0 ->
+ forall op:Map B -> Map B -> Map B,
+ (forall m1:Map B,
+ mapcanon B m1 ->
+ forall m2:Map B, mapcanon B m2 -> mapcanon B (op m1 m2)) ->
+ forall f:ad -> A -> Map B,
+ (forall (a:ad) (y:A), mapcanon B (f a y)) ->
+ forall m:Map A, mapcanon B (MapFold A (Map B) m0 op f m).
Proof.
- Intros. Exact (MapFold_canon_1 m0 H op H0 f H1 m [a:ad]a).
+ intros. exact (MapFold_canon_1 m0 H op H0 f H1 m (fun a:ad => a)).
Qed.
- Lemma MapCollect_canon :
- (f : ad->A->(Map B)) ((a:ad) (y:A) (mapcanon B (f a y))) ->
- (m:(Map A)) (mapcanon B (MapCollect A B f m)).
+ Lemma MapCollect_canon :
+ forall f:ad -> A -> Map B,
+ (forall (a:ad) (y:A), mapcanon B (f a y)) ->
+ forall m:Map A, mapcanon B (MapCollect A B f m).
Proof.
- Intros. Rewrite MapCollect_as_Fold. Apply MapFold_canon. Apply M0_canon.
- Intros. Exact (MapMerge_canon B m1 m2 H0 H1).
- Assumption.
+ intros. rewrite MapCollect_as_Fold. apply MapFold_canon. apply M0_canon.
+ intros. exact (MapMerge_canon B m1 m2 H0 H1).
+ assumption.
Qed.
-End MapFoldCanon.
+End MapFoldCanon. \ No newline at end of file
diff --git a/theories/IntMap/Mapcard.v b/theories/IntMap/Mapcard.v
index e124a11f6..fe598c412 100644
--- a/theories/IntMap/Mapcard.v
+++ b/theories/IntMap/Mapcard.v
@@ -7,664 +7,758 @@
(***********************************************************************)
(*i $Id$ i*)
-Require Bool.
-Require Sumbool.
-Require Arith.
-Require ZArith.
-Require Addr.
-Require Adist.
-Require Addec.
-Require Map.
-Require Mapaxioms.
-Require Mapiter.
-Require Fset.
-Require Mapsubset.
-Require PolyList.
-Require Lsort.
-Require Peano_dec.
+Require Import Bool.
+Require Import Sumbool.
+Require Import Arith.
+Require Import ZArith.
+Require Import Addr.
+Require Import Adist.
+Require Import Addec.
+Require Import Map.
+Require Import Mapaxioms.
+Require Import Mapiter.
+Require Import Fset.
+Require Import Mapsubset.
+Require Import List.
+Require Import Lsort.
+Require Import Peano_dec.
Section MapCard.
- Variable A, B : Set.
+ Variables A B : Set.
+
+ Lemma MapCard_M0 : MapCard A (M0 A) = 0.
+ Proof.
+ trivial.
+ Qed.
+
+ Lemma MapCard_M1 : forall (a:ad) (y:A), MapCard A (M1 A a y) = 1.
+ Proof.
+ trivial.
+ Qed.
+
+ Lemma MapCard_is_O :
+ forall m:Map A, MapCard A m = 0 -> forall a:ad, MapGet A m a = NONE A.
+ Proof.
+ simple induction m. trivial.
+ intros a y H. discriminate H.
+ intros. simpl in H1. elim (plus_is_O _ _ H1). intros. rewrite (MapGet_M2_bit_0_if A m0 m1 a).
+ case (ad_bit_0 a). apply H0. assumption.
+ apply H. assumption.
+ Qed.
- Lemma MapCard_M0 : (MapCard A (M0 A))=O.
+ Lemma MapCard_is_not_O :
+ forall (m:Map A) (a:ad) (y:A),
+ MapGet A m a = SOME A y -> {n : nat | MapCard A m = S n}.
Proof.
- Trivial.
+ simple induction m. intros. discriminate H.
+ intros a y a0 y0 H. simpl in H. elim (sumbool_of_bool (ad_eq a a0)). intro H0. split with 0.
+ reflexivity.
+ intro H0. rewrite H0 in H. discriminate H.
+ intros. elim (sumbool_of_bool (ad_bit_0 a)). intro H2.
+ rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1) in H1. elim (H0 (ad_div_2 a) y H1). intros n H3.
+ simpl in |- *. rewrite H3. split with (MapCard A m0 + n).
+ rewrite <- (plus_Snm_nSm (MapCard A m0) n). reflexivity.
+ intro H2. rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1) in H1. elim (H (ad_div_2 a) y H1).
+ intros n H3. simpl in |- *. rewrite H3. split with (n + MapCard A m1). reflexivity.
Qed.
- Lemma MapCard_M1 : (a:ad) (y:A) (MapCard A (M1 A a y))=(1).
+ Lemma MapCard_is_one :
+ forall m:Map A,
+ MapCard A m = 1 -> {a : ad & {y : A | MapGet A m a = SOME A y}}.
Proof.
- Trivial.
+ simple induction m. intro. discriminate H.
+ intros a y H. split with a. split with y. apply M1_semantics_1.
+ intros. simpl in H1. elim (plus_is_one (MapCard A m0) (MapCard A m1) H1).
+ intro H2. elim H2. intros. elim (H0 H4). intros a H5. split with (ad_double_plus_un a).
+ rewrite (MapGet_M2_bit_0_1 A _ (ad_double_plus_un_bit_0 a) m0 m1).
+ rewrite ad_double_plus_un_div_2. exact H5.
+ intro H2. elim H2. intros. elim (H H3). intros a H5. split with (ad_double a).
+ rewrite (MapGet_M2_bit_0_0 A _ (ad_double_bit_0 a) m0 m1).
+ rewrite ad_double_div_2. exact H5.
Qed.
- Lemma MapCard_is_O : (m:(Map A)) (MapCard A m)=O ->
- (a:ad) (MapGet A m a)=(NONE A).
+ Lemma MapCard_is_one_unique :
+ forall m:Map A,
+ MapCard A m = 1 ->
+ forall (a a':ad) (y y':A),
+ MapGet A m a = SOME A y ->
+ MapGet A m a' = SOME A y' -> a = a' /\ y = y'.
Proof.
- Induction m. Trivial.
- Intros a y H. Discriminate H.
- Intros. Simpl in H1. Elim (plus_is_O ? ? H1). Intros. Rewrite (MapGet_M2_bit_0_if A m0 m1 a).
- Case (ad_bit_0 a). Apply H0. Assumption.
- Apply H. Assumption.
+ simple induction m. intro. discriminate H.
+ intros. elim (sumbool_of_bool (ad_eq a a1)). intro H2. rewrite (ad_eq_complete _ _ H2) in H0.
+ rewrite (M1_semantics_1 A a1 a0) in H0. inversion H0. elim (sumbool_of_bool (ad_eq a a')).
+ intro H5. rewrite (ad_eq_complete _ _ H5) in H1. rewrite (M1_semantics_1 A a' a0) in H1.
+ inversion H1. rewrite <- (ad_eq_complete _ _ H2). rewrite <- (ad_eq_complete _ _ H5).
+ rewrite <- H4. rewrite <- H6. split; reflexivity.
+ intro H5. rewrite (M1_semantics_2 A a a' a0 H5) in H1. discriminate H1.
+ intro H2. rewrite (M1_semantics_2 A a a1 a0 H2) in H0. discriminate H0.
+ intros. simpl in H1. elim (plus_is_one _ _ H1). intro H4. elim H4. intros.
+ rewrite (MapGet_M2_bit_0_if A m0 m1 a) in H2. elim (sumbool_of_bool (ad_bit_0 a)).
+ intro H7. rewrite H7 in H2. rewrite (MapGet_M2_bit_0_if A m0 m1 a') in H3.
+ elim (sumbool_of_bool (ad_bit_0 a')). intro H8. rewrite H8 in H3. elim (H0 H6 _ _ _ _ H2 H3).
+ intros. split. rewrite <- (ad_div_2_double_plus_un a H7).
+ rewrite <- (ad_div_2_double_plus_un a' H8). rewrite H9. reflexivity.
+ assumption.
+ intro H8. rewrite H8 in H3. rewrite (MapCard_is_O m0 H5 (ad_div_2 a')) in H3.
+ discriminate H3.
+ intro H7. rewrite H7 in H2. rewrite (MapCard_is_O m0 H5 (ad_div_2 a)) in H2.
+ discriminate H2.
+ intro H4. elim H4. intros. rewrite (MapGet_M2_bit_0_if A m0 m1 a) in H2.
+ elim (sumbool_of_bool (ad_bit_0 a)). intro H7. rewrite H7 in H2.
+ rewrite (MapCard_is_O m1 H6 (ad_div_2 a)) in H2. discriminate H2.
+ intro H7. rewrite H7 in H2. rewrite (MapGet_M2_bit_0_if A m0 m1 a') in H3.
+ elim (sumbool_of_bool (ad_bit_0 a')). intro H8. rewrite H8 in H3.
+ rewrite (MapCard_is_O m1 H6 (ad_div_2 a')) in H3. discriminate H3.
+ intro H8. rewrite H8 in H3. elim (H H5 _ _ _ _ H2 H3). intros. split.
+ rewrite <- (ad_div_2_double a H7). rewrite <- (ad_div_2_double a' H8).
+ rewrite H9. reflexivity.
+ assumption.
Qed.
- Lemma MapCard_is_not_O : (m:(Map A)) (a:ad) (y:A) (MapGet A m a)=(SOME A y) ->
- {n:nat | (MapCard A m)=(S n)}.
+ Lemma length_as_fold :
+ forall (C:Set) (l:list C),
+ length l = fold_right (fun (_:C) (n:nat) => S n) 0 l.
Proof.
- Induction m. Intros. Discriminate H.
- Intros a y a0 y0 H. Simpl in H. Elim (sumbool_of_bool (ad_eq a a0)). Intro H0. Split with O.
- Reflexivity.
- Intro H0. Rewrite H0 in H. Discriminate H.
- Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H2.
- Rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1) in H1. Elim (H0 (ad_div_2 a) y H1). Intros n H3.
- Simpl. Rewrite H3. Split with (plus (MapCard A m0) n).
- Rewrite <- (plus_Snm_nSm (MapCard A m0) n). Reflexivity.
- Intro H2. Rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1) in H1. Elim (H (ad_div_2 a) y H1).
- Intros n H3. Simpl. Rewrite H3. Split with (plus n (MapCard A m1)). Reflexivity.
+ simple induction l. reflexivity.
+ intros. simpl in |- *. rewrite H. reflexivity.
Qed.
- Lemma MapCard_is_one : (m:(Map A)) (MapCard A m)=(1) ->
- {a:ad & {y:A | (MapGet A m a)=(SOME A y)}}.
- Proof.
- Induction m. Intro. Discriminate H.
- Intros a y H. Split with a. Split with y. Apply M1_semantics_1.
- Intros. Simpl in H1. Elim (plus_is_one (MapCard A m0) (MapCard A m1) H1).
- Intro H2. Elim H2. Intros. Elim (H0 H4). Intros a H5. Split with (ad_double_plus_un a).
- Rewrite (MapGet_M2_bit_0_1 A ? (ad_double_plus_un_bit_0 a) m0 m1).
- Rewrite ad_double_plus_un_div_2. Exact H5.
- Intro H2. Elim H2. Intros. Elim (H H3). Intros a H5. Split with (ad_double a).
- Rewrite (MapGet_M2_bit_0_0 A ? (ad_double_bit_0 a) m0 m1).
- Rewrite ad_double_div_2. Exact H5.
- Qed.
-
- Lemma MapCard_is_one_unique : (m:(Map A)) (MapCard A m)=(1) -> (a,a':ad) (y,y':A)
- (MapGet A m a)=(SOME A y) -> (MapGet A m a')=(SOME A y') ->
- a=a' /\ y=y'.
- Proof.
- Induction m. Intro. Discriminate H.
- Intros. Elim (sumbool_of_bool (ad_eq a a1)). Intro H2. Rewrite (ad_eq_complete ? ? H2) in H0.
- Rewrite (M1_semantics_1 A a1 a0) in H0. Inversion H0. Elim (sumbool_of_bool (ad_eq a a')).
- Intro H5. Rewrite (ad_eq_complete ? ? H5) in H1. Rewrite (M1_semantics_1 A a' a0) in H1.
- Inversion H1. Rewrite <- (ad_eq_complete ? ? H2). Rewrite <- (ad_eq_complete ? ? H5).
- Rewrite <- H4. Rewrite <- H6. (Split; Reflexivity).
- Intro H5. Rewrite (M1_semantics_2 A a a' a0 H5) in H1. Discriminate H1.
- Intro H2. Rewrite (M1_semantics_2 A a a1 a0 H2) in H0. Discriminate H0.
- Intros. Simpl in H1. Elim (plus_is_one ? ? H1). Intro H4. Elim H4. Intros.
- Rewrite (MapGet_M2_bit_0_if A m0 m1 a) in H2. Elim (sumbool_of_bool (ad_bit_0 a)).
- Intro H7. Rewrite H7 in H2. Rewrite (MapGet_M2_bit_0_if A m0 m1 a') in H3.
- Elim (sumbool_of_bool (ad_bit_0 a')). Intro H8. Rewrite H8 in H3. Elim (H0 H6 ? ? ? ? H2 H3).
- Intros. Split. Rewrite <- (ad_div_2_double_plus_un a H7).
- Rewrite <- (ad_div_2_double_plus_un a' H8). Rewrite H9. Reflexivity.
- Assumption.
- Intro H8. Rewrite H8 in H3. Rewrite (MapCard_is_O m0 H5 (ad_div_2 a')) in H3.
- Discriminate H3.
- Intro H7. Rewrite H7 in H2. Rewrite (MapCard_is_O m0 H5 (ad_div_2 a)) in H2.
- Discriminate H2.
- Intro H4. Elim H4. Intros. Rewrite (MapGet_M2_bit_0_if A m0 m1 a) in H2.
- Elim (sumbool_of_bool (ad_bit_0 a)). Intro H7. Rewrite H7 in H2.
- Rewrite (MapCard_is_O m1 H6 (ad_div_2 a)) in H2. Discriminate H2.
- Intro H7. Rewrite H7 in H2. Rewrite (MapGet_M2_bit_0_if A m0 m1 a') in H3.
- Elim (sumbool_of_bool (ad_bit_0 a')). Intro H8. Rewrite H8 in H3.
- Rewrite (MapCard_is_O m1 H6 (ad_div_2 a')) in H3. Discriminate H3.
- Intro H8. Rewrite H8 in H3. Elim (H H5 ? ? ? ? H2 H3). Intros. Split.
- Rewrite <- (ad_div_2_double a H7). Rewrite <- (ad_div_2_double a' H8).
- Rewrite H9. Reflexivity.
- Assumption.
- Qed.
-
- Lemma length_as_fold : (C:Set) (l:(list C))
- (length l)=(fold_right [_:C][n:nat](S n) O l).
- Proof.
- Induction l. Reflexivity.
- Intros. Simpl. Rewrite H. Reflexivity.
- Qed.
-
- Lemma length_as_fold_2 : (l:(alist A))
- (length l)=(fold_right [r:ad*A][n:nat]let (a,y)=r in (plus (1) n) O l).
- Proof.
- Induction l. Reflexivity.
- Intros. Simpl. Rewrite H. (Elim a; Reflexivity).
- Qed.
-
- Lemma MapCard_as_Fold_1 : (m:(Map A)) (pf:ad->ad)
- (MapCard A m)=(MapFold1 A nat O plus [_:ad][_:A](1) pf m).
- Proof.
- Induction m. Trivial.
- Trivial.
- Intros. Simpl. Rewrite <- (H [a0:ad](pf (ad_double a0))).
- Rewrite <- (H0 [a0:ad](pf (ad_double_plus_un a0))). Reflexivity.
- Qed.
-
- Lemma MapCard_as_Fold :
- (m:(Map A)) (MapCard A m)=(MapFold A nat O plus [_:ad][_:A](1) m).
- Proof.
- Intro. Exact (MapCard_as_Fold_1 m [a0:ad]a0).
+ Lemma length_as_fold_2 :
+ forall l:alist A,
+ length l =
+ fold_right (fun (r:ad * A) (n:nat) => let (a, y) := r in 1 + n) 0 l.
+ Proof.
+ simple induction l. reflexivity.
+ intros. simpl in |- *. rewrite H. elim a; reflexivity.
+ Qed.
+
+ Lemma MapCard_as_Fold_1 :
+ forall (m:Map A) (pf:ad -> ad),
+ MapCard A m = MapFold1 A nat 0 plus (fun (_:ad) (_:A) => 1) pf m.
+ Proof.
+ simple induction m. trivial.
+ trivial.
+ intros. simpl in |- *. rewrite <- (H (fun a0:ad => pf (ad_double a0))).
+ rewrite <- (H0 (fun a0:ad => pf (ad_double_plus_un a0))). reflexivity.
+ Qed.
+
+ Lemma MapCard_as_Fold :
+ forall m:Map A,
+ MapCard A m = MapFold A nat 0 plus (fun (_:ad) (_:A) => 1) m.
+ Proof.
+ intro. exact (MapCard_as_Fold_1 m (fun a0:ad => a0)).
Qed.
- Lemma MapCard_as_length : (m:(Map A)) (MapCard A m)=(length (alist_of_Map A m)).
- Proof.
- Intro. Rewrite MapCard_as_Fold. Rewrite length_as_fold_2.
- Apply MapFold_as_fold with op:=plus neutral:=O f:=[_:ad][_:A](1). Exact plus_assoc_r.
- Trivial.
- Intro. Rewrite <- plus_n_O. Reflexivity.
- Qed.
-
- Lemma MapCard_Put1_equals_2 : (p:positive) (a,a':ad) (y,y':A)
- (MapCard A (MapPut1 A a y a' y' p))=(2).
- Proof.
- Induction p. Intros. Simpl. (Case (ad_bit_0 a); Reflexivity).
- Intros. Simpl. Case (ad_bit_0 a). Exact (H (ad_div_2 a) (ad_div_2 a') y y').
- Simpl. Rewrite <- plus_n_O. Exact (H (ad_div_2 a) (ad_div_2 a') y y').
- Intros. Simpl. (Case (ad_bit_0 a); Reflexivity).
- Qed.
-
- Lemma MapCard_Put_sum : (m,m':(Map A)) (a:ad) (y:A) (n,n':nat)
- m'=(MapPut A m a y) -> n=(MapCard A m) -> n'=(MapCard A m') ->
- {n'=n}+{n'=(S n)}.
- Proof.
- Induction m. Simpl. Intros. Rewrite H in H1. Simpl in H1. Right .
- Rewrite H0. Rewrite H1. Reflexivity.
- Intros a y m' a0 y0 n n' H H0 H1. Simpl in H. Elim (ad_sum (ad_xor a a0)). Intro H2.
- Elim H2. Intros p H3. Rewrite H3 in H. Rewrite H in H1.
- Rewrite (MapCard_Put1_equals_2 p a a0 y y0) in H1. Simpl in H0. Right .
- Rewrite H0. Rewrite H1. Reflexivity.
- Intro H2. Rewrite H2 in H. Rewrite H in H1. Simpl in H1. Simpl in H0. Left .
- Rewrite H0. Rewrite H1. Reflexivity.
- Intros. Simpl in H2. Rewrite (MapPut_semantics_3_1 A m0 m1 a y) in H1.
- Elim (sumbool_of_bool (ad_bit_0 a)). Intro H4. Rewrite H4 in H1.
- Elim (H0 (MapPut A m1 (ad_div_2 a) y) (ad_div_2 a) y (MapCard A m1)
- (MapCard A (MapPut A m1 (ad_div_2 a) y)) (refl_equal ? ?)
- (refl_equal ? ?) (refl_equal ? ?)).
- Intro H5. Rewrite H1 in H3. Simpl in H3. Rewrite H5 in H3. Rewrite <- H2 in H3. Left .
- Assumption.
- Intro H5. Rewrite H1 in H3. Simpl in H3. Rewrite H5 in H3.
- Rewrite <- (plus_Snm_nSm (MapCard A m0) (MapCard A m1)) in H3.
- Simpl in H3. Rewrite <- H2 in H3. Right . Assumption.
- Intro H4. Rewrite H4 in H1.
- Elim (H (MapPut A m0 (ad_div_2 a) y) (ad_div_2 a) y (MapCard A m0)
- (MapCard A (MapPut A m0 (ad_div_2 a) y)) (refl_equal ? ?)
- (refl_equal ? ?) (refl_equal ? ?)).
- Intro H5. Rewrite H1 in H3. Simpl in H3. Rewrite H5 in H3. Rewrite <- H2 in H3.
- Left . Assumption.
- Intro H5. Rewrite H1 in H3. Simpl in H3. Rewrite H5 in H3. Simpl in H3. Rewrite <- H2 in H3.
- Right . Assumption.
- Qed.
-
- Lemma MapCard_Put_lb : (m:(Map A)) (a:ad) (y:A)
- (ge (MapCard A (MapPut A m a y)) (MapCard A m)).
- Proof.
- Unfold ge. Intros.
- Elim (MapCard_Put_sum m (MapPut A m a y) a y (MapCard A m)
- (MapCard A (MapPut A m a y)) (refl_equal ? ?) (refl_equal ? ?)
- (refl_equal ? ?)).
- Intro H. Rewrite H. Apply le_n.
- Intro H. Rewrite H. Apply le_n_Sn.
- Qed.
-
- Lemma MapCard_Put_ub : (m:(Map A)) (a:ad) (y:A)
- (le (MapCard A (MapPut A m a y)) (S (MapCard A m))).
- Proof.
- Intros.
- Elim (MapCard_Put_sum m (MapPut A m a y) a y (MapCard A m)
- (MapCard A (MapPut A m a y)) (refl_equal ? ?) (refl_equal ? ?)
- (refl_equal ? ?)).
- Intro H. Rewrite H. Apply le_n_Sn.
- Intro H. Rewrite H. Apply le_n.
- Qed.
-
- Lemma MapCard_Put_1 : (m:(Map A)) (a:ad) (y:A)
- (MapCard A (MapPut A m a y))=(MapCard A m) ->
- {y:A | (MapGet A m a)=(SOME A y)}.
- Proof.
- Induction m. Intros. Discriminate H.
- Intros a y a0 y0 H. Simpl in H. Elim (ad_sum (ad_xor a a0)). Intro H0. Elim H0.
- Intros p H1. Rewrite H1 in H. Rewrite (MapCard_Put1_equals_2 p a a0 y y0) in H.
- Discriminate H.
- Intro H0. Rewrite H0 in H. Rewrite (ad_xor_eq ? ? H0). Split with y. Apply M1_semantics_1.
- Intros. Rewrite (MapPut_semantics_3_1 A m0 m1 a y) in H1. Elim (sumbool_of_bool (ad_bit_0 a)).
- Intro H2. Rewrite H2 in H1. Simpl in H1. Elim (H0 (ad_div_2 a) y (simpl_plus_l ? ? ? H1)).
- Intros y0 H3. Split with y0. Rewrite <- H3. Exact (MapGet_M2_bit_0_1 A a H2 m0 m1).
- Intro H2. Rewrite H2 in H1. Simpl in H1.
- Rewrite (plus_sym (MapCard A (MapPut A m0 (ad_div_2 a) y)) (MapCard A m1)) in H1.
- Rewrite (plus_sym (MapCard A m0) (MapCard A m1)) in H1.
- Elim (H (ad_div_2 a) y (simpl_plus_l ? ? ? H1)). Intros y0 H3. Split with y0.
- Rewrite <- H3. Exact (MapGet_M2_bit_0_0 A a H2 m0 m1).
- Qed.
-
- Lemma MapCard_Put_2 : (m:(Map A)) (a:ad) (y:A)
- (MapCard A (MapPut A m a y))=(S (MapCard A m)) -> (MapGet A m a)=(NONE A).
- Proof.
- Induction m. Trivial.
- Intros. Simpl in H. Elim (sumbool_of_bool (ad_eq a a1)). Intro H0.
- Rewrite (ad_eq_complete ? ? H0) in H. Rewrite (ad_xor_nilpotent a1) in H. Discriminate H.
- Intro H0. Exact (M1_semantics_2 A a a1 a0 H0).
- Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H2.
- Rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1). Apply (H0 (ad_div_2 a) y).
- Apply simpl_plus_l with n:=(MapCard A m0).
- Rewrite <- (plus_Snm_nSm (MapCard A m0) (MapCard A m1)). Simpl in H1. Simpl. Rewrite <- H1.
- Clear H1.
- NewInduction a. Discriminate H2.
- NewInduction p. Reflexivity.
- Discriminate H2.
- Reflexivity.
- Intro H2. Rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1). Apply (H (ad_div_2 a) y).
- Cut (plus (MapCard A (MapPut A m0 (ad_div_2 a) y)) (MapCard A m1))
- =(plus (S (MapCard A m0)) (MapCard A m1)).
- Intro. Rewrite (plus_sym (MapCard A (MapPut A m0 (ad_div_2 a) y)) (MapCard A m1)) in H3.
- Rewrite (plus_sym (S (MapCard A m0)) (MapCard A m1)) in H3. Exact (simpl_plus_l ? ? ? H3).
- Simpl. Simpl in H1. Rewrite <- H1. NewInduction a. Trivial.
- NewInduction p. Discriminate H2.
- Reflexivity.
- Discriminate H2.
- Qed.
-
- Lemma MapCard_Put_1_conv : (m:(Map A)) (a:ad) (y,y':A)
- (MapGet A m a)=(SOME A y) -> (MapCard A (MapPut A m a y'))=(MapCard A m).
- Proof.
- Intros.
- Elim (MapCard_Put_sum m (MapPut A m a y') a y' (MapCard A m)
- (MapCard A (MapPut A m a y')) (refl_equal ? ?) (refl_equal ? ?)
- (refl_equal ? ?)).
- Trivial.
- Intro H0. Rewrite (MapCard_Put_2 m a y' H0) in H. Discriminate H.
- Qed.
-
- Lemma MapCard_Put_2_conv : (m:(Map A)) (a:ad) (y:A)
- (MapGet A m a)=(NONE A) -> (MapCard A (MapPut A m a y))=(S (MapCard A m)).
- Proof.
- Intros.
- Elim (MapCard_Put_sum m (MapPut A m a y) a y (MapCard A m)
- (MapCard A (MapPut A m a y)) (refl_equal ? ?) (refl_equal ? ?)
- (refl_equal ? ?)).
- Intro H0. Elim (MapCard_Put_1 m a y H0). Intros y' H1. Rewrite H1 in H. Discriminate H.
- Trivial.
- Qed.
-
- Lemma MapCard_ext : (m,m':(Map A))
- (eqm A (MapGet A m) (MapGet A m')) -> (MapCard A m)=(MapCard A m').
- Proof.
- Unfold eqm. Intros. Rewrite (MapCard_as_length m). Rewrite (MapCard_as_length m').
- Rewrite (alist_canonical A (alist_of_Map A m) (alist_of_Map A m')). Reflexivity.
- Unfold eqm. Intro. Rewrite (Map_of_alist_semantics A (alist_of_Map A m) a).
- Rewrite (Map_of_alist_semantics A (alist_of_Map A m') a). Rewrite (Map_of_alist_of_Map A m' a).
- Rewrite (Map_of_alist_of_Map A m a). Exact (H a).
- Apply alist_of_Map_sorts2.
- Apply alist_of_Map_sorts2.
- Qed.
-
- Lemma MapCard_Dom : (m:(Map A)) (MapCard A m)=(MapCard unit (MapDom A m)).
- Proof.
- (Induction m; Trivial). Intros. Simpl. Rewrite H. Rewrite H0. Reflexivity.
- Qed.
-
- Lemma MapCard_Dom_Put_behind : (m:(Map A)) (a:ad) (y:A)
- (MapDom A (MapPut_behind A m a y))=(MapDom A (MapPut A m a y)).
- Proof.
- Induction m. Trivial.
- Intros a y a0 y0. Simpl. Elim (ad_sum (ad_xor a a0)). Intro H. Elim H.
- Intros p H0. Rewrite H0. Reflexivity.
- Intro H. Rewrite H. Rewrite (ad_xor_eq ? ? H). Reflexivity.
- Intros. Simpl. Elim (ad_sum a). Intro H1. Elim H1. Intros p H2. Rewrite H2. Case p.
- Intro p0. Simpl. Rewrite H0. Reflexivity.
- Intro p0. Simpl. Rewrite H. Reflexivity.
- Simpl. Rewrite H0. Reflexivity.
- Intro H1. Rewrite H1. Simpl. Rewrite H. Reflexivity.
- Qed.
-
- Lemma MapCard_Put_behind_Put : (m:(Map A)) (a:ad) (y:A)
- (MapCard A (MapPut_behind A m a y))=(MapCard A (MapPut A m a y)).
- Proof.
- Intros. Rewrite MapCard_Dom. Rewrite MapCard_Dom. Rewrite MapCard_Dom_Put_behind.
- Reflexivity.
- Qed.
-
- Lemma MapCard_Put_behind_sum : (m,m':(Map A)) (a:ad) (y:A) (n,n':nat)
- m'=(MapPut_behind A m a y) -> n=(MapCard A m) -> n'=(MapCard A m') ->
- {n'=n}+{n'=(S n)}.
- Proof.
- Intros. (Apply (MapCard_Put_sum m (MapPut A m a y) a y n n'); Trivial).
- Rewrite <- MapCard_Put_behind_Put. Rewrite <- H. Assumption.
- Qed.
+ Lemma MapCard_as_length :
+ forall m:Map A, MapCard A m = length (alist_of_Map A m).
+ Proof.
+ intro. rewrite MapCard_as_Fold. rewrite length_as_fold_2.
+ apply MapFold_as_fold with
+ (op := plus) (neutral := 0) (f := fun (_:ad) (_:A) => 1). exact plus_assoc_reverse.
+ trivial.
+ intro. rewrite <- plus_n_O. reflexivity.
+ Qed.
+
+ Lemma MapCard_Put1_equals_2 :
+ forall (p:positive) (a a':ad) (y y':A),
+ MapCard A (MapPut1 A a y a' y' p) = 2.
+ Proof.
+ simple induction p. intros. simpl in |- *. case (ad_bit_0 a); reflexivity.
+ intros. simpl in |- *. case (ad_bit_0 a). exact (H (ad_div_2 a) (ad_div_2 a') y y').
+ simpl in |- *. rewrite <- plus_n_O. exact (H (ad_div_2 a) (ad_div_2 a') y y').
+ intros. simpl in |- *. case (ad_bit_0 a); reflexivity.
+ Qed.
+
+ Lemma MapCard_Put_sum :
+ forall (m m':Map A) (a:ad) (y:A) (n n':nat),
+ m' = MapPut A m a y ->
+ n = MapCard A m -> n' = MapCard A m' -> {n' = n} + {n' = S n}.
+ Proof.
+ simple induction m. simpl in |- *. intros. rewrite H in H1. simpl in H1. right.
+ rewrite H0. rewrite H1. reflexivity.
+ intros a y m' a0 y0 n n' H H0 H1. simpl in H. elim (ad_sum (ad_xor a a0)). intro H2.
+ elim H2. intros p H3. rewrite H3 in H. rewrite H in H1.
+ rewrite (MapCard_Put1_equals_2 p a a0 y y0) in H1. simpl in H0. right.
+ rewrite H0. rewrite H1. reflexivity.
+ intro H2. rewrite H2 in H. rewrite H in H1. simpl in H1. simpl in H0. left.
+ rewrite H0. rewrite H1. reflexivity.
+ intros. simpl in H2. rewrite (MapPut_semantics_3_1 A m0 m1 a y) in H1.
+ elim (sumbool_of_bool (ad_bit_0 a)). intro H4. rewrite H4 in H1.
+ elim
+ (H0 (MapPut A m1 (ad_div_2 a) y) (ad_div_2 a) y (
+ MapCard A m1) (MapCard A (MapPut A m1 (ad_div_2 a) y)) (
+ refl_equal _) (refl_equal _) (refl_equal _)).
+ intro H5. rewrite H1 in H3. simpl in H3. rewrite H5 in H3. rewrite <- H2 in H3. left.
+ assumption.
+ intro H5. rewrite H1 in H3. simpl in H3. rewrite H5 in H3.
+ rewrite <- (plus_Snm_nSm (MapCard A m0) (MapCard A m1)) in H3.
+ simpl in H3. rewrite <- H2 in H3. right. assumption.
+ intro H4. rewrite H4 in H1.
+ elim
+ (H (MapPut A m0 (ad_div_2 a) y) (ad_div_2 a) y (
+ MapCard A m0) (MapCard A (MapPut A m0 (ad_div_2 a) y)) (
+ refl_equal _) (refl_equal _) (refl_equal _)).
+ intro H5. rewrite H1 in H3. simpl in H3. rewrite H5 in H3. rewrite <- H2 in H3.
+ left. assumption.
+ intro H5. rewrite H1 in H3. simpl in H3. rewrite H5 in H3. simpl in H3. rewrite <- H2 in H3.
+ right. assumption.
+ Qed.
+
+ Lemma MapCard_Put_lb :
+ forall (m:Map A) (a:ad) (y:A), MapCard A (MapPut A m a y) >= MapCard A m.
+ Proof.
+ unfold ge in |- *. intros.
+ elim
+ (MapCard_Put_sum m (MapPut A m a y) a y (MapCard A m)
+ (MapCard A (MapPut A m a y)) (refl_equal _) (
+ refl_equal _) (refl_equal _)).
+ intro H. rewrite H. apply le_n.
+ intro H. rewrite H. apply le_n_Sn.
+ Qed.
+
+ Lemma MapCard_Put_ub :
+ forall (m:Map A) (a:ad) (y:A),
+ MapCard A (MapPut A m a y) <= S (MapCard A m).
+ Proof.
+ intros.
+ elim
+ (MapCard_Put_sum m (MapPut A m a y) a y (MapCard A m)
+ (MapCard A (MapPut A m a y)) (refl_equal _) (
+ refl_equal _) (refl_equal _)).
+ intro H. rewrite H. apply le_n_Sn.
+ intro H. rewrite H. apply le_n.
+ Qed.
+
+ Lemma MapCard_Put_1 :
+ forall (m:Map A) (a:ad) (y:A),
+ MapCard A (MapPut A m a y) = MapCard A m ->
+ {y : A | MapGet A m a = SOME A y}.
+ Proof.
+ simple induction m. intros. discriminate H.
+ intros a y a0 y0 H. simpl in H. elim (ad_sum (ad_xor a a0)). intro H0. elim H0.
+ intros p H1. rewrite H1 in H. rewrite (MapCard_Put1_equals_2 p a a0 y y0) in H.
+ discriminate H.
+ intro H0. rewrite H0 in H. rewrite (ad_xor_eq _ _ H0). split with y. apply M1_semantics_1.
+ intros. rewrite (MapPut_semantics_3_1 A m0 m1 a y) in H1. elim (sumbool_of_bool (ad_bit_0 a)).
+ intro H2. rewrite H2 in H1. simpl in H1. elim (H0 (ad_div_2 a) y ((fun n m p:nat => plus_reg_l m p n) _ _ _ H1)).
+ intros y0 H3. split with y0. rewrite <- H3. exact (MapGet_M2_bit_0_1 A a H2 m0 m1).
+ intro H2. rewrite H2 in H1. simpl in H1.
+ rewrite
+ (plus_comm (MapCard A (MapPut A m0 (ad_div_2 a) y)) (MapCard A m1))
+ in H1.
+ rewrite (plus_comm (MapCard A m0) (MapCard A m1)) in H1.
+ elim (H (ad_div_2 a) y ((fun n m p:nat => plus_reg_l m p n) _ _ _ H1)). intros y0 H3. split with y0.
+ rewrite <- H3. exact (MapGet_M2_bit_0_0 A a H2 m0 m1).
+ Qed.
+
+ Lemma MapCard_Put_2 :
+ forall (m:Map A) (a:ad) (y:A),
+ MapCard A (MapPut A m a y) = S (MapCard A m) -> MapGet A m a = NONE A.
+ Proof.
+ simple induction m. trivial.
+ intros. simpl in H. elim (sumbool_of_bool (ad_eq a a1)). intro H0.
+ rewrite (ad_eq_complete _ _ H0) in H. rewrite (ad_xor_nilpotent a1) in H. discriminate H.
+ intro H0. exact (M1_semantics_2 A a a1 a0 H0).
+ intros. elim (sumbool_of_bool (ad_bit_0 a)). intro H2.
+ rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1). apply (H0 (ad_div_2 a) y).
+ apply (fun n m p:nat => plus_reg_l m p n) with (n := MapCard A m0).
+ rewrite <- (plus_Snm_nSm (MapCard A m0) (MapCard A m1)). simpl in H1. simpl in |- *. rewrite <- H1.
+ clear H1.
+ induction a. discriminate H2.
+ induction p. reflexivity.
+ discriminate H2.
+ reflexivity.
+ intro H2. rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1). apply (H (ad_div_2 a) y).
+ cut
+ (MapCard A (MapPut A m0 (ad_div_2 a) y) + MapCard A m1 =
+ S (MapCard A m0) + MapCard A m1).
+ intro. rewrite (plus_comm (MapCard A (MapPut A m0 (ad_div_2 a) y)) (MapCard A m1))
+ in H3.
+ rewrite (plus_comm (S (MapCard A m0)) (MapCard A m1)) in H3. exact ((fun n m p:nat => plus_reg_l m p n) _ _ _ H3).
+ simpl in |- *. simpl in H1. rewrite <- H1. induction a. trivial.
+ induction p. discriminate H2.
+ reflexivity.
+ discriminate H2.
+ Qed.
+
+ Lemma MapCard_Put_1_conv :
+ forall (m:Map A) (a:ad) (y y':A),
+ MapGet A m a = SOME A y -> MapCard A (MapPut A m a y') = MapCard A m.
+ Proof.
+ intros.
+ elim
+ (MapCard_Put_sum m (MapPut A m a y') a y' (MapCard A m)
+ (MapCard A (MapPut A m a y')) (refl_equal _) (
+ refl_equal _) (refl_equal _)).
+ trivial.
+ intro H0. rewrite (MapCard_Put_2 m a y' H0) in H. discriminate H.
+ Qed.
+
+ Lemma MapCard_Put_2_conv :
+ forall (m:Map A) (a:ad) (y:A),
+ MapGet A m a = NONE A -> MapCard A (MapPut A m a y) = S (MapCard A m).
+ Proof.
+ intros.
+ elim
+ (MapCard_Put_sum m (MapPut A m a y) a y (MapCard A m)
+ (MapCard A (MapPut A m a y)) (refl_equal _) (
+ refl_equal _) (refl_equal _)).
+ intro H0. elim (MapCard_Put_1 m a y H0). intros y' H1. rewrite H1 in H. discriminate H.
+ trivial.
+ Qed.
+
+ Lemma MapCard_ext :
+ forall m m':Map A,
+ eqm A (MapGet A m) (MapGet A m') -> MapCard A m = MapCard A m'.
+ Proof.
+ unfold eqm in |- *. intros. rewrite (MapCard_as_length m). rewrite (MapCard_as_length m').
+ rewrite (alist_canonical A (alist_of_Map A m) (alist_of_Map A m')). reflexivity.
+ unfold eqm in |- *. intro. rewrite (Map_of_alist_semantics A (alist_of_Map A m) a).
+ rewrite (Map_of_alist_semantics A (alist_of_Map A m') a). rewrite (Map_of_alist_of_Map A m' a).
+ rewrite (Map_of_alist_of_Map A m a). exact (H a).
+ apply alist_of_Map_sorts2.
+ apply alist_of_Map_sorts2.
+ Qed.
+
+ Lemma MapCard_Dom : forall m:Map A, MapCard A m = MapCard unit (MapDom A m).
+ Proof.
+ simple induction m; trivial. intros. simpl in |- *. rewrite H. rewrite H0. reflexivity.
+ Qed.
+
+ Lemma MapCard_Dom_Put_behind :
+ forall (m:Map A) (a:ad) (y:A),
+ MapDom A (MapPut_behind A m a y) = MapDom A (MapPut A m a y).
+ Proof.
+ simple induction m. trivial.
+ intros a y a0 y0. simpl in |- *. elim (ad_sum (ad_xor a a0)). intro H. elim H.
+ intros p H0. rewrite H0. reflexivity.
+ intro H. rewrite H. rewrite (ad_xor_eq _ _ H). reflexivity.
+ intros. simpl in |- *. elim (ad_sum a). intro H1. elim H1. intros p H2. rewrite H2. case p.
+ intro p0. simpl in |- *. rewrite H0. reflexivity.
+ intro p0. simpl in |- *. rewrite H. reflexivity.
+ simpl in |- *. rewrite H0. reflexivity.
+ intro H1. rewrite H1. simpl in |- *. rewrite H. reflexivity.
+ Qed.
+
+ Lemma MapCard_Put_behind_Put :
+ forall (m:Map A) (a:ad) (y:A),
+ MapCard A (MapPut_behind A m a y) = MapCard A (MapPut A m a y).
+ Proof.
+ intros. rewrite MapCard_Dom. rewrite MapCard_Dom. rewrite MapCard_Dom_Put_behind.
+ reflexivity.
+ Qed.
- Lemma MapCard_makeM2 : (m,m':(Map A))
- (MapCard A (makeM2 A m m'))=(plus (MapCard A m) (MapCard A m')).
+ Lemma MapCard_Put_behind_sum :
+ forall (m m':Map A) (a:ad) (y:A) (n n':nat),
+ m' = MapPut_behind A m a y ->
+ n = MapCard A m -> n' = MapCard A m' -> {n' = n} + {n' = S n}.
+ Proof.
+ intros. apply (MapCard_Put_sum m (MapPut A m a y) a y n n'); trivial.
+ rewrite <- MapCard_Put_behind_Put. rewrite <- H. assumption.
+ Qed.
+
+ Lemma MapCard_makeM2 :
+ forall m m':Map A, MapCard A (makeM2 A m m') = MapCard A m + MapCard A m'.
Proof.
- Intros. Rewrite (MapCard_ext ? ? (makeM2_M2 A m m')). Reflexivity.
+ intros. rewrite (MapCard_ext _ _ (makeM2_M2 A m m')). reflexivity.
Qed.
- Lemma MapCard_Remove_sum : (m,m':(Map A)) (a:ad) (n,n':nat)
- m'=(MapRemove A m a) -> n=(MapCard A m) -> n'=(MapCard A m') ->
- {n=n'}+{n=(S n')}.
- Proof.
- Induction m. Simpl. Intros. Rewrite H in H1. Simpl in H1. Left . Rewrite H1. Assumption.
- Simpl. Intros. Elim (sumbool_of_bool (ad_eq a a1)). Intro H2. Rewrite H2 in H.
- Rewrite H in H1. Simpl in H1. Right . Rewrite H1. Assumption.
- Intro H2. Rewrite H2 in H. Rewrite H in H1. Simpl in H1. Left . Rewrite H1. Assumption.
- Intros. Simpl in H1. Simpl in H2. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H4.
- Rewrite H4 in H1. Rewrite H1 in H3.
- Rewrite (MapCard_makeM2 m0 (MapRemove A m1 (ad_div_2 a))) in H3.
- Elim (H0 (MapRemove A m1 (ad_div_2 a)) (ad_div_2 a) (MapCard A m1)
- (MapCard A (MapRemove A m1 (ad_div_2 a))) (refl_equal ? ?)
- (refl_equal ? ?) (refl_equal ? ?)).
- Intro H5. Rewrite H5 in H2. Left . Rewrite H3. Exact H2.
- Intro H5. Rewrite H5 in H2.
- Rewrite <- (plus_Snm_nSm (MapCard A m0) (MapCard A (MapRemove A m1 (ad_div_2 a)))) in H2.
- Right . Rewrite H3. Exact H2.
- Intro H4. Rewrite H4 in H1. Rewrite H1 in H3.
- Rewrite (MapCard_makeM2 (MapRemove A m0 (ad_div_2 a)) m1) in H3.
- Elim (H (MapRemove A m0 (ad_div_2 a)) (ad_div_2 a) (MapCard A m0)
- (MapCard A (MapRemove A m0 (ad_div_2 a))) (refl_equal ? ?)
- (refl_equal ? ?) (refl_equal ? ?)).
- Intro H5. Rewrite H5 in H2. Left . Rewrite H3. Exact H2.
- Intro H5. Rewrite H5 in H2. Right . Rewrite H3. Exact H2.
- Qed.
-
- Lemma MapCard_Remove_ub : (m:(Map A)) (a:ad)
- (le (MapCard A (MapRemove A m a)) (MapCard A m)).
- Proof.
- Intros.
- Elim (MapCard_Remove_sum m (MapRemove A m a) a (MapCard A m)
- (MapCard A (MapRemove A m a)) (refl_equal ? ?) (refl_equal ? ?)
- (refl_equal ? ?)).
- Intro H. Rewrite H. Apply le_n.
- Intro H. Rewrite H. Apply le_n_Sn.
- Qed.
-
- Lemma MapCard_Remove_lb : (m:(Map A)) (a:ad)
- (ge (S (MapCard A (MapRemove A m a))) (MapCard A m)).
- Proof.
- Unfold ge. Intros.
- Elim (MapCard_Remove_sum m (MapRemove A m a) a (MapCard A m)
- (MapCard A (MapRemove A m a)) (refl_equal ? ?) (refl_equal ? ?)
- (refl_equal ? ?)).
- Intro H. Rewrite H. Apply le_n_Sn.
- Intro H. Rewrite H. Apply le_n.
- Qed.
-
- Lemma MapCard_Remove_1 : (m:(Map A)) (a:ad)
- (MapCard A (MapRemove A m a))=(MapCard A m) -> (MapGet A m a)=(NONE A).
- Proof.
- Induction m. Trivial.
- Simpl. Intros a y a0 H. Elim (sumbool_of_bool (ad_eq a a0)). Intro H0.
- Rewrite H0 in H. Discriminate H.
- Intro H0. Rewrite H0. Reflexivity.
- Intros. Simpl in H1. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H2. Rewrite H2 in H1.
- Rewrite (MapCard_makeM2 m0 (MapRemove A m1 (ad_div_2 a))) in H1.
- Rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1). Apply H0. Exact (simpl_plus_l ? ? ? H1).
- Intro H2. Rewrite H2 in H1.
- Rewrite (MapCard_makeM2 (MapRemove A m0 (ad_div_2 a)) m1) in H1.
- Rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1). Apply H.
- Rewrite (plus_sym (MapCard A (MapRemove A m0 (ad_div_2 a))) (MapCard A m1)) in H1.
- Rewrite (plus_sym (MapCard A m0) (MapCard A m1)) in H1. Exact (simpl_plus_l ? ? ? H1).
- Qed.
-
- Lemma MapCard_Remove_2 : (m:(Map A)) (a:ad)
- (S (MapCard A (MapRemove A m a)))=(MapCard A m) ->
- {y:A | (MapGet A m a)=(SOME A y)}.
- Proof.
- Induction m. Intros. Discriminate H.
- Intros a y a0 H. Simpl in H. Elim (sumbool_of_bool (ad_eq a a0)). Intro H0.
- Rewrite (ad_eq_complete ? ? H0). Split with y. Exact (M1_semantics_1 A a0 y).
- Intro H0. Rewrite H0 in H. Discriminate H.
- Intros. Simpl in H1. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H2. Rewrite H2 in H1.
- Rewrite (MapCard_makeM2 m0 (MapRemove A m1 (ad_div_2 a))) in H1.
- Rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1). Apply H0.
- Change (plus (S (MapCard A m0)) (MapCard A (MapRemove A m1 (ad_div_2 a))))
- =(plus (MapCard A m0) (MapCard A m1)) in H1.
- Rewrite (plus_Snm_nSm (MapCard A m0) (MapCard A (MapRemove A m1 (ad_div_2 a)))) in H1.
- Exact (simpl_plus_l ? ? ? H1).
- Intro H2. Rewrite H2 in H1. Rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1). Apply H.
- Rewrite (MapCard_makeM2 (MapRemove A m0 (ad_div_2 a)) m1) in H1.
- Change (plus (S (MapCard A (MapRemove A m0 (ad_div_2 a)))) (MapCard A m1))
- =(plus (MapCard A m0) (MapCard A m1)) in H1.
- Rewrite (plus_sym (S (MapCard A (MapRemove A m0 (ad_div_2 a)))) (MapCard A m1)) in H1.
- Rewrite (plus_sym (MapCard A m0) (MapCard A m1)) in H1. Exact (simpl_plus_l ? ? ? H1).
- Qed.
-
- Lemma MapCard_Remove_1_conv : (m:(Map A)) (a:ad)
- (MapGet A m a)=(NONE A) -> (MapCard A (MapRemove A m a))=(MapCard A m).
- Proof.
- Intros.
- Elim (MapCard_Remove_sum m (MapRemove A m a) a (MapCard A m)
- (MapCard A (MapRemove A m a)) (refl_equal ? ?) (refl_equal ? ?)
- (refl_equal ? ?)).
- Intro H0. Rewrite H0. Reflexivity.
- Intro H0. Elim (MapCard_Remove_2 m a (sym_eq ? ? ? H0)). Intros y H1. Rewrite H1 in H.
- Discriminate H.
- Qed.
-
- Lemma MapCard_Remove_2_conv : (m:(Map A)) (a:ad) (y:A)
- (MapGet A m a)=(SOME A y) ->
- (S (MapCard A (MapRemove A m a)))=(MapCard A m).
- Proof.
- Intros.
- Elim (MapCard_Remove_sum m (MapRemove A m a) a (MapCard A m)
- (MapCard A (MapRemove A m a)) (refl_equal ? ?) (refl_equal ? ?)
- (refl_equal ? ?)).
- Intro H0. Rewrite (MapCard_Remove_1 m a (sym_eq ? ? ? H0)) in H. Discriminate H.
- Intro H0. Rewrite H0. Reflexivity.
- Qed.
-
- Lemma MapMerge_Restr_Card : (m,m':(Map A))
- (plus (MapCard A m) (MapCard A m'))=
- (plus (MapCard A (MapMerge A m m')) (MapCard A (MapDomRestrTo A A m m'))).
- Proof.
- Induction m. Simpl. Intro. Apply plus_n_O.
- Simpl. Intros a y m'. Elim (option_sum A (MapGet A m' a)). Intro H. Elim H. Intros y0 H0.
- Rewrite H0. Rewrite MapCard_Put_behind_Put. Rewrite (MapCard_Put_1_conv m' a y0 y H0).
- Simpl. Rewrite <- plus_Snm_nSm. Apply plus_n_O.
- Intro H. Rewrite H. Rewrite MapCard_Put_behind_Put. Rewrite (MapCard_Put_2_conv m' a y H).
- Apply plus_n_O.
- Intros.
- Change (plus (plus (MapCard A m0) (MapCard A m1)) (MapCard A m'))
- =(plus (MapCard A (MapMerge A (M2 A m0 m1) m'))
- (MapCard A (MapDomRestrTo A A (M2 A m0 m1) m'))).
- Elim m'. Reflexivity.
- Intros a y. Unfold MapMerge. Unfold MapDomRestrTo.
- Elim (option_sum A (MapGet A (M2 A m0 m1) a)). Intro H1. Elim H1. Intros y0 H2. Rewrite H2.
- Rewrite (MapCard_Put_1_conv (M2 A m0 m1) a y0 y H2). Reflexivity.
- Intro H1. Rewrite H1. Rewrite (MapCard_Put_2_conv (M2 A m0 m1) a y H1). Simpl.
- Rewrite <- (plus_Snm_nSm (plus (MapCard A m0) (MapCard A m1)) O). Reflexivity.
- Intros. Simpl.
- Rewrite (plus_permute_2_in_4 (MapCard A m0) (MapCard A m1) (MapCard A m2) (MapCard A m3)).
- Rewrite (H m2). Rewrite (H0 m3).
- Rewrite (MapCard_makeM2 (MapDomRestrTo A A m0 m2) (MapDomRestrTo A A m1 m3)).
- Apply plus_permute_2_in_4.
- Qed.
-
- Lemma MapMerge_disjoint_Card : (m,m':(Map A)) (MapDisjoint A A m m') ->
- (MapCard A (MapMerge A m m'))=(plus (MapCard A m) (MapCard A m')).
- Proof.
- Intros. Rewrite (MapMerge_Restr_Card m m').
- Rewrite (MapCard_ext ? ? (MapDisjoint_imp_2 ? ? ? ? H)). Apply plus_n_O.
- Qed.
-
- Lemma MapSplit_Card : (m:(Map A)) (m':(Map B))
- (MapCard A m)=(plus (MapCard A (MapDomRestrTo A B m m'))
- (MapCard A (MapDomRestrBy A B m m'))).
- Proof.
- Intros. Rewrite (MapCard_ext ? ? (MapDom_Split_1 A B m m')). Apply MapMerge_disjoint_Card.
- Apply MapDisjoint_2_imp. Unfold MapDisjoint_2. Apply MapDom_Split_3.
- Qed.
-
- Lemma MapMerge_Card_ub : (m,m':(Map A))
- (le (MapCard A (MapMerge A m m')) (plus (MapCard A m) (MapCard A m'))).
- Proof.
- Intros. Rewrite MapMerge_Restr_Card. Apply le_plus_l.
- Qed.
-
- Lemma MapDomRestrTo_Card_ub_l : (m:(Map A)) (m':(Map B))
- (le (MapCard A (MapDomRestrTo A B m m')) (MapCard A m)).
- Proof.
- Intros. Rewrite (MapSplit_Card m m'). Apply le_plus_l.
- Qed.
-
- Lemma MapDomRestrBy_Card_ub_l : (m:(Map A)) (m':(Map B))
- (le (MapCard A (MapDomRestrBy A B m m')) (MapCard A m)).
- Proof.
- Intros. Rewrite (MapSplit_Card m m'). Apply le_plus_r.
- Qed.
-
- Lemma MapMerge_Card_disjoint : (m,m':(Map A))
- (MapCard A (MapMerge A m m'))=(plus (MapCard A m) (MapCard A m')) ->
- (MapDisjoint A A m m').
- Proof.
- Induction m. Intros. Apply Map_M0_disjoint.
- Simpl. Intros. Rewrite (MapCard_Put_behind_Put m' a a0) in H. Unfold MapDisjoint in_dom.
- Simpl. Intros. Elim (sumbool_of_bool (ad_eq a a1)). Intro H2.
- Rewrite (ad_eq_complete ? ? H2) in H. Rewrite (MapCard_Put_2 m' a1 a0 H) in H1.
- Discriminate H1.
- Intro H2. Rewrite H2 in H0. Discriminate H0.
- Induction m'. Intros. Apply Map_disjoint_M0.
- Intros a y H1. Rewrite <- (MapCard_ext ? ? (MapPut_as_Merge A (M2 A m0 m1) a y)) in H1.
- Unfold 3 MapCard in H1. Rewrite <- (plus_Snm_nSm (MapCard A (M2 A m0 m1)) O) in H1.
- Rewrite <- (plus_n_O (S (MapCard A (M2 A m0 m1)))) in H1. Unfold MapDisjoint in_dom.
- Unfold 2 MapGet. Intros. Elim (sumbool_of_bool (ad_eq a a0)). Intro H4.
- Rewrite <- (ad_eq_complete ? ? H4) in H2. Rewrite (MapCard_Put_2 ? ? ? H1) in H2.
- Discriminate H2.
- Intro H4. Rewrite H4 in H3. Discriminate H3.
- Intros. Unfold MapDisjoint. Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H6.
- Unfold MapDisjoint in H0. Apply H0 with m':=m3 a:=(ad_div_2 a). Apply le_antisym.
- Apply MapMerge_Card_ub.
- Apply simpl_le_plus_l with p:=(plus (MapCard A m0) (MapCard A m2)).
- Rewrite (plus_permute_2_in_4 (MapCard A m0) (MapCard A m2) (MapCard A m1) (MapCard A m3)).
- Change (MapCard A (M2 A (MapMerge A m0 m2) (MapMerge A m1 m3)))
- =(plus (plus (MapCard A m0) (MapCard A m1)) (plus (MapCard A m2) (MapCard A m3))) in H3.
- Rewrite <- H3. Simpl. Apply le_reg_r. Apply MapMerge_Card_ub.
- Elim (in_dom_some ? ? ? H4). Intros y H7. Rewrite (MapGet_M2_bit_0_1 ? a H6 m0 m1) in H7.
- Unfold in_dom. Rewrite H7. Reflexivity.
- Elim (in_dom_some ? ? ? H5). Intros y H7. Rewrite (MapGet_M2_bit_0_1 ? a H6 m2 m3) in H7.
- Unfold in_dom. Rewrite H7. Reflexivity.
- Intro H6. Unfold MapDisjoint in H. Apply H with m':=m2 a:=(ad_div_2 a). Apply le_antisym.
- Apply MapMerge_Card_ub.
- Apply simpl_le_plus_l with p:=(plus (MapCard A m1) (MapCard A m3)).
- Rewrite (plus_sym (plus (MapCard A m1) (MapCard A m3)) (plus (MapCard A m0) (MapCard A m2))).
- Rewrite (plus_permute_2_in_4 (MapCard A m0) (MapCard A m2) (MapCard A m1) (MapCard A m3)).
- Rewrite (plus_sym (plus (MapCard A m1) (MapCard A m3)) (MapCard A (MapMerge A m0 m2))).
- Change (plus (MapCard A (MapMerge A m0 m2)) (MapCard A (MapMerge A m1 m3)))
- =(plus (plus (MapCard A m0) (MapCard A m1)) (plus (MapCard A m2) (MapCard A m3))) in H3.
- Rewrite <- H3. Apply le_reg_l. Apply MapMerge_Card_ub.
- Elim (in_dom_some ? ? ? H4). Intros y H7. Rewrite (MapGet_M2_bit_0_0 ? a H6 m0 m1) in H7.
- Unfold in_dom. Rewrite H7. Reflexivity.
- Elim (in_dom_some ? ? ? H5). Intros y H7. Rewrite (MapGet_M2_bit_0_0 ? a H6 m2 m3) in H7.
- Unfold in_dom. Rewrite H7. Reflexivity.
- Qed.
-
- Lemma MapCard_is_Sn : (m:(Map A)) (n:nat) (MapCard ? m)=(S n) ->
- {a:ad | (in_dom ? a m)=true}.
- Proof.
- Induction m. Intros. Discriminate H.
- Intros a y n H. Split with a. Unfold in_dom. Rewrite (M1_semantics_1 ? a y). Reflexivity.
- Intros. Simpl in H1. Elim (O_or_S (MapCard ? m0)). Intro H2. Elim H2. Intros m2 H3.
- Elim (H ? (sym_eq ? ? ? H3)). Intros a H4. Split with (ad_double a). Unfold in_dom.
- Rewrite (MapGet_M2_bit_0_0 A (ad_double a) (ad_double_bit_0 a) m0 m1).
- Rewrite (ad_double_div_2 a). Elim (in_dom_some ? ? ? H4). Intros y H5. Rewrite H5. Reflexivity.
- Intro H2. Rewrite <- H2 in H1. Simpl in H1. Elim (H0 ? H1). Intros a H3.
- Split with (ad_double_plus_un a). Unfold in_dom.
- Rewrite (MapGet_M2_bit_0_1 A (ad_double_plus_un a) (ad_double_plus_un_bit_0 a) m0 m1).
- Rewrite (ad_double_plus_un_div_2 a). Elim (in_dom_some ? ? ? H3). Intros y H4. Rewrite H4.
- Reflexivity.
+ Lemma MapCard_Remove_sum :
+ forall (m m':Map A) (a:ad) (n n':nat),
+ m' = MapRemove A m a ->
+ n = MapCard A m -> n' = MapCard A m' -> {n = n'} + {n = S n'}.
+ Proof.
+ simple induction m. simpl in |- *. intros. rewrite H in H1. simpl in H1. left. rewrite H1. assumption.
+ simpl in |- *. intros. elim (sumbool_of_bool (ad_eq a a1)). intro H2. rewrite H2 in H.
+ rewrite H in H1. simpl in H1. right. rewrite H1. assumption.
+ intro H2. rewrite H2 in H. rewrite H in H1. simpl in H1. left. rewrite H1. assumption.
+ intros. simpl in H1. simpl in H2. elim (sumbool_of_bool (ad_bit_0 a)). intro H4.
+ rewrite H4 in H1. rewrite H1 in H3.
+ rewrite (MapCard_makeM2 m0 (MapRemove A m1 (ad_div_2 a))) in H3.
+ elim
+ (H0 (MapRemove A m1 (ad_div_2 a)) (ad_div_2 a) (
+ MapCard A m1) (MapCard A (MapRemove A m1 (ad_div_2 a)))
+ (refl_equal _) (refl_equal _) (refl_equal _)).
+ intro H5. rewrite H5 in H2. left. rewrite H3. exact H2.
+ intro H5. rewrite H5 in H2.
+ rewrite <-
+ (plus_Snm_nSm (MapCard A m0) (MapCard A (MapRemove A m1 (ad_div_2 a))))
+ in H2.
+ right. rewrite H3. exact H2.
+ intro H4. rewrite H4 in H1. rewrite H1 in H3.
+ rewrite (MapCard_makeM2 (MapRemove A m0 (ad_div_2 a)) m1) in H3.
+ elim
+ (H (MapRemove A m0 (ad_div_2 a)) (ad_div_2 a) (
+ MapCard A m0) (MapCard A (MapRemove A m0 (ad_div_2 a)))
+ (refl_equal _) (refl_equal _) (refl_equal _)).
+ intro H5. rewrite H5 in H2. left. rewrite H3. exact H2.
+ intro H5. rewrite H5 in H2. right. rewrite H3. exact H2.
+ Qed.
+
+ Lemma MapCard_Remove_ub :
+ forall (m:Map A) (a:ad), MapCard A (MapRemove A m a) <= MapCard A m.
+ Proof.
+ intros.
+ elim
+ (MapCard_Remove_sum m (MapRemove A m a) a (MapCard A m)
+ (MapCard A (MapRemove A m a)) (refl_equal _) (
+ refl_equal _) (refl_equal _)).
+ intro H. rewrite H. apply le_n.
+ intro H. rewrite H. apply le_n_Sn.
+ Qed.
+
+ Lemma MapCard_Remove_lb :
+ forall (m:Map A) (a:ad), S (MapCard A (MapRemove A m a)) >= MapCard A m.
+ Proof.
+ unfold ge in |- *. intros.
+ elim
+ (MapCard_Remove_sum m (MapRemove A m a) a (MapCard A m)
+ (MapCard A (MapRemove A m a)) (refl_equal _) (
+ refl_equal _) (refl_equal _)).
+ intro H. rewrite H. apply le_n_Sn.
+ intro H. rewrite H. apply le_n.
+ Qed.
+
+ Lemma MapCard_Remove_1 :
+ forall (m:Map A) (a:ad),
+ MapCard A (MapRemove A m a) = MapCard A m -> MapGet A m a = NONE A.
+ Proof.
+ simple induction m. trivial.
+ simpl in |- *. intros a y a0 H. elim (sumbool_of_bool (ad_eq a a0)). intro H0.
+ rewrite H0 in H. discriminate H.
+ intro H0. rewrite H0. reflexivity.
+ intros. simpl in H1. elim (sumbool_of_bool (ad_bit_0 a)). intro H2. rewrite H2 in H1.
+ rewrite (MapCard_makeM2 m0 (MapRemove A m1 (ad_div_2 a))) in H1.
+ rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1). apply H0. exact ((fun n m p:nat => plus_reg_l m p n) _ _ _ H1).
+ intro H2. rewrite H2 in H1.
+ rewrite (MapCard_makeM2 (MapRemove A m0 (ad_div_2 a)) m1) in H1.
+ rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1). apply H.
+ rewrite
+ (plus_comm (MapCard A (MapRemove A m0 (ad_div_2 a))) (MapCard A m1))
+ in H1.
+ rewrite (plus_comm (MapCard A m0) (MapCard A m1)) in H1. exact ((fun n m p:nat => plus_reg_l m p n) _ _ _ H1).
+ Qed.
+
+ Lemma MapCard_Remove_2 :
+ forall (m:Map A) (a:ad),
+ S (MapCard A (MapRemove A m a)) = MapCard A m ->
+ {y : A | MapGet A m a = SOME A y}.
+ Proof.
+ simple induction m. intros. discriminate H.
+ intros a y a0 H. simpl in H. elim (sumbool_of_bool (ad_eq a a0)). intro H0.
+ rewrite (ad_eq_complete _ _ H0). split with y. exact (M1_semantics_1 A a0 y).
+ intro H0. rewrite H0 in H. discriminate H.
+ intros. simpl in H1. elim (sumbool_of_bool (ad_bit_0 a)). intro H2. rewrite H2 in H1.
+ rewrite (MapCard_makeM2 m0 (MapRemove A m1 (ad_div_2 a))) in H1.
+ rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1). apply H0.
+ change
+ (S (MapCard A m0) + MapCard A (MapRemove A m1 (ad_div_2 a)) =
+ MapCard A m0 + MapCard A m1) in H1.
+ rewrite
+ (plus_Snm_nSm (MapCard A m0) (MapCard A (MapRemove A m1 (ad_div_2 a))))
+ in H1.
+ exact ((fun n m p:nat => plus_reg_l m p n) _ _ _ H1).
+ intro H2. rewrite H2 in H1. rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1). apply H.
+ rewrite (MapCard_makeM2 (MapRemove A m0 (ad_div_2 a)) m1) in H1.
+ change
+ (S (MapCard A (MapRemove A m0 (ad_div_2 a))) + MapCard A m1 =
+ MapCard A m0 + MapCard A m1) in H1.
+ rewrite
+ (plus_comm (S (MapCard A (MapRemove A m0 (ad_div_2 a)))) (MapCard A m1))
+ in H1.
+ rewrite (plus_comm (MapCard A m0) (MapCard A m1)) in H1. exact ((fun n m p:nat => plus_reg_l m p n) _ _ _ H1).
+ Qed.
+
+ Lemma MapCard_Remove_1_conv :
+ forall (m:Map A) (a:ad),
+ MapGet A m a = NONE A -> MapCard A (MapRemove A m a) = MapCard A m.
+ Proof.
+ intros.
+ elim
+ (MapCard_Remove_sum m (MapRemove A m a) a (MapCard A m)
+ (MapCard A (MapRemove A m a)) (refl_equal _) (
+ refl_equal _) (refl_equal _)).
+ intro H0. rewrite H0. reflexivity.
+ intro H0. elim (MapCard_Remove_2 m a (sym_eq H0)). intros y H1. rewrite H1 in H.
+ discriminate H.
+ Qed.
+
+ Lemma MapCard_Remove_2_conv :
+ forall (m:Map A) (a:ad) (y:A),
+ MapGet A m a = SOME A y -> S (MapCard A (MapRemove A m a)) = MapCard A m.
+ Proof.
+ intros.
+ elim
+ (MapCard_Remove_sum m (MapRemove A m a) a (MapCard A m)
+ (MapCard A (MapRemove A m a)) (refl_equal _) (
+ refl_equal _) (refl_equal _)).
+ intro H0. rewrite (MapCard_Remove_1 m a (sym_eq H0)) in H. discriminate H.
+ intro H0. rewrite H0. reflexivity.
+ Qed.
+
+ Lemma MapMerge_Restr_Card :
+ forall m m':Map A,
+ MapCard A m + MapCard A m' =
+ MapCard A (MapMerge A m m') + MapCard A (MapDomRestrTo A A m m').
+ Proof.
+ simple induction m. simpl in |- *. intro. apply plus_n_O.
+ simpl in |- *. intros a y m'. elim (option_sum A (MapGet A m' a)). intro H. elim H. intros y0 H0.
+ rewrite H0. rewrite MapCard_Put_behind_Put. rewrite (MapCard_Put_1_conv m' a y0 y H0).
+ simpl in |- *. rewrite <- plus_Snm_nSm. apply plus_n_O.
+ intro H. rewrite H. rewrite MapCard_Put_behind_Put. rewrite (MapCard_Put_2_conv m' a y H).
+ apply plus_n_O.
+ intros.
+ change
+ (MapCard A m0 + MapCard A m1 + MapCard A m' =
+ MapCard A (MapMerge A (M2 A m0 m1) m') +
+ MapCard A (MapDomRestrTo A A (M2 A m0 m1) m'))
+ in |- *.
+ elim m'. reflexivity.
+ intros a y. unfold MapMerge in |- *. unfold MapDomRestrTo in |- *.
+ elim (option_sum A (MapGet A (M2 A m0 m1) a)). intro H1. elim H1. intros y0 H2. rewrite H2.
+ rewrite (MapCard_Put_1_conv (M2 A m0 m1) a y0 y H2). reflexivity.
+ intro H1. rewrite H1. rewrite (MapCard_Put_2_conv (M2 A m0 m1) a y H1). simpl in |- *.
+ rewrite <- (plus_Snm_nSm (MapCard A m0 + MapCard A m1) 0). reflexivity.
+ intros. simpl in |- *.
+ rewrite
+ (plus_permute_2_in_4 (MapCard A m0) (MapCard A m1) (
+ MapCard A m2) (MapCard A m3)).
+ rewrite (H m2). rewrite (H0 m3).
+ rewrite
+ (MapCard_makeM2 (MapDomRestrTo A A m0 m2) (MapDomRestrTo A A m1 m3))
+ .
+ apply plus_permute_2_in_4.
+ Qed.
+
+ Lemma MapMerge_disjoint_Card :
+ forall m m':Map A,
+ MapDisjoint A A m m' ->
+ MapCard A (MapMerge A m m') = MapCard A m + MapCard A m'.
+ Proof.
+ intros. rewrite (MapMerge_Restr_Card m m').
+ rewrite (MapCard_ext _ _ (MapDisjoint_imp_2 _ _ _ _ H)). apply plus_n_O.
+ Qed.
+
+ Lemma MapSplit_Card :
+ forall (m:Map A) (m':Map B),
+ MapCard A m =
+ MapCard A (MapDomRestrTo A B m m') + MapCard A (MapDomRestrBy A B m m').
+ Proof.
+ intros. rewrite (MapCard_ext _ _ (MapDom_Split_1 A B m m')). apply MapMerge_disjoint_Card.
+ apply MapDisjoint_2_imp. unfold MapDisjoint_2 in |- *. apply MapDom_Split_3.
+ Qed.
+
+ Lemma MapMerge_Card_ub :
+ forall m m':Map A,
+ MapCard A (MapMerge A m m') <= MapCard A m + MapCard A m'.
+ Proof.
+ intros. rewrite MapMerge_Restr_Card. apply le_plus_l.
+ Qed.
+
+ Lemma MapDomRestrTo_Card_ub_l :
+ forall (m:Map A) (m':Map B),
+ MapCard A (MapDomRestrTo A B m m') <= MapCard A m.
+ Proof.
+ intros. rewrite (MapSplit_Card m m'). apply le_plus_l.
+ Qed.
+
+ Lemma MapDomRestrBy_Card_ub_l :
+ forall (m:Map A) (m':Map B),
+ MapCard A (MapDomRestrBy A B m m') <= MapCard A m.
+ Proof.
+ intros. rewrite (MapSplit_Card m m'). apply le_plus_r.
+ Qed.
+
+ Lemma MapMerge_Card_disjoint :
+ forall m m':Map A,
+ MapCard A (MapMerge A m m') = MapCard A m + MapCard A m' ->
+ MapDisjoint A A m m'.
+ Proof.
+ simple induction m. intros. apply Map_M0_disjoint.
+ simpl in |- *. intros. rewrite (MapCard_Put_behind_Put m' a a0) in H. unfold MapDisjoint, in_dom in |- *.
+ simpl in |- *. intros. elim (sumbool_of_bool (ad_eq a a1)). intro H2.
+ rewrite (ad_eq_complete _ _ H2) in H. rewrite (MapCard_Put_2 m' a1 a0 H) in H1.
+ discriminate H1.
+ intro H2. rewrite H2 in H0. discriminate H0.
+ simple induction m'. intros. apply Map_disjoint_M0.
+ intros a y H1. rewrite <- (MapCard_ext _ _ (MapPut_as_Merge A (M2 A m0 m1) a y)) in H1.
+ unfold MapCard at 3 in H1. rewrite <- (plus_Snm_nSm (MapCard A (M2 A m0 m1)) 0) in H1.
+ rewrite <- (plus_n_O (S (MapCard A (M2 A m0 m1)))) in H1. unfold MapDisjoint, in_dom in |- *.
+ unfold MapGet at 2 in |- *. intros. elim (sumbool_of_bool (ad_eq a a0)). intro H4.
+ rewrite <- (ad_eq_complete _ _ H4) in H2. rewrite (MapCard_Put_2 _ _ _ H1) in H2.
+ discriminate H2.
+ intro H4. rewrite H4 in H3. discriminate H3.
+ intros. unfold MapDisjoint in |- *. intros. elim (sumbool_of_bool (ad_bit_0 a)). intro H6.
+ unfold MapDisjoint in H0. apply H0 with (m' := m3) (a := ad_div_2 a). apply le_antisym.
+ apply MapMerge_Card_ub.
+ apply (fun p n m:nat => plus_le_reg_l n m p) with
+ (p := MapCard A m0 + MapCard A m2).
+ rewrite
+ (plus_permute_2_in_4 (MapCard A m0) (MapCard A m2) (
+ MapCard A m1) (MapCard A m3)).
+ change
+ (MapCard A (M2 A (MapMerge A m0 m2) (MapMerge A m1 m3)) =
+ MapCard A m0 + MapCard A m1 + (MapCard A m2 + MapCard A m3))
+ in H3.
+ rewrite <- H3. simpl in |- *. apply plus_le_compat_r. apply MapMerge_Card_ub.
+ elim (in_dom_some _ _ _ H4). intros y H7. rewrite (MapGet_M2_bit_0_1 _ a H6 m0 m1) in H7.
+ unfold in_dom in |- *. rewrite H7. reflexivity.
+ elim (in_dom_some _ _ _ H5). intros y H7. rewrite (MapGet_M2_bit_0_1 _ a H6 m2 m3) in H7.
+ unfold in_dom in |- *. rewrite H7. reflexivity.
+ intro H6. unfold MapDisjoint in H. apply H with (m' := m2) (a := ad_div_2 a). apply le_antisym.
+ apply MapMerge_Card_ub.
+ apply (fun p n m:nat => plus_le_reg_l n m p) with
+ (p := MapCard A m1 + MapCard A m3).
+ rewrite
+ (plus_comm (MapCard A m1 + MapCard A m3) (MapCard A m0 + MapCard A m2))
+ .
+ rewrite
+ (plus_permute_2_in_4 (MapCard A m0) (MapCard A m2) (
+ MapCard A m1) (MapCard A m3)).
+ rewrite
+ (plus_comm (MapCard A m1 + MapCard A m3) (MapCard A (MapMerge A m0 m2)))
+ .
+ change
+ (MapCard A (MapMerge A m0 m2) + MapCard A (MapMerge A m1 m3) =
+ MapCard A m0 + MapCard A m1 + (MapCard A m2 + MapCard A m3))
+ in H3.
+ rewrite <- H3. apply plus_le_compat_l. apply MapMerge_Card_ub.
+ elim (in_dom_some _ _ _ H4). intros y H7. rewrite (MapGet_M2_bit_0_0 _ a H6 m0 m1) in H7.
+ unfold in_dom in |- *. rewrite H7. reflexivity.
+ elim (in_dom_some _ _ _ H5). intros y H7. rewrite (MapGet_M2_bit_0_0 _ a H6 m2 m3) in H7.
+ unfold in_dom in |- *. rewrite H7. reflexivity.
+ Qed.
+
+ Lemma MapCard_is_Sn :
+ forall (m:Map A) (n:nat),
+ MapCard _ m = S n -> {a : ad | in_dom _ a m = true}.
+ Proof.
+ simple induction m. intros. discriminate H.
+ intros a y n H. split with a. unfold in_dom in |- *. rewrite (M1_semantics_1 _ a y). reflexivity.
+ intros. simpl in H1. elim (O_or_S (MapCard _ m0)). intro H2. elim H2. intros m2 H3.
+ elim (H _ (sym_eq H3)). intros a H4. split with (ad_double a). unfold in_dom in |- *.
+ rewrite (MapGet_M2_bit_0_0 A (ad_double a) (ad_double_bit_0 a) m0 m1).
+ rewrite (ad_double_div_2 a). elim (in_dom_some _ _ _ H4). intros y H5. rewrite H5. reflexivity.
+ intro H2. rewrite <- H2 in H1. simpl in H1. elim (H0 _ H1). intros a H3.
+ split with (ad_double_plus_un a). unfold in_dom in |- *.
+ rewrite
+ (MapGet_M2_bit_0_1 A (ad_double_plus_un a) (ad_double_plus_un_bit_0 a)
+ m0 m1).
+ rewrite (ad_double_plus_un_div_2 a). elim (in_dom_some _ _ _ H3). intros y H4. rewrite H4.
+ reflexivity.
Qed.
End MapCard.
Section MapCard2.
- Variable A, B : Set.
-
- Lemma MapSubset_card_eq_1 : (n:nat) (m:(Map A)) (m':(Map B))
- (MapSubset ? ? m m') -> (MapCard ? m)=n -> (MapCard ? m')=n ->
- (MapSubset ? ? m' m).
- Proof.
- Induction n. Intros. Unfold MapSubset in_dom. Intro. Rewrite (MapCard_is_O ? m H0 a).
- Rewrite (MapCard_is_O ? m' H1 a). Intro H2. Discriminate H2.
- Intros. Elim (MapCard_is_Sn A m n0 H1). Intros a H3. Elim (in_dom_some ? ? ? H3).
- Intros y H4. Elim (in_dom_some ? ? ? (H0 ? H3)). Intros y' H6.
- Cut (eqmap ? (MapPut ? (MapRemove ? m a) a y) m). Intro.
- Cut (eqmap ? (MapPut ? (MapRemove ? m' a) a y') m'). Intro.
- Apply MapSubset_ext with m0:=(MapPut ? (MapRemove ? m' a) a y')
- m2:=(MapPut ? (MapRemove ? m a) a y).
- Assumption.
- Assumption.
- Apply MapSubset_Put_mono. Apply H. Apply MapSubset_Remove_mono. Assumption.
- Rewrite <- (MapCard_Remove_2_conv ? m a y H4) in H1. Inversion_clear H1. Reflexivity.
- Rewrite <- (MapCard_Remove_2_conv ? m' a y' H6) in H2. Inversion_clear H2. Reflexivity.
- Unfold eqmap eqm. Intro. Rewrite (MapPut_semantics ? (MapRemove B m' a) a y' a0).
- Elim (sumbool_of_bool (ad_eq a a0)). Intro H7. Rewrite H7. Rewrite <- (ad_eq_complete ? ? H7).
- Apply sym_eq. Assumption.
- Intro H7. Rewrite H7. Rewrite (MapRemove_semantics ? m' a a0). Rewrite H7. Reflexivity.
- Unfold eqmap eqm. Intro. Rewrite (MapPut_semantics ? (MapRemove A m a) a y a0).
- Elim (sumbool_of_bool (ad_eq a a0)). Intro H7. Rewrite H7. Rewrite <- (ad_eq_complete ? ? H7).
- Apply sym_eq. Assumption.
- Intro H7. Rewrite H7. Rewrite (MapRemove_semantics A m a a0). Rewrite H7. Reflexivity.
- Qed.
-
- Lemma MapDomRestrTo_Card_ub_r : (m:(Map A)) (m':(Map B))
- (le (MapCard A (MapDomRestrTo A B m m')) (MapCard B m')).
- Proof.
- Induction m. Intro. Simpl. Apply le_O_n.
- Intros a y m'. Simpl. Elim (option_sum B (MapGet B m' a)). Intro H. Elim H. Intros y0 H0.
- Rewrite H0. Elim (MapCard_is_not_O B m' a y0 H0). Intros n H1. Rewrite H1. Simpl.
- Apply le_n_S. Apply le_O_n.
- Intro H. Rewrite H. Simpl. Apply le_O_n.
- Induction m'. Simpl. Apply le_O_n.
-
- Intros a y. Unfold MapDomRestrTo. Case (MapGet A (M2 A m0 m1) a). Simpl. Apply le_O_n.
- Intro. Simpl. Apply le_n.
- Intros. Simpl. Rewrite (MapCard_makeM2 A (MapDomRestrTo A B m0 m2) (MapDomRestrTo A B m1 m3)).
- Apply le_plus_plus. Apply H.
- Apply H0.
+ Variables A B : Set.
+
+ Lemma MapSubset_card_eq_1 :
+ forall (n:nat) (m:Map A) (m':Map B),
+ MapSubset _ _ m m' ->
+ MapCard _ m = n -> MapCard _ m' = n -> MapSubset _ _ m' m.
+ Proof.
+ simple induction n. intros. unfold MapSubset, in_dom in |- *. intro. rewrite (MapCard_is_O _ m H0 a).
+ rewrite (MapCard_is_O _ m' H1 a). intro H2. discriminate H2.
+ intros. elim (MapCard_is_Sn A m n0 H1). intros a H3. elim (in_dom_some _ _ _ H3).
+ intros y H4. elim (in_dom_some _ _ _ (H0 _ H3)). intros y' H6.
+ cut (eqmap _ (MapPut _ (MapRemove _ m a) a y) m). intro.
+ cut (eqmap _ (MapPut _ (MapRemove _ m' a) a y') m'). intro.
+ apply MapSubset_ext with
+ (m0 := MapPut _ (MapRemove _ m' a) a y')
+ (m2 := MapPut _ (MapRemove _ m a) a y).
+ assumption.
+ assumption.
+ apply MapSubset_Put_mono. apply H. apply MapSubset_Remove_mono. assumption.
+ rewrite <- (MapCard_Remove_2_conv _ m a y H4) in H1. inversion_clear H1. reflexivity.
+ rewrite <- (MapCard_Remove_2_conv _ m' a y' H6) in H2. inversion_clear H2. reflexivity.
+ unfold eqmap, eqm in |- *. intro. rewrite (MapPut_semantics _ (MapRemove B m' a) a y' a0).
+ elim (sumbool_of_bool (ad_eq a a0)). intro H7. rewrite H7. rewrite <- (ad_eq_complete _ _ H7).
+ apply sym_eq. assumption.
+ intro H7. rewrite H7. rewrite (MapRemove_semantics _ m' a a0). rewrite H7. reflexivity.
+ unfold eqmap, eqm in |- *. intro. rewrite (MapPut_semantics _ (MapRemove A m a) a y a0).
+ elim (sumbool_of_bool (ad_eq a a0)). intro H7. rewrite H7. rewrite <- (ad_eq_complete _ _ H7).
+ apply sym_eq. assumption.
+ intro H7. rewrite H7. rewrite (MapRemove_semantics A m a a0). rewrite H7. reflexivity.
+ Qed.
+
+ Lemma MapDomRestrTo_Card_ub_r :
+ forall (m:Map A) (m':Map B),
+ MapCard A (MapDomRestrTo A B m m') <= MapCard B m'.
+ Proof.
+ simple induction m. intro. simpl in |- *. apply le_O_n.
+ intros a y m'. simpl in |- *. elim (option_sum B (MapGet B m' a)). intro H. elim H. intros y0 H0.
+ rewrite H0. elim (MapCard_is_not_O B m' a y0 H0). intros n H1. rewrite H1. simpl in |- *.
+ apply le_n_S. apply le_O_n.
+ intro H. rewrite H. simpl in |- *. apply le_O_n.
+ simple induction m'. simpl in |- *. apply le_O_n.
+
+ intros a y. unfold MapDomRestrTo in |- *. case (MapGet A (M2 A m0 m1) a). simpl in |- *. apply le_O_n.
+ intro. simpl in |- *. apply le_n.
+ intros. simpl in |- *. rewrite
+ (MapCard_makeM2 A (MapDomRestrTo A B m0 m2) (MapDomRestrTo A B m1 m3))
+ .
+ apply plus_le_compat. apply H.
+ apply H0.
Qed.
End MapCard2.
Section MapCard3.
- Variable A, B : Set.
+ Variables A B : Set.
- Lemma MapMerge_Card_lb_l : (m,m':(Map A))
- (ge (MapCard A (MapMerge A m m')) (MapCard A m)).
+ Lemma MapMerge_Card_lb_l :
+ forall m m':Map A, MapCard A (MapMerge A m m') >= MapCard A m.
Proof.
- Unfold ge. Intros. Apply (simpl_le_plus_l (MapCard A m')).
- Rewrite (plus_sym (MapCard A m') (MapCard A m)).
- Rewrite (plus_sym (MapCard A m') (MapCard A (MapMerge A m m'))).
- Rewrite (MapMerge_Restr_Card A m m'). Apply le_reg_l. Apply MapDomRestrTo_Card_ub_r.
+ unfold ge in |- *. intros. apply ((fun p n m:nat => plus_le_reg_l n m p) (MapCard A m')).
+ rewrite (plus_comm (MapCard A m') (MapCard A m)).
+ rewrite (plus_comm (MapCard A m') (MapCard A (MapMerge A m m'))).
+ rewrite (MapMerge_Restr_Card A m m'). apply plus_le_compat_l. apply MapDomRestrTo_Card_ub_r.
Qed.
- Lemma MapMerge_Card_lb_r : (m,m':(Map A))
- (ge (MapCard A (MapMerge A m m')) (MapCard A m')).
+ Lemma MapMerge_Card_lb_r :
+ forall m m':Map A, MapCard A (MapMerge A m m') >= MapCard A m'.
Proof.
- Unfold ge. Intros. Apply (simpl_le_plus_l (MapCard A m)). Rewrite (MapMerge_Restr_Card A m m').
- Rewrite (plus_sym (MapCard A (MapMerge A m m')) (MapCard A (MapDomRestrTo A A m m'))).
- Apply le_reg_r. Apply MapDomRestrTo_Card_ub_l.
+ unfold ge in |- *. intros. apply ((fun p n m:nat => plus_le_reg_l n m p) (MapCard A m)). rewrite (MapMerge_Restr_Card A m m').
+ rewrite
+ (plus_comm (MapCard A (MapMerge A m m'))
+ (MapCard A (MapDomRestrTo A A m m'))).
+ apply plus_le_compat_r. apply MapDomRestrTo_Card_ub_l.
Qed.
- Lemma MapDomRestrBy_Card_lb : (m:(Map A)) (m':(Map B))
- (ge (plus (MapCard B m') (MapCard A (MapDomRestrBy A B m m'))) (MapCard A m)).
+ Lemma MapDomRestrBy_Card_lb :
+ forall (m:Map A) (m':Map B),
+ MapCard B m' + MapCard A (MapDomRestrBy A B m m') >= MapCard A m.
Proof.
- Unfold ge. Intros. Rewrite (MapSplit_Card A B m m'). Apply le_reg_r.
- Apply MapDomRestrTo_Card_ub_r.
+ unfold ge in |- *. intros. rewrite (MapSplit_Card A B m m'). apply plus_le_compat_r.
+ apply MapDomRestrTo_Card_ub_r.
Qed.
- Lemma MapSubset_Card_le : (m:(Map A)) (m':(Map B))
- (MapSubset A B m m') -> (le (MapCard A m) (MapCard B m')).
+ Lemma MapSubset_Card_le :
+ forall (m:Map A) (m':Map B),
+ MapSubset A B m m' -> MapCard A m <= MapCard B m'.
Proof.
- Intros. Apply le_trans with m:=(plus (MapCard B m') (MapCard A (MapDomRestrBy A B m m'))).
- Exact (MapDomRestrBy_Card_lb m m').
- Rewrite (MapCard_ext ? ? ? (MapSubset_imp_2 ? ? ? ? H)). Simpl. Rewrite <- plus_n_O.
- Apply le_n.
+ intros. apply le_trans with (m := MapCard B m' + MapCard A (MapDomRestrBy A B m m')).
+ exact (MapDomRestrBy_Card_lb m m').
+ rewrite (MapCard_ext _ _ _ (MapSubset_imp_2 _ _ _ _ H)). simpl in |- *. rewrite <- plus_n_O.
+ apply le_n.
Qed.
- Lemma MapSubset_card_eq : (m:(Map A)) (m':(Map B))
- (MapSubset ? ? m m') -> (le (MapCard ? m') (MapCard ? m)) ->
- (eqmap ? (MapDom ? m) (MapDom ? m')).
+ Lemma MapSubset_card_eq :
+ forall (m:Map A) (m':Map B),
+ MapSubset _ _ m m' ->
+ MapCard _ m' <= MapCard _ m -> eqmap _ (MapDom _ m) (MapDom _ m').
Proof.
- Intros. Apply MapSubset_antisym. Assumption.
- Cut (MapCard B m')=(MapCard A m). Intro. Apply (MapSubset_card_eq_1 A B (MapCard A m)).
- Assumption.
- Reflexivity.
- Assumption.
- Apply le_antisym. Assumption.
- Apply MapSubset_Card_le. Assumption.
+ intros. apply MapSubset_antisym. assumption.
+ cut (MapCard B m' = MapCard A m). intro. apply (MapSubset_card_eq_1 A B (MapCard A m)).
+ assumption.
+ reflexivity.
+ assumption.
+ apply le_antisym. assumption.
+ apply MapSubset_Card_le. assumption.
Qed.
-End MapCard3.
+End MapCard3. \ No newline at end of file
diff --git a/theories/IntMap/Mapfold.v b/theories/IntMap/Mapfold.v
index 1e59e42b2..f14b07261 100644
--- a/theories/IntMap/Mapfold.v
+++ b/theories/IntMap/Mapfold.v
@@ -7,19 +7,19 @@
(***********************************************************************)
(*i $Id$ i*)
-Require Bool.
-Require Sumbool.
-Require ZArith.
-Require Addr.
-Require Adist.
-Require Addec.
-Require Map.
-Require Fset.
-Require Mapaxioms.
-Require Mapiter.
-Require Lsort.
-Require Mapsubset.
-Require PolyList.
+Require Import Bool.
+Require Import Sumbool.
+Require Import ZArith.
+Require Import Addr.
+Require Import Adist.
+Require Import Addec.
+Require Import Map.
+Require Import Fset.
+Require Import Mapaxioms.
+Require Import Mapiter.
+Require Import Lsort.
+Require Import Mapsubset.
+Require Import List.
Section MapFoldResults.
@@ -29,218 +29,238 @@ Section MapFoldResults.
Variable neutral : M.
Variable op : M -> M -> M.
- Variable nleft : (a:M) (op neutral a)=a.
- Variable nright : (a:M) (op a neutral)=a.
- Variable assoc : (a,b,c:M) (op (op a b) c)=(op a (op b c)).
+ Variable nleft : forall a:M, op neutral a = a.
+ Variable nright : forall a:M, op a neutral = a.
+ Variable assoc : forall a b c:M, op (op a b) c = op a (op b c).
- Lemma MapFold_ext : (f:ad->A->M) (m,m':(Map A)) (eqmap A m m') ->
- (MapFold ? ? neutral op f m)=(MapFold ? ? neutral op f m').
+ Lemma MapFold_ext :
+ forall (f:ad -> A -> M) (m m':Map A),
+ eqmap A m m' -> MapFold _ _ neutral op f m = MapFold _ _ neutral op f m'.
Proof.
- Intros. Rewrite (MapFold_as_fold A M neutral op assoc nleft nright f m).
- Rewrite (MapFold_as_fold A M neutral op assoc nleft nright f m').
- Cut (alist_of_Map A m)=(alist_of_Map A m'). Intro. Rewrite H0. Reflexivity.
- Apply alist_canonical. Unfold eqmap in H. Apply eqm_trans with f':=(MapGet A m).
- Apply eqm_sym. Apply alist_of_Map_semantics.
- Apply eqm_trans with f':=(MapGet A m'). Assumption.
- Apply alist_of_Map_semantics.
- Apply alist_of_Map_sorts2.
- Apply alist_of_Map_sorts2.
+ intros. rewrite (MapFold_as_fold A M neutral op assoc nleft nright f m).
+ rewrite (MapFold_as_fold A M neutral op assoc nleft nright f m').
+ cut (alist_of_Map A m = alist_of_Map A m'). intro. rewrite H0. reflexivity.
+ apply alist_canonical. unfold eqmap in H. apply eqm_trans with (f' := MapGet A m).
+ apply eqm_sym. apply alist_of_Map_semantics.
+ apply eqm_trans with (f' := MapGet A m'). assumption.
+ apply alist_of_Map_semantics.
+ apply alist_of_Map_sorts2.
+ apply alist_of_Map_sorts2.
Qed.
- Lemma MapFold_ext_f_1 : (m:(Map A)) (f,g:ad->A->M) (pf:ad->ad)
- ((a:ad) (y:A) (MapGet ? m a)=(SOME ? y) -> (f (pf a) y)=(g (pf a) y)) ->
- (MapFold1 ? ? neutral op f pf m)=(MapFold1 ? ? neutral op g pf m).
+ Lemma MapFold_ext_f_1 :
+ forall (m:Map A) (f g:ad -> A -> M) (pf:ad -> ad),
+ (forall (a:ad) (y:A), MapGet _ m a = SOME _ y -> f (pf a) y = g (pf a) y) ->
+ MapFold1 _ _ neutral op f pf m = MapFold1 _ _ neutral op g pf m.
Proof.
- Induction m. Trivial.
- Simpl. Intros. Apply H. Rewrite (ad_eq_correct a). Reflexivity.
- Intros. Simpl. Rewrite (H f g [a0:ad](pf (ad_double a0))).
- Rewrite (H0 f g [a0:ad](pf (ad_double_plus_un a0))). Reflexivity.
- Intros. Apply H1. Rewrite MapGet_M2_bit_0_1. Rewrite ad_double_plus_un_div_2. Assumption.
- Apply ad_double_plus_un_bit_0.
- Intros. Apply H1. Rewrite MapGet_M2_bit_0_0. Rewrite ad_double_div_2. Assumption.
- Apply ad_double_bit_0.
+ simple induction m. trivial.
+ simpl in |- *. intros. apply H. rewrite (ad_eq_correct a). reflexivity.
+ intros. simpl in |- *. rewrite (H f g (fun a0:ad => pf (ad_double a0))).
+ rewrite (H0 f g (fun a0:ad => pf (ad_double_plus_un a0))). reflexivity.
+ intros. apply H1. rewrite MapGet_M2_bit_0_1. rewrite ad_double_plus_un_div_2. assumption.
+ apply ad_double_plus_un_bit_0.
+ intros. apply H1. rewrite MapGet_M2_bit_0_0. rewrite ad_double_div_2. assumption.
+ apply ad_double_bit_0.
Qed.
- Lemma MapFold_ext_f : (f,g:ad->A->M) (m:(Map A))
- ((a:ad) (y:A) (MapGet ? m a)=(SOME ? y) -> (f a y)=(g a y)) ->
- (MapFold ? ? neutral op f m)=(MapFold ? ? neutral op g m).
+ Lemma MapFold_ext_f :
+ forall (f g:ad -> A -> M) (m:Map A),
+ (forall (a:ad) (y:A), MapGet _ m a = SOME _ y -> f a y = g a y) ->
+ MapFold _ _ neutral op f m = MapFold _ _ neutral op g m.
Proof.
- Intros. Exact (MapFold_ext_f_1 m f g [a0:ad]a0 H).
+ intros. exact (MapFold_ext_f_1 m f g (fun a0:ad => a0) H).
Qed.
- Lemma MapFold1_as_Fold_1 : (m:(Map A)) (f,f':ad->A->M) (pf, pf':ad->ad)
- ((a:ad) (y:A) (f (pf a) y)=(f' (pf' a) y)) ->
- (MapFold1 ? ? neutral op f pf m)=(MapFold1 ? ? neutral op f' pf' m).
+ Lemma MapFold1_as_Fold_1 :
+ forall (m:Map A) (f f':ad -> A -> M) (pf pf':ad -> ad),
+ (forall (a:ad) (y:A), f (pf a) y = f' (pf' a) y) ->
+ MapFold1 _ _ neutral op f pf m = MapFold1 _ _ neutral op f' pf' m.
Proof.
- Induction m. Trivial.
- Intros. Simpl. Apply H.
- Intros. Simpl.
- Rewrite (H f f' [a0:ad](pf (ad_double a0)) [a0:ad](pf' (ad_double a0))).
- Rewrite (H0 f f' [a0:ad](pf (ad_double_plus_un a0)) [a0:ad](pf' (ad_double_plus_un a0))).
- Reflexivity.
- Intros. Apply H1.
- Intros. Apply H1.
+ simple induction m. trivial.
+ intros. simpl in |- *. apply H.
+ intros. simpl in |- *.
+ rewrite
+ (H f f' (fun a0:ad => pf (ad_double a0))
+ (fun a0:ad => pf' (ad_double a0))).
+ rewrite
+ (H0 f f' (fun a0:ad => pf (ad_double_plus_un a0))
+ (fun a0:ad => pf' (ad_double_plus_un a0))).
+ reflexivity.
+ intros. apply H1.
+ intros. apply H1.
Qed.
- Lemma MapFold1_as_Fold : (f:ad->A->M) (pf:ad->ad) (m:(Map A))
- (MapFold1 ? ? neutral op f pf m)=(MapFold ? ? neutral op [a:ad][y:A] (f (pf a) y) m).
+ Lemma MapFold1_as_Fold :
+ forall (f:ad -> A -> M) (pf:ad -> ad) (m:Map A),
+ MapFold1 _ _ neutral op f pf m =
+ MapFold _ _ neutral op (fun (a:ad) (y:A) => f (pf a) y) m.
Proof.
- Intros. Unfold MapFold. Apply MapFold1_as_Fold_1. Trivial.
+ intros. unfold MapFold in |- *. apply MapFold1_as_Fold_1. trivial.
Qed.
- Lemma MapFold1_ext : (f:ad->A->M) (m,m':(Map A)) (eqmap A m m') -> (pf:ad->ad)
- (MapFold1 ? ? neutral op f pf m)=(MapFold1 ? ? neutral op f pf m').
+ Lemma MapFold1_ext :
+ forall (f:ad -> A -> M) (m m':Map A),
+ eqmap A m m' ->
+ forall pf:ad -> ad,
+ MapFold1 _ _ neutral op f pf m = MapFold1 _ _ neutral op f pf m'.
Proof.
- Intros. Rewrite MapFold1_as_Fold. Rewrite MapFold1_as_Fold. Apply MapFold_ext. Assumption.
+ intros. rewrite MapFold1_as_Fold. rewrite MapFold1_as_Fold. apply MapFold_ext. assumption.
Qed.
- Variable comm : (a,b:M) (op a b)=(op b a).
+ Variable comm : forall a b:M, op a b = op b a.
- Lemma MapFold_Put_disjoint_1 : (p:positive)
- (f:ad->A->M) (pf:ad->ad) (a1,a2:ad) (y1,y2:A)
- (ad_xor a1 a2)=(ad_x p) ->
- (MapFold1 A M neutral op f pf (MapPut1 A a1 y1 a2 y2 p))=
- (op (f (pf a1) y1) (f (pf a2) y2)).
+ Lemma MapFold_Put_disjoint_1 :
+ forall (p:positive) (f:ad -> A -> M) (pf:ad -> ad)
+ (a1 a2:ad) (y1 y2:A),
+ ad_xor a1 a2 = ad_x p ->
+ MapFold1 A M neutral op f pf (MapPut1 A a1 y1 a2 y2 p) =
+ op (f (pf a1) y1) (f (pf a2) y2).
Proof.
- Induction p. Intros. Simpl. Elim (sumbool_of_bool (ad_bit_0 a1)). Intro H1. Rewrite H1.
- Simpl. Rewrite ad_div_2_double_plus_un. Rewrite ad_div_2_double. Apply comm.
- Change (ad_bit_0 a2)=(negb true). Rewrite <- H1. Rewrite (ad_neg_bit_0_2 ? ? ? H0).
- Rewrite negb_elim. Reflexivity.
- Assumption.
- Intro H1. Rewrite H1. Simpl. Rewrite ad_div_2_double. Rewrite ad_div_2_double_plus_un.
- Reflexivity.
- Change (ad_bit_0 a2)=(negb false). Rewrite <- H1. Rewrite (ad_neg_bit_0_2 ? ? ? H0).
- Rewrite negb_elim. Reflexivity.
- Assumption.
- Simpl. Intros. Elim (sumbool_of_bool (ad_bit_0 a1)). Intro H1. Rewrite H1. Simpl.
- Rewrite nleft.
- Rewrite (H f [a0:ad](pf (ad_double_plus_un a0)) (ad_div_2 a1) (ad_div_2 a2) y1 y2).
- Rewrite ad_div_2_double_plus_un. Rewrite ad_div_2_double_plus_un. Reflexivity.
- Rewrite <- (ad_same_bit_0 ? ? ? H0). Assumption.
- Assumption.
- Rewrite <- ad_xor_div_2. Rewrite H0. Reflexivity.
- Intro H1. Rewrite H1. Simpl. Rewrite nright.
- Rewrite (H f [a0:ad](pf (ad_double a0)) (ad_div_2 a1) (ad_div_2 a2) y1 y2).
- Rewrite ad_div_2_double. Rewrite ad_div_2_double. Reflexivity.
- Rewrite <- (ad_same_bit_0 ? ? ? H0). Assumption.
- Assumption.
- Rewrite <- ad_xor_div_2. Rewrite H0. Reflexivity.
- Intros. Simpl. Elim (sumbool_of_bool (ad_bit_0 a1)). Intro H0. Rewrite H0. Simpl.
- Rewrite ad_div_2_double. Rewrite ad_div_2_double_plus_un. Apply comm.
- Assumption.
- Change (ad_bit_0 a2)=(negb true). Rewrite <- H0. Rewrite (ad_neg_bit_0_1 ? ? H).
- Rewrite negb_elim. Reflexivity.
- Intro H0. Rewrite H0. Simpl. Rewrite ad_div_2_double. Rewrite ad_div_2_double_plus_un.
- Reflexivity.
- Change (ad_bit_0 a2)=(negb false). Rewrite <- H0. Rewrite (ad_neg_bit_0_1 ? ? H).
- Rewrite negb_elim. Reflexivity.
- Assumption.
+ simple induction p. intros. simpl in |- *. elim (sumbool_of_bool (ad_bit_0 a1)). intro H1. rewrite H1.
+ simpl in |- *. rewrite ad_div_2_double_plus_un. rewrite ad_div_2_double. apply comm.
+ change (ad_bit_0 a2 = negb true) in |- *. rewrite <- H1. rewrite (ad_neg_bit_0_2 _ _ _ H0).
+ rewrite negb_elim. reflexivity.
+ assumption.
+ intro H1. rewrite H1. simpl in |- *. rewrite ad_div_2_double. rewrite ad_div_2_double_plus_un.
+ reflexivity.
+ change (ad_bit_0 a2 = negb false) in |- *. rewrite <- H1. rewrite (ad_neg_bit_0_2 _ _ _ H0).
+ rewrite negb_elim. reflexivity.
+ assumption.
+ simpl in |- *. intros. elim (sumbool_of_bool (ad_bit_0 a1)). intro H1. rewrite H1. simpl in |- *.
+ rewrite nleft.
+ rewrite
+ (H f (fun a0:ad => pf (ad_double_plus_un a0)) (
+ ad_div_2 a1) (ad_div_2 a2) y1 y2).
+ rewrite ad_div_2_double_plus_un. rewrite ad_div_2_double_plus_un. reflexivity.
+ rewrite <- (ad_same_bit_0 _ _ _ H0). assumption.
+ assumption.
+ rewrite <- ad_xor_div_2. rewrite H0. reflexivity.
+ intro H1. rewrite H1. simpl in |- *. rewrite nright.
+ rewrite
+ (H f (fun a0:ad => pf (ad_double a0)) (ad_div_2 a1) (ad_div_2 a2) y1 y2)
+ .
+ rewrite ad_div_2_double. rewrite ad_div_2_double. reflexivity.
+ rewrite <- (ad_same_bit_0 _ _ _ H0). assumption.
+ assumption.
+ rewrite <- ad_xor_div_2. rewrite H0. reflexivity.
+ intros. simpl in |- *. elim (sumbool_of_bool (ad_bit_0 a1)). intro H0. rewrite H0. simpl in |- *.
+ rewrite ad_div_2_double. rewrite ad_div_2_double_plus_un. apply comm.
+ assumption.
+ change (ad_bit_0 a2 = negb true) in |- *. rewrite <- H0. rewrite (ad_neg_bit_0_1 _ _ H).
+ rewrite negb_elim. reflexivity.
+ intro H0. rewrite H0. simpl in |- *. rewrite ad_div_2_double. rewrite ad_div_2_double_plus_un.
+ reflexivity.
+ change (ad_bit_0 a2 = negb false) in |- *. rewrite <- H0. rewrite (ad_neg_bit_0_1 _ _ H).
+ rewrite negb_elim. reflexivity.
+ assumption.
Qed.
- Lemma MapFold_Put_disjoint_2 :
- (f:ad->A->M) (m:(Map A)) (a:ad) (y:A) (pf:ad->ad)
- (MapGet A m a)=(NONE A) ->
- (MapFold1 A M neutral op f pf (MapPut A m a y))=
- (op (f (pf a) y) (MapFold1 A M neutral op f pf m)).
+ Lemma MapFold_Put_disjoint_2 :
+ forall (f:ad -> A -> M) (m:Map A) (a:ad) (y:A) (pf:ad -> ad),
+ MapGet A m a = NONE A ->
+ MapFold1 A M neutral op f pf (MapPut A m a y) =
+ op (f (pf a) y) (MapFold1 A M neutral op f pf m).
Proof.
- Induction m. Intros. Simpl. Rewrite (nright (f (pf a) y)). Reflexivity.
- Intros a1 y1 a2 y2 pf H. Simpl. Elim (ad_sum (ad_xor a1 a2)). Intro H0. Elim H0.
- Intros p H1. Rewrite H1. Rewrite comm. Exact (MapFold_Put_disjoint_1 p f pf a1 a2 y1 y2 H1).
- Intro H0. Rewrite (ad_eq_complete ? ? (ad_xor_eq_true ? ? H0)) in H.
- Rewrite (M1_semantics_1 A a2 y1) in H. Discriminate H.
- Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H2.
- Cut (MapPut A (M2 A m0 m1) a y)=(M2 A m0 (MapPut A m1 (ad_div_2 a) y)). Intro.
- Rewrite H3. Simpl. Rewrite (H0 (ad_div_2 a) y [a0:ad](pf (ad_double_plus_un a0))).
- Rewrite ad_div_2_double_plus_un. Rewrite <- assoc.
- Rewrite (comm (MapFold1 A M neutral op f [a0:ad](pf (ad_double a0)) m0) (f (pf a) y)).
- Rewrite assoc. Reflexivity.
- Assumption.
- Rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1) in H1. Assumption.
- Simpl. Elim (ad_sum a). Intro H3. Elim H3. Intro p. Elim p. Intros p0 H4 H5. Rewrite H5.
- Reflexivity.
- Intros p0 H4 H5. Rewrite H5 in H2. Discriminate H2.
- Intro H4. Rewrite H4. Reflexivity.
- Intro H3. Rewrite H3 in H2. Discriminate H2.
- Intro H2. Cut (MapPut A (M2 A m0 m1) a y)=(M2 A (MapPut A m0 (ad_div_2 a) y) m1).
- Intro. Rewrite H3. Simpl. Rewrite (H (ad_div_2 a) y [a0:ad](pf (ad_double a0))).
- Rewrite ad_div_2_double. Rewrite <- assoc. Reflexivity.
- Assumption.
- Rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1) in H1. Assumption.
- Simpl. Elim (ad_sum a). Intro H3. Elim H3. Intro p. Elim p. Intros p0 H4 H5. Rewrite H5 in H2.
- Discriminate H2.
- Intros p0 H4 H5. Rewrite H5. Reflexivity.
- Intro H4. Rewrite H4 in H2. Discriminate H2.
- Intro H3. Rewrite H3. Reflexivity.
+ simple induction m. intros. simpl in |- *. rewrite (nright (f (pf a) y)). reflexivity.
+ intros a1 y1 a2 y2 pf H. simpl in |- *. elim (ad_sum (ad_xor a1 a2)). intro H0. elim H0.
+ intros p H1. rewrite H1. rewrite comm. exact (MapFold_Put_disjoint_1 p f pf a1 a2 y1 y2 H1).
+ intro H0. rewrite (ad_eq_complete _ _ (ad_xor_eq_true _ _ H0)) in H.
+ rewrite (M1_semantics_1 A a2 y1) in H. discriminate H.
+ intros. elim (sumbool_of_bool (ad_bit_0 a)). intro H2.
+ cut (MapPut A (M2 A m0 m1) a y = M2 A m0 (MapPut A m1 (ad_div_2 a) y)). intro.
+ rewrite H3. simpl in |- *. rewrite (H0 (ad_div_2 a) y (fun a0:ad => pf (ad_double_plus_un a0))).
+ rewrite ad_div_2_double_plus_un. rewrite <- assoc.
+ rewrite
+ (comm (MapFold1 A M neutral op f (fun a0:ad => pf (ad_double a0)) m0)
+ (f (pf a) y)).
+ rewrite assoc. reflexivity.
+ assumption.
+ rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1) in H1. assumption.
+ simpl in |- *. elim (ad_sum a). intro H3. elim H3. intro p. elim p. intros p0 H4 H5. rewrite H5.
+ reflexivity.
+ intros p0 H4 H5. rewrite H5 in H2. discriminate H2.
+ intro H4. rewrite H4. reflexivity.
+ intro H3. rewrite H3 in H2. discriminate H2.
+ intro H2. cut (MapPut A (M2 A m0 m1) a y = M2 A (MapPut A m0 (ad_div_2 a) y) m1).
+ intro. rewrite H3. simpl in |- *. rewrite (H (ad_div_2 a) y (fun a0:ad => pf (ad_double a0))).
+ rewrite ad_div_2_double. rewrite <- assoc. reflexivity.
+ assumption.
+ rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1) in H1. assumption.
+ simpl in |- *. elim (ad_sum a). intro H3. elim H3. intro p. elim p. intros p0 H4 H5. rewrite H5 in H2.
+ discriminate H2.
+ intros p0 H4 H5. rewrite H5. reflexivity.
+ intro H4. rewrite H4 in H2. discriminate H2.
+ intro H3. rewrite H3. reflexivity.
Qed.
- Lemma MapFold_Put_disjoint :
- (f:ad->A->M) (m:(Map A)) (a:ad) (y:A)
- (MapGet A m a)=(NONE A) ->
- (MapFold A M neutral op f (MapPut A m a y))=
- (op (f a y) (MapFold A M neutral op f m)).
+ Lemma MapFold_Put_disjoint :
+ forall (f:ad -> A -> M) (m:Map A) (a:ad) (y:A),
+ MapGet A m a = NONE A ->
+ MapFold A M neutral op f (MapPut A m a y) =
+ op (f a y) (MapFold A M neutral op f m).
Proof.
- Intros. Exact (MapFold_Put_disjoint_2 f m a y [a0:ad]a0 H).
+ intros. exact (MapFold_Put_disjoint_2 f m a y (fun a0:ad => a0) H).
Qed.
- Lemma MapFold_Put_behind_disjoint_2 :
- (f:ad->A->M) (m:(Map A)) (a:ad) (y:A) (pf:ad->ad)
- (MapGet A m a)=(NONE A) ->
- (MapFold1 A M neutral op f pf (MapPut_behind A m a y))=
- (op (f (pf a) y) (MapFold1 A M neutral op f pf m)).
+ Lemma MapFold_Put_behind_disjoint_2 :
+ forall (f:ad -> A -> M) (m:Map A) (a:ad) (y:A) (pf:ad -> ad),
+ MapGet A m a = NONE A ->
+ MapFold1 A M neutral op f pf (MapPut_behind A m a y) =
+ op (f (pf a) y) (MapFold1 A M neutral op f pf m).
Proof.
- Intros. Cut (eqmap A (MapPut_behind A m a y) (MapPut A m a y)). Intro.
- Rewrite (MapFold1_ext f ? ? H0 pf). Apply MapFold_Put_disjoint_2. Assumption.
- Apply eqmap_trans with m':=(MapMerge A (M1 A a y) m). Apply MapPut_behind_as_Merge.
- Apply eqmap_trans with m':=(MapMerge A m (M1 A a y)).
- Apply eqmap_trans with m':=(MapDelta A (M1 A a y) m). Apply eqmap_sym. Apply MapDelta_disjoint.
- Unfold MapDisjoint. Unfold in_dom. Simpl. Intros. Elim (sumbool_of_bool (ad_eq a a0)).
- Intro H2. Rewrite (ad_eq_complete ? ? H2) in H. Rewrite H in H1. Discriminate H1.
- Intro H2. Rewrite H2 in H0. Discriminate H0.
- Apply eqmap_trans with m':=(MapDelta A m (M1 A a y)). Apply MapDelta_sym.
- Apply MapDelta_disjoint. Unfold MapDisjoint. Unfold in_dom. Simpl. Intros.
- Elim (sumbool_of_bool (ad_eq a a0)). Intro H2. Rewrite (ad_eq_complete ? ? H2) in H.
- Rewrite H in H0. Discriminate H0.
- Intro H2. Rewrite H2 in H1. Discriminate H1.
- Apply eqmap_sym. Apply MapPut_as_Merge.
+ intros. cut (eqmap A (MapPut_behind A m a y) (MapPut A m a y)). intro.
+ rewrite (MapFold1_ext f _ _ H0 pf). apply MapFold_Put_disjoint_2. assumption.
+ apply eqmap_trans with (m' := MapMerge A (M1 A a y) m). apply MapPut_behind_as_Merge.
+ apply eqmap_trans with (m' := MapMerge A m (M1 A a y)).
+ apply eqmap_trans with (m' := MapDelta A (M1 A a y) m). apply eqmap_sym. apply MapDelta_disjoint.
+ unfold MapDisjoint in |- *. unfold in_dom in |- *. simpl in |- *. intros. elim (sumbool_of_bool (ad_eq a a0)).
+ intro H2. rewrite (ad_eq_complete _ _ H2) in H. rewrite H in H1. discriminate H1.
+ intro H2. rewrite H2 in H0. discriminate H0.
+ apply eqmap_trans with (m' := MapDelta A m (M1 A a y)). apply MapDelta_sym.
+ apply MapDelta_disjoint. unfold MapDisjoint in |- *. unfold in_dom in |- *. simpl in |- *. intros.
+ elim (sumbool_of_bool (ad_eq a a0)). intro H2. rewrite (ad_eq_complete _ _ H2) in H.
+ rewrite H in H0. discriminate H0.
+ intro H2. rewrite H2 in H1. discriminate H1.
+ apply eqmap_sym. apply MapPut_as_Merge.
Qed.
- Lemma MapFold_Put_behind_disjoint :
- (f:ad->A->M) (m:(Map A)) (a:ad) (y:A)
- (MapGet A m a)=(NONE A) ->
- (MapFold A M neutral op f (MapPut_behind A m a y))
- =(op (f a y) (MapFold A M neutral op f m)).
+ Lemma MapFold_Put_behind_disjoint :
+ forall (f:ad -> A -> M) (m:Map A) (a:ad) (y:A),
+ MapGet A m a = NONE A ->
+ MapFold A M neutral op f (MapPut_behind A m a y) =
+ op (f a y) (MapFold A M neutral op f m).
Proof.
- Intros. Exact (MapFold_Put_behind_disjoint_2 f m a y [a0:ad]a0 H).
+ intros. exact (MapFold_Put_behind_disjoint_2 f m a y (fun a0:ad => a0) H).
Qed.
Lemma MapFold_Merge_disjoint_1 :
- (f:ad->A->M) (m1,m2:(Map A)) (pf:ad->ad)
- (MapDisjoint A A m1 m2) ->
- (MapFold1 A M neutral op f pf (MapMerge A m1 m2))=
- (op (MapFold1 A M neutral op f pf m1) (MapFold1 A M neutral op f pf m2)).
+ forall (f:ad -> A -> M) (m1 m2:Map A) (pf:ad -> ad),
+ MapDisjoint A A m1 m2 ->
+ MapFold1 A M neutral op f pf (MapMerge A m1 m2) =
+ op (MapFold1 A M neutral op f pf m1) (MapFold1 A M neutral op f pf m2).
Proof.
- Induction m1. Simpl. Intros. Rewrite nleft. Reflexivity.
- Intros. Unfold MapMerge. Apply (MapFold_Put_behind_disjoint_2 f m2 a a0 pf).
- Apply in_dom_none. Exact (MapDisjoint_M1_l ? ? m2 a a0 H).
- Induction m2. Intros. Simpl. Rewrite nright. Reflexivity.
- Intros. Unfold MapMerge. Rewrite (MapFold_Put_disjoint_2 f (M2 A m m0) a a0 pf). Apply comm.
- Apply in_dom_none. Exact (MapDisjoint_M1_r ? ? (M2 A m m0) a a0 H1).
- Intros. Simpl. Rewrite (H m3 [a0:ad](pf (ad_double a0))).
- Rewrite (H0 m4 [a0:ad](pf (ad_double_plus_un a0))).
- Cut (a,b,c,d:M)(op (op a b) (op c d))=(op (op a c) (op b d)). Intro. Apply H4.
- Intros. Rewrite assoc. Rewrite <- (assoc b c d). Rewrite (comm b c). Rewrite (assoc c b d).
- Rewrite assoc. Reflexivity.
- Exact (MapDisjoint_M2_r ? ? ? ? ? ? H3).
- Exact (MapDisjoint_M2_l ? ? ? ? ? ? H3).
+ simple induction m1. simpl in |- *. intros. rewrite nleft. reflexivity.
+ intros. unfold MapMerge in |- *. apply (MapFold_Put_behind_disjoint_2 f m2 a a0 pf).
+ apply in_dom_none. exact (MapDisjoint_M1_l _ _ m2 a a0 H).
+ simple induction m2. intros. simpl in |- *. rewrite nright. reflexivity.
+ intros. unfold MapMerge in |- *. rewrite (MapFold_Put_disjoint_2 f (M2 A m m0) a a0 pf). apply comm.
+ apply in_dom_none. exact (MapDisjoint_M1_r _ _ (M2 A m m0) a a0 H1).
+ intros. simpl in |- *. rewrite (H m3 (fun a0:ad => pf (ad_double a0))).
+ rewrite (H0 m4 (fun a0:ad => pf (ad_double_plus_un a0))).
+ cut (forall a b c d:M, op (op a b) (op c d) = op (op a c) (op b d)). intro. apply H4.
+ intros. rewrite assoc. rewrite <- (assoc b c d). rewrite (comm b c). rewrite (assoc c b d).
+ rewrite assoc. reflexivity.
+ exact (MapDisjoint_M2_r _ _ _ _ _ _ H3).
+ exact (MapDisjoint_M2_l _ _ _ _ _ _ H3).
Qed.
Lemma MapFold_Merge_disjoint :
- (f:ad->A->M) (m1,m2:(Map A))
- (MapDisjoint A A m1 m2) ->
- (MapFold A M neutral op f (MapMerge A m1 m2))=
- (op (MapFold A M neutral op f m1) (MapFold A M neutral op f m2)).
+ forall (f:ad -> A -> M) (m1 m2:Map A),
+ MapDisjoint A A m1 m2 ->
+ MapFold A M neutral op f (MapMerge A m1 m2) =
+ op (MapFold A M neutral op f m1) (MapFold A M neutral op f m2).
Proof.
- Intros. Exact (MapFold_Merge_disjoint_1 f m1 m2 [a0:ad]a0 H).
+ intros. exact (MapFold_Merge_disjoint_1 f m1 m2 (fun a0:ad => a0) H).
Qed.
End MapFoldResults.
@@ -261,23 +281,27 @@ Section MapFoldDistr.
Variable times : M -> N -> M'.
- Variable absorb : (c:N)(times neutral c)=neutral'.
- Variable distr : (a,b:M) (c:N) (times (op a b) c) = (op' (times a c) (times b c)).
+ Variable absorb : forall c:N, times neutral c = neutral'.
+ Variable
+ distr :
+ forall (a b:M) (c:N), times (op a b) c = op' (times a c) (times b c).
- Lemma MapFold_distr_r_1 : (f:ad->A->M) (m:(Map A)) (c:N) (pf:ad->ad)
- (times (MapFold1 A M neutral op f pf m) c)=
- (MapFold1 A M' neutral' op' [a:ad][y:A] (times (f a y) c) pf m).
+ Lemma MapFold_distr_r_1 :
+ forall (f:ad -> A -> M) (m:Map A) (c:N) (pf:ad -> ad),
+ times (MapFold1 A M neutral op f pf m) c =
+ MapFold1 A M' neutral' op' (fun (a:ad) (y:A) => times (f a y) c) pf m.
Proof.
- Induction m. Intros. Exact (absorb c).
- Trivial.
- Intros. Simpl. Rewrite distr. Rewrite H. Rewrite H0. Reflexivity.
+ simple induction m. intros. exact (absorb c).
+ trivial.
+ intros. simpl in |- *. rewrite distr. rewrite H. rewrite H0. reflexivity.
Qed.
- Lemma MapFold_distr_r : (f:ad->A->M) (m:(Map A)) (c:N)
- (times (MapFold A M neutral op f m) c)=
- (MapFold A M' neutral' op' [a:ad][y:A] (times (f a y) c) m).
+ Lemma MapFold_distr_r :
+ forall (f:ad -> A -> M) (m:Map A) (c:N),
+ times (MapFold A M neutral op f m) c =
+ MapFold A M' neutral' op' (fun (a:ad) (y:A) => times (f a y) c) m.
Proof.
- Intros. Exact (MapFold_distr_r_1 f m c [a:ad]a).
+ intros. exact (MapFold_distr_r_1 f m c (fun a:ad => a)).
Qed.
End MapFoldDistr.
@@ -298,14 +322,18 @@ Section MapFoldDistrL.
Variable times : N -> M -> M'.
- Variable absorb : (c:N)(times c neutral)=neutral'.
- Variable distr : (a,b:M) (c:N) (times c (op a b)) = (op' (times c a) (times c b)).
+ Variable absorb : forall c:N, times c neutral = neutral'.
+ Variable
+ distr :
+ forall (a b:M) (c:N), times c (op a b) = op' (times c a) (times c b).
- Lemma MapFold_distr_l : (f:ad->A->M) (m:(Map A)) (c:N)
- (times c (MapFold A M neutral op f m))=
- (MapFold A M' neutral' op' [a:ad][y:A] (times c (f a y)) m).
+ Lemma MapFold_distr_l :
+ forall (f:ad -> A -> M) (m:Map A) (c:N),
+ times c (MapFold A M neutral op f m) =
+ MapFold A M' neutral' op' (fun (a:ad) (y:A) => times c (f a y)) m.
Proof.
- Intros. Apply MapFold_distr_r with times:=[a:M][b:N](times b a); Assumption.
+ intros. apply MapFold_distr_r with (times := fun (a:M) (b:N) => times b a);
+ assumption.
Qed.
End MapFoldDistrL.
@@ -314,27 +342,30 @@ Section MapFoldExists.
Variable A : Set.
- Lemma MapFold_orb_1 : (f:ad->A->bool) (m:(Map A)) (pf:ad->ad)
- (MapFold1 A bool false orb f pf m)=
- (Cases (MapSweep1 A f pf m) of
- (SOME _) => true
- | _ => false
- end).
+ Lemma MapFold_orb_1 :
+ forall (f:ad -> A -> bool) (m:Map A) (pf:ad -> ad),
+ MapFold1 A bool false orb f pf m =
+ match MapSweep1 A f pf m with
+ | SOME _ => true
+ | _ => false
+ end.
Proof.
- Induction m. Trivial.
- Intros a y pf. Simpl. Unfold MapSweep2. (Case (f (pf a) y); Reflexivity).
- Intros. Simpl. Rewrite (H [a0:ad](pf (ad_double a0))).
- Rewrite (H0 [a0:ad](pf (ad_double_plus_un a0))).
- Case (MapSweep1 A f [a0:ad](pf (ad_double a0)) m0); Reflexivity.
+ simple induction m. trivial.
+ intros a y pf. simpl in |- *. unfold MapSweep2 in |- *. case (f (pf a) y); reflexivity.
+ intros. simpl in |- *. rewrite (H (fun a0:ad => pf (ad_double a0))).
+ rewrite (H0 (fun a0:ad => pf (ad_double_plus_un a0))).
+ case (MapSweep1 A f (fun a0:ad => pf (ad_double a0)) m0); reflexivity.
Qed.
- Lemma MapFold_orb : (f:ad->A->bool) (m:(Map A)) (MapFold A bool false orb f m)=
- (Cases (MapSweep A f m) of
- (SOME _) => true
- | _ => false
- end).
+ Lemma MapFold_orb :
+ forall (f:ad -> A -> bool) (m:Map A),
+ MapFold A bool false orb f m =
+ match MapSweep A f m with
+ | SOME _ => true
+ | _ => false
+ end.
Proof.
- Intros. Exact (MapFold_orb_1 f m [a:ad]a).
+ intros. exact (MapFold_orb_1 f m (fun a:ad => a)).
Qed.
End MapFoldExists.
@@ -343,39 +374,51 @@ Section DMergeDef.
Variable A : Set.
- Definition DMerge := (MapFold (Map A) (Map A) (M0 A) (MapMerge A) [_:ad][m:(Map A)] m).
+ Definition DMerge :=
+ MapFold (Map A) (Map A) (M0 A) (MapMerge A) (fun (_:ad) (m:Map A) => m).
- Lemma in_dom_DMerge_1 : (m:(Map (Map A))) (a:ad) (in_dom A a (DMerge m))=
- (Cases (MapSweep ? [_:ad][m0:(Map A)] (in_dom A a m0) m) of
- (SOME _) => true
- | _ => false
- end).
+ Lemma in_dom_DMerge_1 :
+ forall (m:Map (Map A)) (a:ad),
+ in_dom A a (DMerge m) =
+ match MapSweep _ (fun (_:ad) (m0:Map A) => in_dom A a m0) m with
+ | SOME _ => true
+ | _ => false
+ end.
Proof.
- Unfold DMerge. Intros.
- Rewrite (MapFold_distr_l (Map A) (Map A) (M0 A) (MapMerge A) bool false
- orb ad (in_dom A) [c:ad](refl_equal ? ?) (in_dom_merge A)).
- Apply MapFold_orb.
+ unfold DMerge in |- *. intros.
+ rewrite
+ (MapFold_distr_l (Map A) (Map A) (M0 A) (MapMerge A) bool false orb ad
+ (in_dom A) (fun c:ad => refl_equal _) (in_dom_merge A))
+ .
+ apply MapFold_orb.
Qed.
- Lemma in_dom_DMerge_2 : (m:(Map (Map A))) (a:ad) (in_dom A a (DMerge m))=true ->
- {b:ad & {m0:(Map A) | (MapGet ? m b)=(SOME ? m0) /\
- (in_dom A a m0)=true}}.
+ Lemma in_dom_DMerge_2 :
+ forall (m:Map (Map A)) (a:ad),
+ in_dom A a (DMerge m) = true ->
+ {b : ad &
+ {m0 : Map A | MapGet _ m b = SOME _ m0 /\ in_dom A a m0 = true}}.
Proof.
- Intros m a. Rewrite in_dom_DMerge_1.
- Elim (option_sum ? (MapSweep (Map A) [_:ad][m0:(Map A)](in_dom A a m0) m)).
- Intro H. Elim H. Intro r. Elim r. Intros b m0 H0. Intro. Split with b. Split with m0.
- Split. Exact (MapSweep_semantics_2 ? ? ? ? ? H0).
- Exact (MapSweep_semantics_1 ? ? ? ? ? H0).
- Intro H. Rewrite H. Intro. Discriminate H0.
+ intros m a. rewrite in_dom_DMerge_1.
+ elim
+ (option_sum _
+ (MapSweep (Map A) (fun (_:ad) (m0:Map A) => in_dom A a m0) m)).
+ intro H. elim H. intro r. elim r. intros b m0 H0. intro. split with b. split with m0.
+ split. exact (MapSweep_semantics_2 _ _ _ _ _ H0).
+ exact (MapSweep_semantics_1 _ _ _ _ _ H0).
+ intro H. rewrite H. intro. discriminate H0.
Qed.
- Lemma in_dom_DMerge_3 : (m:(Map (Map A))) (a,b:ad) (m0:(Map A))
- (MapGet ? m a)=(SOME ? m0) -> (in_dom A b m0)=true ->
- (in_dom A b (DMerge m))=true.
+ Lemma in_dom_DMerge_3 :
+ forall (m:Map (Map A)) (a b:ad) (m0:Map A),
+ MapGet _ m a = SOME _ m0 ->
+ in_dom A b m0 = true -> in_dom A b (DMerge m) = true.
Proof.
- Intros m a b m0 H H0. Rewrite in_dom_DMerge_1.
- Elim (MapSweep_semantics_4 ? [_:ad][m'0:(Map A)](in_dom A b m'0) ? ? ? H H0).
- Intros a' H1. Elim H1. Intros m'0 H2. Rewrite H2. Reflexivity.
+ intros m a b m0 H H0. rewrite in_dom_DMerge_1.
+ elim
+ (MapSweep_semantics_4 _ (fun (_:ad) (m'0:Map A) => in_dom A b m'0) _ _ _
+ H H0).
+ intros a' H1. elim H1. intros m'0 H2. rewrite H2. reflexivity.
Qed.
-End DMergeDef.
+End DMergeDef. \ No newline at end of file
diff --git a/theories/IntMap/Mapiter.v b/theories/IntMap/Mapiter.v
index 216a07c63..3c0aad802 100644
--- a/theories/IntMap/Mapiter.v
+++ b/theories/IntMap/Mapiter.v
@@ -7,16 +7,16 @@
(***********************************************************************)
(*i $Id$ i*)
-Require Bool.
-Require Sumbool.
-Require ZArith.
-Require Addr.
-Require Adist.
-Require Addec.
-Require Map.
-Require Mapaxioms.
-Require Fset.
-Require PolyList.
+Require Import Bool.
+Require Import Sumbool.
+Require Import ZArith.
+Require Import Addr.
+Require Import Adist.
+Require Import Addec.
+Require Import Map.
+Require Import Mapaxioms.
+Require Import Fset.
+Require Import List.
Section MapIter.
@@ -24,172 +24,200 @@ Section MapIter.
Section MapSweepDef.
- Variable f:ad->A->bool.
-
- Definition MapSweep2 := [a0:ad; y:A] if (f a0 y) then (SOME ? (a0, y)) else (NONE ?).
-
- Fixpoint MapSweep1 [pf:ad->ad; m:(Map A)] : (option (ad * A)) :=
- Cases m of
- M0 => (NONE ?)
- | (M1 a y) => (MapSweep2 (pf a) y)
- | (M2 m m') => Cases (MapSweep1 ([a:ad] (pf (ad_double a))) m) of
- (SOME r) => (SOME ? r)
- | NONE => (MapSweep1 ([a:ad] (pf (ad_double_plus_un a))) m')
- end
+ Variable f : ad -> A -> bool.
+
+ Definition MapSweep2 (a0:ad) (y:A) :=
+ if f a0 y then SOME _ (a0, y) else NONE _.
+
+ Fixpoint MapSweep1 (pf:ad -> ad) (m:Map A) {struct m} :
+ option (ad * A) :=
+ match m with
+ | M0 => NONE _
+ | M1 a y => MapSweep2 (pf a) y
+ | M2 m m' =>
+ match MapSweep1 (fun a:ad => pf (ad_double a)) m with
+ | SOME r => SOME _ r
+ | NONE => MapSweep1 (fun a:ad => pf (ad_double_plus_un a)) m'
+ end
end.
- Definition MapSweep := [m:(Map A)] (MapSweep1 ([a:ad] a) m).
+ Definition MapSweep (m:Map A) := MapSweep1 (fun a:ad => a) m.
- Lemma MapSweep_semantics_1_1 : (m:(Map A)) (pf:ad->ad) (a:ad) (y:A)
- (MapSweep1 pf m)=(SOME ? (a, y)) -> (f a y)=true.
+ Lemma MapSweep_semantics_1_1 :
+ forall (m:Map A) (pf:ad -> ad) (a:ad) (y:A),
+ MapSweep1 pf m = SOME _ (a, y) -> f a y = true.
Proof.
- Induction m. Intros. Discriminate H.
- Simpl. Intros a y pf a0 y0. Elim (sumbool_of_bool (f (pf a) y)). Intro H. Unfold MapSweep2.
- Rewrite H. Intro H0. Inversion H0. Rewrite <- H3. Assumption.
- Intro H. Unfold MapSweep2. Rewrite H. Intro H0. Discriminate H0.
- Simpl. Intros. Elim (option_sum ad*A (MapSweep1 [a0:ad](pf (ad_double a0)) m0)).
- Intro H2. Elim H2. Intros r H3. Rewrite H3 in H1. Inversion H1. Rewrite H5 in H3.
- Exact (H [a0:ad](pf (ad_double a0)) a y H3).
- Intro H2. Rewrite H2 in H1. Exact (H0 [a0:ad](pf (ad_double_plus_un a0)) a y H1).
+ simple induction m. intros. discriminate H.
+ simpl in |- *. intros a y pf a0 y0. elim (sumbool_of_bool (f (pf a) y)). intro H. unfold MapSweep2 in |- *.
+ rewrite H. intro H0. inversion H0. rewrite <- H3. assumption.
+ intro H. unfold MapSweep2 in |- *. rewrite H. intro H0. discriminate H0.
+ simpl in |- *. intros. elim (option_sum (ad * A) (MapSweep1 (fun a0:ad => pf (ad_double a0)) m0)).
+ intro H2. elim H2. intros r H3. rewrite H3 in H1. inversion H1. rewrite H5 in H3.
+ exact (H (fun a0:ad => pf (ad_double a0)) a y H3).
+ intro H2. rewrite H2 in H1. exact (H0 (fun a0:ad => pf (ad_double_plus_un a0)) a y H1).
Qed.
- Lemma MapSweep_semantics_1 : (m:(Map A)) (a:ad) (y:A)
- (MapSweep m)=(SOME ? (a, y)) -> (f a y)=true.
+ Lemma MapSweep_semantics_1 :
+ forall (m:Map A) (a:ad) (y:A), MapSweep m = SOME _ (a, y) -> f a y = true.
Proof.
- Intros. Exact (MapSweep_semantics_1_1 m [a:ad]a a y H).
+ intros. exact (MapSweep_semantics_1_1 m (fun a:ad => a) a y H).
Qed.
- Lemma MapSweep_semantics_2_1 : (m:(Map A)) (pf:ad->ad) (a:ad) (y:A)
- (MapSweep1 pf m)=(SOME ? (a, y)) -> {a':ad | a=(pf a')}.
+ Lemma MapSweep_semantics_2_1 :
+ forall (m:Map A) (pf:ad -> ad) (a:ad) (y:A),
+ MapSweep1 pf m = SOME _ (a, y) -> {a' : ad | a = pf a'}.
Proof.
- Induction m. Intros. Discriminate H.
- Simpl. Unfold MapSweep2. Intros a y pf a0 y0. Case (f (pf a) y). Intros. Split with a.
- Inversion H. Reflexivity.
- Intro. Discriminate H.
- Intros m0 H m1 H0 pf a y. Simpl.
- Elim (option_sum ad*A (MapSweep1 [a0:ad](pf (ad_double a0)) m0)). Intro H1. Elim H1.
- Intros r H2. Rewrite H2. Intro H3. Inversion H3. Rewrite H5 in H2.
- Elim (H [a0:ad](pf (ad_double a0)) a y H2). Intros a0 H6. Split with (ad_double a0).
- Assumption.
- Intro H1. Rewrite H1. Intro H2. Elim (H0 [a0:ad](pf (ad_double_plus_un a0)) a y H2).
- Intros a0 H3. Split with (ad_double_plus_un a0). Assumption.
+ simple induction m. intros. discriminate H.
+ simpl in |- *. unfold MapSweep2 in |- *. intros a y pf a0 y0. case (f (pf a) y). intros. split with a.
+ inversion H. reflexivity.
+ intro. discriminate H.
+ intros m0 H m1 H0 pf a y. simpl in |- *.
+ elim
+ (option_sum (ad * A) (MapSweep1 (fun a0:ad => pf (ad_double a0)) m0)). intro H1. elim H1.
+ intros r H2. rewrite H2. intro H3. inversion H3. rewrite H5 in H2.
+ elim (H (fun a0:ad => pf (ad_double a0)) a y H2). intros a0 H6. split with (ad_double a0).
+ assumption.
+ intro H1. rewrite H1. intro H2. elim (H0 (fun a0:ad => pf (ad_double_plus_un a0)) a y H2).
+ intros a0 H3. split with (ad_double_plus_un a0). assumption.
Qed.
- Lemma MapSweep_semantics_2_2 : (m:(Map A))
- (pf,fp:ad->ad) ((a0:ad) (fp (pf a0))=a0) -> (a:ad) (y:A)
- (MapSweep1 pf m)=(SOME ? (a, y)) -> (MapGet A m (fp a))=(SOME ? y).
+ Lemma MapSweep_semantics_2_2 :
+ forall (m:Map A) (pf fp:ad -> ad),
+ (forall a0:ad, fp (pf a0) = a0) ->
+ forall (a:ad) (y:A),
+ MapSweep1 pf m = SOME _ (a, y) -> MapGet A m (fp a) = SOME _ y.
Proof.
- Induction m. Intros. Discriminate H0.
- Simpl. Intros a y pf fp H a0 y0. Unfold MapSweep2. Elim (sumbool_of_bool (f (pf a) y)).
- Intro H0. Rewrite H0. Intro H1. Inversion H1. Rewrite (H a). Rewrite (ad_eq_correct a).
- Reflexivity.
- Intro H0. Rewrite H0. Intro H1. Discriminate H1.
- Intros. Rewrite (MapGet_M2_bit_0_if A m0 m1 (fp a)). Elim (sumbool_of_bool (ad_bit_0 (fp a))).
- Intro H3. Rewrite H3. Elim (option_sum ad*A (MapSweep1 [a0:ad](pf (ad_double a0)) m0)).
- Intro H4. Simpl in H2. Apply (H0 [a0:ad](pf (ad_double_plus_un a0)) [a0:ad](ad_div_2 (fp a0))).
- Intro. Rewrite H1. Apply ad_double_plus_un_div_2.
- Elim (option_sum ad*A (MapSweep1 [a0:ad](pf (ad_double a0)) m0)). Intro H5. Elim H5.
- Intros r H6. Rewrite H6 in H2. Inversion H2. Rewrite H8 in H6.
- Elim (MapSweep_semantics_2_1 m0 [a0:ad](pf (ad_double a0)) a y H6). Intros a0 H9.
- Rewrite H9 in H3. Rewrite (H1 (ad_double a0)) in H3. Rewrite (ad_double_bit_0 a0) in H3.
- Discriminate H3.
- Intro H5. Rewrite H5 in H2. Assumption.
- Intro H4. Simpl in H2. Rewrite H4 in H2.
- Apply (H0 [a0:ad](pf (ad_double_plus_un a0)) [a0:ad](ad_div_2 (fp a0))). Intro.
- Rewrite H1. Apply ad_double_plus_un_div_2.
- Assumption.
- Intro H3. Rewrite H3. Simpl in H2.
- Elim (option_sum ad*A (MapSweep1 [a0:ad](pf (ad_double a0)) m0)). Intro H4. Elim H4.
- Intros r H5. Rewrite H5 in H2. Inversion H2. Rewrite H7 in H5.
- Apply (H [a0:ad](pf (ad_double a0)) [a0:ad](ad_div_2 (fp a0))). Intro. Rewrite H1.
- Apply ad_double_div_2.
- Assumption.
- Intro H4. Rewrite H4 in H2.
- Elim (MapSweep_semantics_2_1 m1 [a0:ad](pf (ad_double_plus_un a0)) a y H2).
- Intros a0 H5. Rewrite H5 in H3. Rewrite (H1 (ad_double_plus_un a0)) in H3.
- Rewrite (ad_double_plus_un_bit_0 a0) in H3. Discriminate H3.
+ simple induction m. intros. discriminate H0.
+ simpl in |- *. intros a y pf fp H a0 y0. unfold MapSweep2 in |- *. elim (sumbool_of_bool (f (pf a) y)).
+ intro H0. rewrite H0. intro H1. inversion H1. rewrite (H a). rewrite (ad_eq_correct a).
+ reflexivity.
+ intro H0. rewrite H0. intro H1. discriminate H1.
+ intros. rewrite (MapGet_M2_bit_0_if A m0 m1 (fp a)). elim (sumbool_of_bool (ad_bit_0 (fp a))).
+ intro H3. rewrite H3. elim (option_sum (ad * A) (MapSweep1 (fun a0:ad => pf (ad_double a0)) m0)).
+ intro H4. simpl in H2. apply
+ (H0 (fun a0:ad => pf (ad_double_plus_un a0))
+ (fun a0:ad => ad_div_2 (fp a0))).
+ intro. rewrite H1. apply ad_double_plus_un_div_2.
+ elim
+ (option_sum (ad * A) (MapSweep1 (fun a0:ad => pf (ad_double a0)) m0)). intro H5. elim H5.
+ intros r H6. rewrite H6 in H2. inversion H2. rewrite H8 in H6.
+ elim (MapSweep_semantics_2_1 m0 (fun a0:ad => pf (ad_double a0)) a y H6). intros a0 H9.
+ rewrite H9 in H3. rewrite (H1 (ad_double a0)) in H3. rewrite (ad_double_bit_0 a0) in H3.
+ discriminate H3.
+ intro H5. rewrite H5 in H2. assumption.
+ intro H4. simpl in H2. rewrite H4 in H2.
+ apply
+ (H0 (fun a0:ad => pf (ad_double_plus_un a0))
+ (fun a0:ad => ad_div_2 (fp a0))). intro.
+ rewrite H1. apply ad_double_plus_un_div_2.
+ assumption.
+ intro H3. rewrite H3. simpl in H2.
+ elim
+ (option_sum (ad * A) (MapSweep1 (fun a0:ad => pf (ad_double a0)) m0)). intro H4. elim H4.
+ intros r H5. rewrite H5 in H2. inversion H2. rewrite H7 in H5.
+ apply
+ (H (fun a0:ad => pf (ad_double a0)) (fun a0:ad => ad_div_2 (fp a0))). intro. rewrite H1.
+ apply ad_double_div_2.
+ assumption.
+ intro H4. rewrite H4 in H2.
+ elim
+ (MapSweep_semantics_2_1 m1 (fun a0:ad => pf (ad_double_plus_un a0)) a y
+ H2).
+ intros a0 H5. rewrite H5 in H3. rewrite (H1 (ad_double_plus_un a0)) in H3.
+ rewrite (ad_double_plus_un_bit_0 a0) in H3. discriminate H3.
Qed.
- Lemma MapSweep_semantics_2 : (m:(Map A)) (a:ad) (y:A)
- (MapSweep m)=(SOME ? (a, y)) -> (MapGet A m a)=(SOME ? y).
+ Lemma MapSweep_semantics_2 :
+ forall (m:Map A) (a:ad) (y:A),
+ MapSweep m = SOME _ (a, y) -> MapGet A m a = SOME _ y.
Proof.
- Intros.
- Exact (MapSweep_semantics_2_2 m [a0:ad]a0 [a0:ad]a0 [a0:ad](refl_equal ad a0) a y H).
+ intros.
+ exact
+ (MapSweep_semantics_2_2 m (fun a0:ad => a0) (fun a0:ad => a0)
+ (fun a0:ad => refl_equal a0) a y H).
Qed.
- Lemma MapSweep_semantics_3_1 : (m:(Map A)) (pf:ad->ad)
- (MapSweep1 pf m)=(NONE ?) ->
- (a:ad) (y:A) (MapGet A m a)=(SOME ? y) -> (f (pf a) y)=false.
+ Lemma MapSweep_semantics_3_1 :
+ forall (m:Map A) (pf:ad -> ad),
+ MapSweep1 pf m = NONE _ ->
+ forall (a:ad) (y:A), MapGet A m a = SOME _ y -> f (pf a) y = false.
Proof.
- Induction m. Intros. Discriminate H0.
- Simpl. Unfold MapSweep2. Intros a y pf. Elim (sumbool_of_bool (f (pf a) y)). Intro H.
- Rewrite H. Intro. Discriminate H0.
- Intro H. Rewrite H. Intros H0 a0 y0. Elim (sumbool_of_bool (ad_eq a a0)). Intro H1. Rewrite H1.
- Intro H2. Inversion H2. Rewrite <- H4. Rewrite <- (ad_eq_complete ? ? H1). Assumption.
- Intro H1. Rewrite H1. Intro. Discriminate H2.
- Intros. Simpl in H1. Elim (option_sum ad*A (MapSweep1 [a:ad](pf (ad_double a)) m0)).
- Intro H3. Elim H3. Intros r H4. Rewrite H4 in H1. Discriminate H1.
- Intro H3. Rewrite H3 in H1. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H4.
- Rewrite (MapGet_M2_bit_0_1 A a H4 m0 m1) in H2. Rewrite <- (ad_div_2_double_plus_un a H4).
- Exact (H0 [a:ad](pf (ad_double_plus_un a)) H1 (ad_div_2 a) y H2).
- Intro H4. Rewrite (MapGet_M2_bit_0_0 A a H4 m0 m1) in H2. Rewrite <- (ad_div_2_double a H4).
- Exact (H [a:ad](pf (ad_double a)) H3 (ad_div_2 a) y H2).
+ simple induction m. intros. discriminate H0.
+ simpl in |- *. unfold MapSweep2 in |- *. intros a y pf. elim (sumbool_of_bool (f (pf a) y)). intro H.
+ rewrite H. intro. discriminate H0.
+ intro H. rewrite H. intros H0 a0 y0. elim (sumbool_of_bool (ad_eq a a0)). intro H1. rewrite H1.
+ intro H2. inversion H2. rewrite <- H4. rewrite <- (ad_eq_complete _ _ H1). assumption.
+ intro H1. rewrite H1. intro. discriminate H2.
+ intros. simpl in H1. elim (option_sum (ad * A) (MapSweep1 (fun a:ad => pf (ad_double a)) m0)).
+ intro H3. elim H3. intros r H4. rewrite H4 in H1. discriminate H1.
+ intro H3. rewrite H3 in H1. elim (sumbool_of_bool (ad_bit_0 a)). intro H4.
+ rewrite (MapGet_M2_bit_0_1 A a H4 m0 m1) in H2. rewrite <- (ad_div_2_double_plus_un a H4).
+ exact (H0 (fun a:ad => pf (ad_double_plus_un a)) H1 (ad_div_2 a) y H2).
+ intro H4. rewrite (MapGet_M2_bit_0_0 A a H4 m0 m1) in H2. rewrite <- (ad_div_2_double a H4).
+ exact (H (fun a:ad => pf (ad_double a)) H3 (ad_div_2 a) y H2).
Qed.
- Lemma MapSweep_semantics_3 : (m:(Map A))
- (MapSweep m)=(NONE ?) -> (a:ad) (y:A) (MapGet A m a)=(SOME ? y) ->
- (f a y)=false.
+ Lemma MapSweep_semantics_3 :
+ forall m:Map A,
+ MapSweep m = NONE _ ->
+ forall (a:ad) (y:A), MapGet A m a = SOME _ y -> f a y = false.
Proof.
- Intros.
- Exact (MapSweep_semantics_3_1 m [a0:ad]a0 H a y H0).
+ intros.
+ exact (MapSweep_semantics_3_1 m (fun a0:ad => a0) H a y H0).
Qed.
- Lemma MapSweep_semantics_4_1 : (m:(Map A)) (pf:ad->ad) (a:ad) (y:A)
- (MapGet A m a)=(SOME A y) -> (f (pf a) y)=true ->
- {a':ad & {y':A | (MapSweep1 pf m)=(SOME ? (a', y'))}}.
+ Lemma MapSweep_semantics_4_1 :
+ forall (m:Map A) (pf:ad -> ad) (a:ad) (y:A),
+ MapGet A m a = SOME A y ->
+ f (pf a) y = true ->
+ {a' : ad & {y' : A | MapSweep1 pf m = SOME _ (a', y')}}.
Proof.
- Induction m. Intros. Discriminate H.
- Intros. Elim (sumbool_of_bool (ad_eq a a1)). Intro H1. Split with (pf a1). Split with y.
- Rewrite (ad_eq_complete ? ? H1). Unfold MapSweep1 MapSweep2.
- Rewrite (ad_eq_complete ? ? H1) in H. Rewrite (M1_semantics_1 ? a1 a0) in H.
- Inversion H. Rewrite H0. Reflexivity.
-
- Intro H1. Rewrite (M1_semantics_2 ? a a1 a0 H1) in H. Discriminate H.
-
- Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H3.
- Rewrite (MapGet_M2_bit_0_1 ? ? H3 m0 m1) in H1.
- Rewrite <- (ad_div_2_double_plus_un a H3) in H2.
- Elim (H0 [a0:ad](pf (ad_double_plus_un a0)) (ad_div_2 a) y H1 H2). Intros a'' H4. Elim H4.
- Intros y'' H5. Simpl. Elim (option_sum ? (MapSweep1 [a:ad](pf (ad_double a)) m0)).
- Intro H6. Elim H6. Intro r. Elim r. Intros a''' y''' H7. Rewrite H7. Split with a'''.
- Split with y'''. Reflexivity.
- Intro H6. Rewrite H6. Split with a''. Split with y''. Assumption.
- Intro H3. Rewrite (MapGet_M2_bit_0_0 ? ? H3 m0 m1) in H1.
- Rewrite <- (ad_div_2_double a H3) in H2.
- Elim (H [a0:ad](pf (ad_double a0)) (ad_div_2 a) y H1 H2). Intros a'' H4. Elim H4.
- Intros y'' H5. Split with a''. Split with y''. Simpl. Rewrite H5. Reflexivity.
+ simple induction m. intros. discriminate H.
+ intros. elim (sumbool_of_bool (ad_eq a a1)). intro H1. split with (pf a1). split with y.
+ rewrite (ad_eq_complete _ _ H1). unfold MapSweep1, MapSweep2 in |- *.
+ rewrite (ad_eq_complete _ _ H1) in H. rewrite (M1_semantics_1 _ a1 a0) in H.
+ inversion H. rewrite H0. reflexivity.
+
+ intro H1. rewrite (M1_semantics_2 _ a a1 a0 H1) in H. discriminate H.
+
+ intros. elim (sumbool_of_bool (ad_bit_0 a)). intro H3.
+ rewrite (MapGet_M2_bit_0_1 _ _ H3 m0 m1) in H1.
+ rewrite <- (ad_div_2_double_plus_un a H3) in H2.
+ elim (H0 (fun a0:ad => pf (ad_double_plus_un a0)) (ad_div_2 a) y H1 H2). intros a'' H4. elim H4.
+ intros y'' H5. simpl in |- *. elim (option_sum _ (MapSweep1 (fun a:ad => pf (ad_double a)) m0)).
+ intro H6. elim H6. intro r. elim r. intros a''' y''' H7. rewrite H7. split with a'''.
+ split with y'''. reflexivity.
+ intro H6. rewrite H6. split with a''. split with y''. assumption.
+ intro H3. rewrite (MapGet_M2_bit_0_0 _ _ H3 m0 m1) in H1.
+ rewrite <- (ad_div_2_double a H3) in H2.
+ elim (H (fun a0:ad => pf (ad_double a0)) (ad_div_2 a) y H1 H2). intros a'' H4. elim H4.
+ intros y'' H5. split with a''. split with y''. simpl in |- *. rewrite H5. reflexivity.
Qed.
- Lemma MapSweep_semantics_4 : (m:(Map A)) (a:ad) (y:A)
- (MapGet A m a)=(SOME A y) -> (f a y)=true ->
- {a':ad & {y':A | (MapSweep m)=(SOME ? (a', y'))}}.
+ Lemma MapSweep_semantics_4 :
+ forall (m:Map A) (a:ad) (y:A),
+ MapGet A m a = SOME A y ->
+ f a y = true -> {a' : ad & {y' : A | MapSweep m = SOME _ (a', y')}}.
Proof.
- Intros. Exact (MapSweep_semantics_4_1 m [a0:ad]a0 a y H H0).
+ intros. exact (MapSweep_semantics_4_1 m (fun a0:ad => a0) a y H H0).
Qed.
End MapSweepDef.
Variable B : Set.
- Fixpoint MapCollect1 [f:ad->A->(Map B); pf:ad->ad; m:(Map A)] : (Map B) :=
- Cases m of
- M0 => (M0 B)
- | (M1 a y) => (f (pf a) y)
- | (M2 m1 m2) => (MapMerge B (MapCollect1 f [a0:ad] (pf (ad_double a0)) m1)
- (MapCollect1 f [a0:ad] (pf (ad_double_plus_un a0)) m2))
+ Fixpoint MapCollect1 (f:ad -> A -> Map B) (pf:ad -> ad)
+ (m:Map A) {struct m} : Map B :=
+ match m with
+ | M0 => M0 B
+ | M1 a y => f (pf a) y
+ | M2 m1 m2 =>
+ MapMerge B (MapCollect1 f (fun a0:ad => pf (ad_double a0)) m1)
+ (MapCollect1 f (fun a0:ad => pf (ad_double_plus_un a0)) m2)
end.
- Definition MapCollect := [f:ad->A->(Map B); m:(Map A)] (MapCollect1 f [a:ad]a m).
+ Definition MapCollect (f:ad -> A -> Map B) (m:Map A) :=
+ MapCollect1 f (fun a:ad => a) m.
Section MapFoldDef.
@@ -197,331 +225,396 @@ Section MapIter.
Variable neutral : M.
Variable op : M -> M -> M.
- Fixpoint MapFold1 [f:ad->A->M; pf:ad->ad; m:(Map A)] : M :=
- Cases m of
- M0 => neutral
- | (M1 a y) => (f (pf a) y)
- | (M2 m1 m2) => (op (MapFold1 f [a0:ad] (pf (ad_double a0)) m1)
- (MapFold1 f [a0:ad] (pf (ad_double_plus_un a0)) m2))
+ Fixpoint MapFold1 (f:ad -> A -> M) (pf:ad -> ad)
+ (m:Map A) {struct m} : M :=
+ match m with
+ | M0 => neutral
+ | M1 a y => f (pf a) y
+ | M2 m1 m2 =>
+ op (MapFold1 f (fun a0:ad => pf (ad_double a0)) m1)
+ (MapFold1 f (fun a0:ad => pf (ad_double_plus_un a0)) m2)
end.
- Definition MapFold := [f:ad->A->M; m:(Map A)] (MapFold1 f [a:ad]a m).
+ Definition MapFold (f:ad -> A -> M) (m:Map A) :=
+ MapFold1 f (fun a:ad => a) m.
- Lemma MapFold_empty : (f:ad->A->M) (MapFold f (M0 A))=neutral.
+ Lemma MapFold_empty : forall f:ad -> A -> M, MapFold f (M0 A) = neutral.
Proof.
- Trivial.
+ trivial.
Qed.
- Lemma MapFold_M1 : (f:ad->A->M) (a:ad) (y:A) (MapFold f (M1 A a y)) = (f a y).
+ Lemma MapFold_M1 :
+ forall (f:ad -> A -> M) (a:ad) (y:A), MapFold f (M1 A a y) = f a y.
Proof.
- Trivial.
+ trivial.
Qed.
Variable State : Set.
- Variable f:State -> ad -> A -> State * M.
-
- Fixpoint MapFold1_state [state:State; pf:ad->ad; m:(Map A)]
- : State * M :=
- Cases m of
- M0 => (state, neutral)
- | (M1 a y) => (f state (pf a) y)
- | (M2 m1 m2) =>
- Cases (MapFold1_state state [a0:ad] (pf (ad_double a0)) m1) of
- (state1, x1) =>
- Cases (MapFold1_state state1 [a0:ad] (pf (ad_double_plus_un a0)) m2) of
- (state2, x2) => (state2, (op x1 x2))
- end
+ Variable f : State -> ad -> A -> State * M.
+
+ Fixpoint MapFold1_state (state:State) (pf:ad -> ad)
+ (m:Map A) {struct m} : State * M :=
+ match m with
+ | M0 => (state, neutral)
+ | M1 a y => f state (pf a) y
+ | M2 m1 m2 =>
+ match MapFold1_state state (fun a0:ad => pf (ad_double a0)) m1 with
+ | (state1, x1) =>
+ match
+ MapFold1_state state1
+ (fun a0:ad => pf (ad_double_plus_un a0)) m2
+ with
+ | (state2, x2) => (state2, op x1 x2)
+ end
end
end.
- Definition MapFold_state := [state:State] (MapFold1_state state [a:ad]a).
+ Definition MapFold_state (state:State) :=
+ MapFold1_state state (fun a:ad => a).
- Lemma pair_sp : (B,C:Set) (x:B*C) x=(Fst x, Snd x).
+ Lemma pair_sp : forall (B C:Set) (x:B * C), x = (fst x, snd x).
Proof.
- Induction x. Trivial.
+ simple induction x. trivial.
Qed.
- Lemma MapFold_state_stateless_1 : (m:(Map A)) (g:ad->A->M) (pf:ad->ad)
- ((state:State) (a:ad) (y:A) (Snd (f state a y))=(g a y)) ->
- (state:State)
- (Snd (MapFold1_state state pf m))=(MapFold1 g pf m).
+ Lemma MapFold_state_stateless_1 :
+ forall (m:Map A) (g:ad -> A -> M) (pf:ad -> ad),
+ (forall (state:State) (a:ad) (y:A), snd (f state a y) = g a y) ->
+ forall state:State, snd (MapFold1_state state pf m) = MapFold1 g pf m.
Proof.
- Induction m. Trivial.
- Intros. Simpl. Apply H.
- Intros. Simpl. Rewrite (pair_sp ? ?
- (MapFold1_state state [a0:ad](pf (ad_double a0)) m0)).
- Rewrite (H g [a0:ad](pf (ad_double a0)) H1 state).
- Rewrite (pair_sp ? ?
+ simple induction m. trivial.
+ intros. simpl in |- *. apply H.
+ intros. simpl in |- *. rewrite
+ (pair_sp _ _ (MapFold1_state state (fun a0:ad => pf (ad_double a0)) m0))
+ .
+ rewrite (H g (fun a0:ad => pf (ad_double a0)) H1 state).
+ rewrite
+ (pair_sp _ _
(MapFold1_state
- (Fst (MapFold1_state state [a0:ad](pf (ad_double a0)) m0))
- [a0:ad](pf (ad_double_plus_un a0)) m1)).
- Simpl.
- Rewrite (H0 g [a0:ad](pf (ad_double_plus_un a0)) H1
- (Fst (MapFold1_state state [a0:ad](pf (ad_double a0)) m0))).
- Reflexivity.
+ (fst (MapFold1_state state (fun a0:ad => pf (ad_double a0)) m0))
+ (fun a0:ad => pf (ad_double_plus_un a0)) m1))
+ .
+ simpl in |- *.
+ rewrite
+ (H0 g (fun a0:ad => pf (ad_double_plus_un a0)) H1
+ (fst (MapFold1_state state (fun a0:ad => pf (ad_double a0)) m0)))
+ .
+ reflexivity.
Qed.
- Lemma MapFold_state_stateless : (g:ad->A->M)
- ((state:State) (a:ad) (y:A) (Snd (f state a y))=(g a y)) ->
- (state:State) (m:(Map A))
- (Snd (MapFold_state state m))=(MapFold g m).
+ Lemma MapFold_state_stateless :
+ forall g:ad -> A -> M,
+ (forall (state:State) (a:ad) (y:A), snd (f state a y) = g a y) ->
+ forall (state:State) (m:Map A),
+ snd (MapFold_state state m) = MapFold g m.
Proof.
- Intros. Exact (MapFold_state_stateless_1 m g [a0:ad]a0 H state).
+ intros. exact (MapFold_state_stateless_1 m g (fun a0:ad => a0) H state).
Qed.
End MapFoldDef.
- Lemma MapCollect_as_Fold : (f:ad->A->(Map B)) (m:(Map A))
- (MapCollect f m)=(MapFold (Map B) (M0 B) (MapMerge B) f m).
+ Lemma MapCollect_as_Fold :
+ forall (f:ad -> A -> Map B) (m:Map A),
+ MapCollect f m = MapFold (Map B) (M0 B) (MapMerge B) f m.
Proof.
- Induction m;Trivial.
+ simple induction m; trivial.
Qed.
- Definition alist := (list (ad*A)).
- Definition anil := (nil (ad*A)).
- Definition acons := (!cons (ad*A)).
- Definition aapp := (!app (ad*A)).
+ Definition alist := list (ad * A).
+ Definition anil := nil (A:=(ad * A)).
+ Definition acons := cons (A:=(ad * A)).
+ Definition aapp := app (A:=(ad * A)).
- Definition alist_of_Map := (MapFold alist anil aapp [a:ad;y:A] (acons (pair ? ? a y) anil)).
+ Definition alist_of_Map :=
+ MapFold alist anil aapp (fun (a:ad) (y:A) => acons (a, y) anil).
- Fixpoint alist_semantics [l:alist] : ad -> (option A) :=
- Cases l of
- nil => [_:ad] (NONE A)
- | (cons (a, y) l') => [a0:ad] if (ad_eq a a0) then (SOME A y) else (alist_semantics l' a0)
+ Fixpoint alist_semantics (l:alist) : ad -> option A :=
+ match l with
+ | nil => fun _:ad => NONE A
+ | (a, y) :: l' =>
+ fun a0:ad => if ad_eq a a0 then SOME A y else alist_semantics l' a0
end.
- Lemma alist_semantics_app : (l,l':alist) (a:ad)
- (alist_semantics (aapp l l') a)=
- (Cases (alist_semantics l a) of
- NONE => (alist_semantics l' a)
- | (SOME y) => (SOME A y)
- end).
+ Lemma alist_semantics_app :
+ forall (l l':alist) (a:ad),
+ alist_semantics (aapp l l') a =
+ match alist_semantics l a with
+ | NONE => alist_semantics l' a
+ | SOME y => SOME A y
+ end.
Proof.
- Unfold aapp. Induction l. Trivial.
- Intros. Elim a. Intros a1 y1. Simpl. Case (ad_eq a1 a0). Reflexivity.
- Apply H.
+ unfold aapp in |- *. simple induction l. trivial.
+ intros. elim a. intros a1 y1. simpl in |- *. case (ad_eq a1 a0). reflexivity.
+ apply H.
Qed.
- Lemma alist_of_Map_semantics_1_1 : (m:(Map A)) (pf:ad->ad) (a:ad) (y:A)
- (alist_semantics (MapFold1 alist anil aapp [a0:ad][y:A](acons (a0,y) anil) pf m) a)
- =(SOME A y) -> {a':ad | a=(pf a')}.
+ Lemma alist_of_Map_semantics_1_1 :
+ forall (m:Map A) (pf:ad -> ad) (a:ad) (y:A),
+ alist_semantics
+ (MapFold1 alist anil aapp (fun (a0:ad) (y:A) => acons (a0, y) anil) pf
+ m) a = SOME A y -> {a' : ad | a = pf a'}.
Proof.
- Induction m. Simpl. Intros. Discriminate H.
- Simpl. Intros a y pf a0 y0. Elim (sumbool_of_bool (ad_eq (pf a) a0)). Intro H. Rewrite H.
- Intro H0. Split with a. Rewrite (ad_eq_complete ? ? H). Reflexivity.
- Intro H. Rewrite H. Intro H0. Discriminate H0.
- Intros. Change (alist_semantics
- (aapp
- (MapFold1 alist anil aapp [a0:ad][y:A](acons (a0,y) anil)
- [a0:ad](pf (ad_double a0)) m0)
- (MapFold1 alist anil aapp [a0:ad][y:A](acons (a0,y) anil)
- [a0:ad](pf (ad_double_plus_un a0)) m1)) a)=(SOME A y) in H1.
- Rewrite (alist_semantics_app
- (MapFold1 alist anil aapp [a0:ad][y0:A](acons (a0,y0) anil)
- [a0:ad](pf (ad_double a0)) m0)
- (MapFold1 alist anil aapp [a0:ad][y0:A](acons (a0,y0) anil)
- [a0:ad](pf (ad_double_plus_un a0)) m1) a) in H1.
- Elim (option_sum A
- (alist_semantics
- (MapFold1 alist anil aapp [a0:ad][y0:A](acons (a0,y0) anil)
- [a0:ad](pf (ad_double a0)) m0) a)).
- Intro H2. Elim H2. Intros y0 H3. Elim (H [a0:ad](pf (ad_double a0)) a y0 H3). Intros a0 H4.
- Split with (ad_double a0). Assumption.
- Intro H2. Rewrite H2 in H1. Elim (H0 [a0:ad](pf (ad_double_plus_un a0)) a y H1).
- Intros a0 H3. Split with (ad_double_plus_un a0). Assumption.
+ simple induction m. simpl in |- *. intros. discriminate H.
+ simpl in |- *. intros a y pf a0 y0. elim (sumbool_of_bool (ad_eq (pf a) a0)). intro H. rewrite H.
+ intro H0. split with a. rewrite (ad_eq_complete _ _ H). reflexivity.
+ intro H. rewrite H. intro H0. discriminate H0.
+ intros. change
+ (alist_semantics
+ (aapp
+ (MapFold1 alist anil aapp (fun (a0:ad) (y:A) => acons (a0, y) anil)
+ (fun a0:ad => pf (ad_double a0)) m0)
+ (MapFold1 alist anil aapp (fun (a0:ad) (y:A) => acons (a0, y) anil)
+ (fun a0:ad => pf (ad_double_plus_un a0)) m1)) a =
+ SOME A y) in H1.
+ rewrite
+ (alist_semantics_app
+ (MapFold1 alist anil aapp (fun (a0:ad) (y0:A) => acons (a0, y0) anil)
+ (fun a0:ad => pf (ad_double a0)) m0)
+ (MapFold1 alist anil aapp (fun (a0:ad) (y0:A) => acons (a0, y0) anil)
+ (fun a0:ad => pf (ad_double_plus_un a0)) m1) a)
+ in H1.
+ elim
+ (option_sum A
+ (alist_semantics
+ (MapFold1 alist anil aapp
+ (fun (a0:ad) (y0:A) => acons (a0, y0) anil)
+ (fun a0:ad => pf (ad_double a0)) m0) a)).
+ intro H2. elim H2. intros y0 H3. elim (H (fun a0:ad => pf (ad_double a0)) a y0 H3). intros a0 H4.
+ split with (ad_double a0). assumption.
+ intro H2. rewrite H2 in H1. elim (H0 (fun a0:ad => pf (ad_double_plus_un a0)) a y H1).
+ intros a0 H3. split with (ad_double_plus_un a0). assumption.
Qed.
- Definition ad_inj := [pf:ad->ad] (a0,a1:ad) (pf a0)=(pf a1) -> a0=a1.
+ Definition ad_inj (pf:ad -> ad) :=
+ forall a0 a1:ad, pf a0 = pf a1 -> a0 = a1.
- Lemma ad_comp_double_inj :
- (pf:ad->ad) (ad_inj pf) -> (ad_inj [a0:ad] (pf (ad_double a0))).
+ Lemma ad_comp_double_inj :
+ forall pf:ad -> ad, ad_inj pf -> ad_inj (fun a0:ad => pf (ad_double a0)).
Proof.
- Unfold ad_inj. Intros. Apply ad_double_inj. Exact (H ? ? H0).
+ unfold ad_inj in |- *. intros. apply ad_double_inj. exact (H _ _ H0).
Qed.
- Lemma ad_comp_double_plus_un_inj : (pf:ad->ad) (ad_inj pf) ->
- (ad_inj [a0:ad] (pf (ad_double_plus_un a0))).
+ Lemma ad_comp_double_plus_un_inj :
+ forall pf:ad -> ad,
+ ad_inj pf -> ad_inj (fun a0:ad => pf (ad_double_plus_un a0)).
Proof.
- Unfold ad_inj. Intros. Apply ad_double_plus_un_inj. Exact (H ? ? H0).
+ unfold ad_inj in |- *. intros. apply ad_double_plus_un_inj. exact (H _ _ H0).
Qed.
- Lemma alist_of_Map_semantics_1 : (m:(Map A)) (pf:ad->ad) (ad_inj pf) ->
- (a:ad) (MapGet A m a)=(alist_semantics (MapFold1 alist anil aapp
- [a0:ad;y:A] (acons (pair ? ? a0 y) anil) pf m)
- (pf a)).
+ Lemma alist_of_Map_semantics_1 :
+ forall (m:Map A) (pf:ad -> ad),
+ ad_inj pf ->
+ forall a:ad,
+ MapGet A m a =
+ alist_semantics
+ (MapFold1 alist anil aapp (fun (a0:ad) (y:A) => acons (a0, y) anil)
+ pf m) (pf a).
Proof.
- Induction m. Trivial.
- Simpl. Intros. Elim (sumbool_of_bool (ad_eq a a1)). Intro H0. Rewrite H0.
- Rewrite (ad_eq_complete ? ? H0). Rewrite (ad_eq_correct (pf a1)). Reflexivity.
- Intro H0. Rewrite H0. Elim (sumbool_of_bool (ad_eq (pf a) (pf a1))). Intro H1.
- Rewrite (H a a1 (ad_eq_complete ? ? H1)) in H0. Rewrite (ad_eq_correct a1) in H0.
- Discriminate H0.
- Intro H1. Rewrite H1. Reflexivity.
- Intros. Change (MapGet A (M2 A m0 m1) a)
- =(alist_semantics
- (aapp
- (MapFold1 alist anil aapp [a0:ad][y:A](acons (a0,y) anil)
- [a0:ad](pf (ad_double a0)) m0)
- (MapFold1 alist anil aapp [a0:ad][y:A](acons (a0,y) anil)
- [a0:ad](pf (ad_double_plus_un a0)) m1)) (pf a)).
- Rewrite alist_semantics_app. Rewrite (MapGet_M2_bit_0_if A m0 m1 a).
- Elim (ad_double_or_double_plus_un a). Intro H2. Elim H2. Intros a0 H3. Rewrite H3.
- Rewrite (ad_double_bit_0 a0).
- Rewrite <- (H [a1:ad](pf (ad_double a1)) (ad_comp_double_inj pf H1) a0).
- Rewrite ad_double_div_2. Case (MapGet A m0 a0).
- Elim (option_sum A
- (alist_semantics
- (MapFold1 alist anil aapp [a1:ad][y:A](acons (a1,y) anil)
- [a1:ad](pf (ad_double_plus_un a1)) m1) (pf (ad_double a0)))).
- Intro H4. Elim H4. Intros y H5.
- Elim (alist_of_Map_semantics_1_1 m1 [a1:ad](pf (ad_double_plus_un a1))
- (pf (ad_double a0)) y H5).
- Intros a1 H6. Cut (ad_bit_0 (ad_double a0))=(ad_bit_0 (ad_double_plus_un a1)).
- Intro. Rewrite (ad_double_bit_0 a0) in H7. Rewrite (ad_double_plus_un_bit_0 a1) in H7.
- Discriminate H7.
- Rewrite (H1 (ad_double a0) (ad_double_plus_un a1) H6). Reflexivity.
- Intro H4. Rewrite H4. Reflexivity.
- Trivial.
- Intro H2. Elim H2. Intros a0 H3. Rewrite H3. Rewrite (ad_double_plus_un_bit_0 a0).
- Rewrite <- (H0 [a1:ad](pf (ad_double_plus_un a1)) (ad_comp_double_plus_un_inj pf H1) a0).
- Rewrite ad_double_plus_un_div_2.
- Elim (option_sum A
- (alist_semantics
- (MapFold1 alist anil aapp [a1:ad][y:A](acons (a1,y) anil)
- [a1:ad](pf (ad_double a1)) m0) (pf (ad_double_plus_un a0)))).
- Intro H4. Elim H4. Intros y H5.
- Elim (alist_of_Map_semantics_1_1 m0 [a1:ad](pf (ad_double a1))
- (pf (ad_double_plus_un a0)) y H5).
- Intros a1 H6. Cut (ad_bit_0 (ad_double_plus_un a0))=(ad_bit_0 (ad_double a1)).
- Intro H7. Rewrite (ad_double_plus_un_bit_0 a0) in H7. Rewrite (ad_double_bit_0 a1) in H7.
- Discriminate H7.
- Rewrite (H1 (ad_double_plus_un a0) (ad_double a1) H6). Reflexivity.
- Intro H4. Rewrite H4. Reflexivity.
+ simple induction m. trivial.
+ simpl in |- *. intros. elim (sumbool_of_bool (ad_eq a a1)). intro H0. rewrite H0.
+ rewrite (ad_eq_complete _ _ H0). rewrite (ad_eq_correct (pf a1)). reflexivity.
+ intro H0. rewrite H0. elim (sumbool_of_bool (ad_eq (pf a) (pf a1))). intro H1.
+ rewrite (H a a1 (ad_eq_complete _ _ H1)) in H0. rewrite (ad_eq_correct a1) in H0.
+ discriminate H0.
+ intro H1. rewrite H1. reflexivity.
+ intros. change
+ (MapGet A (M2 A m0 m1) a =
+ alist_semantics
+ (aapp
+ (MapFold1 alist anil aapp (fun (a0:ad) (y:A) => acons (a0, y) anil)
+ (fun a0:ad => pf (ad_double a0)) m0)
+ (MapFold1 alist anil aapp (fun (a0:ad) (y:A) => acons (a0, y) anil)
+ (fun a0:ad => pf (ad_double_plus_un a0)) m1)) (
+ pf a)) in |- *.
+ rewrite alist_semantics_app. rewrite (MapGet_M2_bit_0_if A m0 m1 a).
+ elim (ad_double_or_double_plus_un a). intro H2. elim H2. intros a0 H3. rewrite H3.
+ rewrite (ad_double_bit_0 a0).
+ rewrite <-
+ (H (fun a1:ad => pf (ad_double a1)) (ad_comp_double_inj pf H1) a0)
+ .
+ rewrite ad_double_div_2. case (MapGet A m0 a0).
+ elim
+ (option_sum A
+ (alist_semantics
+ (MapFold1 alist anil aapp
+ (fun (a1:ad) (y:A) => acons (a1, y) anil)
+ (fun a1:ad => pf (ad_double_plus_un a1)) m1)
+ (pf (ad_double a0)))).
+ intro H4. elim H4. intros y H5.
+ elim
+ (alist_of_Map_semantics_1_1 m1 (fun a1:ad => pf (ad_double_plus_un a1))
+ (pf (ad_double a0)) y H5).
+ intros a1 H6. cut (ad_bit_0 (ad_double a0) = ad_bit_0 (ad_double_plus_un a1)).
+ intro. rewrite (ad_double_bit_0 a0) in H7. rewrite (ad_double_plus_un_bit_0 a1) in H7.
+ discriminate H7.
+ rewrite (H1 (ad_double a0) (ad_double_plus_un a1) H6). reflexivity.
+ intro H4. rewrite H4. reflexivity.
+ trivial.
+ intro H2. elim H2. intros a0 H3. rewrite H3. rewrite (ad_double_plus_un_bit_0 a0).
+ rewrite <-
+ (H0 (fun a1:ad => pf (ad_double_plus_un a1))
+ (ad_comp_double_plus_un_inj pf H1) a0).
+ rewrite ad_double_plus_un_div_2.
+ elim
+ (option_sum A
+ (alist_semantics
+ (MapFold1 alist anil aapp
+ (fun (a1:ad) (y:A) => acons (a1, y) anil)
+ (fun a1:ad => pf (ad_double a1)) m0)
+ (pf (ad_double_plus_un a0)))).
+ intro H4. elim H4. intros y H5.
+ elim
+ (alist_of_Map_semantics_1_1 m0 (fun a1:ad => pf (ad_double a1))
+ (pf (ad_double_plus_un a0)) y H5).
+ intros a1 H6. cut (ad_bit_0 (ad_double_plus_un a0) = ad_bit_0 (ad_double a1)).
+ intro H7. rewrite (ad_double_plus_un_bit_0 a0) in H7. rewrite (ad_double_bit_0 a1) in H7.
+ discriminate H7.
+ rewrite (H1 (ad_double_plus_un a0) (ad_double a1) H6). reflexivity.
+ intro H4. rewrite H4. reflexivity.
Qed.
- Lemma alist_of_Map_semantics : (m:(Map A))
- (eqm A (MapGet A m) (alist_semantics (alist_of_Map m))).
+ Lemma alist_of_Map_semantics :
+ forall m:Map A, eqm A (MapGet A m) (alist_semantics (alist_of_Map m)).
Proof.
- Unfold eqm. Intros. Exact (alist_of_Map_semantics_1 m [a0:ad]a0 [a0,a1:ad][p:a0=a1]p a).
+ unfold eqm in |- *. intros. exact
+ (alist_of_Map_semantics_1 m (fun a0:ad => a0)
+ (fun (a0 a1:ad) (p:a0 = a1) => p) a).
Qed.
- Fixpoint Map_of_alist [l:alist] : (Map A) :=
- Cases l of
- nil => (M0 A)
- | (cons (a, y) l') => (MapPut A (Map_of_alist l') a y)
+ Fixpoint Map_of_alist (l:alist) : Map A :=
+ match l with
+ | nil => M0 A
+ | (a, y) :: l' => MapPut A (Map_of_alist l') a y
end.
- Lemma Map_of_alist_semantics : (l:alist)
- (eqm A (alist_semantics l) (MapGet A (Map_of_alist l))).
+ Lemma Map_of_alist_semantics :
+ forall l:alist, eqm A (alist_semantics l) (MapGet A (Map_of_alist l)).
Proof.
- Unfold eqm. Induction l. Trivial.
- Intros r l0 H a. Elim r. Intros a0 y0. Simpl. Elim (sumbool_of_bool (ad_eq a0 a)).
- Intro H0. Rewrite H0. Rewrite (ad_eq_complete ? ? H0).
- Rewrite (MapPut_semantics A (Map_of_alist l0) a y0 a). Rewrite (ad_eq_correct a).
- Reflexivity.
- Intro H0. Rewrite H0. Rewrite (MapPut_semantics A (Map_of_alist l0) a0 y0 a).
- Rewrite H0. Apply H.
+ unfold eqm in |- *. simple induction l. trivial.
+ intros r l0 H a. elim r. intros a0 y0. simpl in |- *. elim (sumbool_of_bool (ad_eq a0 a)).
+ intro H0. rewrite H0. rewrite (ad_eq_complete _ _ H0).
+ rewrite (MapPut_semantics A (Map_of_alist l0) a y0 a). rewrite (ad_eq_correct a).
+ reflexivity.
+ intro H0. rewrite H0. rewrite (MapPut_semantics A (Map_of_alist l0) a0 y0 a).
+ rewrite H0. apply H.
Qed.
- Lemma Map_of_alist_of_Map : (m:(Map A)) (eqmap A (Map_of_alist (alist_of_Map m)) m).
+ Lemma Map_of_alist_of_Map :
+ forall m:Map A, eqmap A (Map_of_alist (alist_of_Map m)) m.
Proof.
- Unfold eqmap. Intro. Apply eqm_trans with f':=(alist_semantics (alist_of_Map m)).
- Apply eqm_sym. Apply Map_of_alist_semantics.
- Apply eqm_sym. Apply alist_of_Map_semantics.
+ unfold eqmap in |- *. intro. apply eqm_trans with (f' := alist_semantics (alist_of_Map m)).
+ apply eqm_sym. apply Map_of_alist_semantics.
+ apply eqm_sym. apply alist_of_Map_semantics.
Qed.
- Lemma alist_of_Map_of_alist : (l:alist)
- (eqm A (alist_semantics (alist_of_Map (Map_of_alist l))) (alist_semantics l)).
+ Lemma alist_of_Map_of_alist :
+ forall l:alist,
+ eqm A (alist_semantics (alist_of_Map (Map_of_alist l)))
+ (alist_semantics l).
Proof.
- Intro. Apply eqm_trans with f':=(MapGet A (Map_of_alist l)).
- Apply eqm_sym. Apply alist_of_Map_semantics.
- Apply eqm_sym. Apply Map_of_alist_semantics.
+ intro. apply eqm_trans with (f' := MapGet A (Map_of_alist l)).
+ apply eqm_sym. apply alist_of_Map_semantics.
+ apply eqm_sym. apply Map_of_alist_semantics.
Qed.
- Lemma fold_right_aapp : (M:Set) (neutral:M) (op:M->M->M)
- ((a,b,c:M) (op (op a b) c)=(op a (op b c))) ->
- ((a:M) (op neutral a)=a) ->
- (f:ad->A->M) (l,l':alist)
- (fold_right [r:ad*A][m:M] let (a,y)=r in (op (f a y) m) neutral
- (aapp l l'))=
- (op (fold_right [r:ad*A][m:M] let (a,y)=r in (op (f a y) m) neutral l)
- (fold_right [r:ad*A][m:M] let (a,y)=r in (op (f a y) m) neutral l'))
-.
+ Lemma fold_right_aapp :
+ forall (M:Set) (neutral:M) (op:M -> M -> M),
+ (forall a b c:M, op (op a b) c = op a (op b c)) ->
+ (forall a:M, op neutral a = a) ->
+ forall (f:ad -> A -> M) (l l':alist),
+ fold_right (fun (r:ad * A) (m:M) => let (a, y) := r in op (f a y) m)
+ neutral (aapp l l') =
+ op
+ (fold_right
+ (fun (r:ad * A) (m:M) => let (a, y) := r in op (f a y) m) neutral
+ l)
+ (fold_right
+ (fun (r:ad * A) (m:M) => let (a, y) := r in op (f a y) m) neutral
+ l').
Proof.
- Induction l. Simpl. Intro. Rewrite H0. Reflexivity.
- Intros r l0 H1 l'. Elim r. Intros a y. Simpl. Rewrite H. Rewrite (H1 l'). Reflexivity.
+ simple induction l. simpl in |- *. intro. rewrite H0. reflexivity.
+ intros r l0 H1 l'. elim r. intros a y. simpl in |- *. rewrite H. rewrite (H1 l'). reflexivity.
Qed.
- Lemma MapFold_as_fold_1 : (M:Set) (neutral:M) (op:M->M->M)
- ((a,b,c:M) (op (op a b) c)=(op a (op b c))) ->
- ((a:M) (op neutral a)=a) ->
- ((a:M) (op a neutral)=a) ->
- (f:ad->A->M) (m:(Map A)) (pf:ad->ad)
- (MapFold1 M neutral op f pf m)=
- (fold_right [r:(ad*A)][m:M] let (a,y)=r in (op (f a y) m) neutral
- (MapFold1 alist anil aapp [a:ad;y:A] (acons (pair ? ?
-a y) anil) pf m)).
+ Lemma MapFold_as_fold_1 :
+ forall (M:Set) (neutral:M) (op:M -> M -> M),
+ (forall a b c:M, op (op a b) c = op a (op b c)) ->
+ (forall a:M, op neutral a = a) ->
+ (forall a:M, op a neutral = a) ->
+ forall (f:ad -> A -> M) (m:Map A) (pf:ad -> ad),
+ MapFold1 M neutral op f pf m =
+ fold_right (fun (r:ad * A) (m:M) => let (a, y) := r in op (f a y) m)
+ neutral
+ (MapFold1 alist anil aapp (fun (a:ad) (y:A) => acons (a, y) anil) pf
+ m).
Proof.
- Induction m. Trivial.
- Intros. Simpl. Rewrite H1. Reflexivity.
- Intros. Simpl. Rewrite (fold_right_aapp M neutral op H H0 f).
- Rewrite (H2 [a0:ad](pf (ad_double a0))). Rewrite (H3 [a0:ad](pf (ad_double_plus_un a0))).
- Reflexivity.
+ simple induction m. trivial.
+ intros. simpl in |- *. rewrite H1. reflexivity.
+ intros. simpl in |- *. rewrite (fold_right_aapp M neutral op H H0 f).
+ rewrite (H2 (fun a0:ad => pf (ad_double a0))). rewrite (H3 (fun a0:ad => pf (ad_double_plus_un a0))).
+ reflexivity.
Qed.
- Lemma MapFold_as_fold : (M:Set) (neutral:M) (op:M->M->M)
- ((a,b,c:M) (op (op a b) c)=(op a (op b c))) ->
- ((a:M) (op neutral a)=a) ->
- ((a:M) (op a neutral)=a) ->
- (f:ad->A->M) (m:(Map A))
- (MapFold M neutral op f m)=
- (fold_right [r:(ad*A)][m:M] let (a,y)=r in (op (f a y) m) neutral
- (alist_of_Map m)).
+ Lemma MapFold_as_fold :
+ forall (M:Set) (neutral:M) (op:M -> M -> M),
+ (forall a b c:M, op (op a b) c = op a (op b c)) ->
+ (forall a:M, op neutral a = a) ->
+ (forall a:M, op a neutral = a) ->
+ forall (f:ad -> A -> M) (m:Map A),
+ MapFold M neutral op f m =
+ fold_right (fun (r:ad * A) (m:M) => let (a, y) := r in op (f a y) m)
+ neutral (alist_of_Map m).
Proof.
- Intros. Exact (MapFold_as_fold_1 M neutral op H H0 H1 f m [a0:ad]a0).
+ intros. exact (MapFold_as_fold_1 M neutral op H H0 H1 f m (fun a0:ad => a0)).
Qed.
- Lemma alist_MapMerge_semantics : (m,m':(Map A))
- (eqm A (alist_semantics (aapp (alist_of_Map m') (alist_of_Map m)))
- (alist_semantics (alist_of_Map (MapMerge A m m')))).
+ Lemma alist_MapMerge_semantics :
+ forall m m':Map A,
+ eqm A (alist_semantics (aapp (alist_of_Map m') (alist_of_Map m)))
+ (alist_semantics (alist_of_Map (MapMerge A m m'))).
Proof.
- Unfold eqm. Intros. Rewrite alist_semantics_app. Rewrite <- (alist_of_Map_semantics m a).
- Rewrite <- (alist_of_Map_semantics m' a).
- Rewrite <- (alist_of_Map_semantics (MapMerge A m m') a).
- Rewrite (MapMerge_semantics A m m' a). Reflexivity.
+ unfold eqm in |- *. intros. rewrite alist_semantics_app. rewrite <- (alist_of_Map_semantics m a).
+ rewrite <- (alist_of_Map_semantics m' a).
+ rewrite <- (alist_of_Map_semantics (MapMerge A m m') a).
+ rewrite (MapMerge_semantics A m m' a). reflexivity.
Qed.
- Lemma alist_MapMerge_semantics_disjoint : (m,m':(Map A))
- (eqmap A (MapDomRestrTo A A m m') (M0 A)) ->
- (eqm A (alist_semantics (aapp (alist_of_Map m) (alist_of_Map m')))
- (alist_semantics (alist_of_Map (MapMerge A m m')))).
+ Lemma alist_MapMerge_semantics_disjoint :
+ forall m m':Map A,
+ eqmap A (MapDomRestrTo A A m m') (M0 A) ->
+ eqm A (alist_semantics (aapp (alist_of_Map m) (alist_of_Map m')))
+ (alist_semantics (alist_of_Map (MapMerge A m m'))).
Proof.
- Unfold eqm. Intros. Rewrite alist_semantics_app. Rewrite <- (alist_of_Map_semantics m a).
- Rewrite <- (alist_of_Map_semantics m' a).
- Rewrite <- (alist_of_Map_semantics (MapMerge A m m') a). Rewrite (MapMerge_semantics A m m' a).
- Elim (option_sum ? (MapGet A m a)). Intro H0. Elim H0. Intros y H1. Rewrite H1.
- Elim (option_sum ? (MapGet A m' a)). Intro H2. Elim H2. Intros y' H3.
- Cut (MapGet A (MapDomRestrTo A A m m') a)=(NONE A).
- Rewrite (MapDomRestrTo_semantics A A m m' a). Rewrite H3. Rewrite H1. Intro. Discriminate H4.
- Exact (H a).
- Intro H2. Rewrite H2. Reflexivity.
- Intro H0. Rewrite H0. Case (MapGet A m' a); Trivial.
+ unfold eqm in |- *. intros. rewrite alist_semantics_app. rewrite <- (alist_of_Map_semantics m a).
+ rewrite <- (alist_of_Map_semantics m' a).
+ rewrite <- (alist_of_Map_semantics (MapMerge A m m') a). rewrite (MapMerge_semantics A m m' a).
+ elim (option_sum _ (MapGet A m a)). intro H0. elim H0. intros y H1. rewrite H1.
+ elim (option_sum _ (MapGet A m' a)). intro H2. elim H2. intros y' H3.
+ cut (MapGet A (MapDomRestrTo A A m m') a = NONE A).
+ rewrite (MapDomRestrTo_semantics A A m m' a). rewrite H3. rewrite H1. intro. discriminate H4.
+ exact (H a).
+ intro H2. rewrite H2. reflexivity.
+ intro H0. rewrite H0. case (MapGet A m' a); trivial.
Qed.
- Lemma alist_semantics_disjoint_comm : (l,l':alist)
- (eqmap A (MapDomRestrTo A A (Map_of_alist l) (Map_of_alist l')) (M0 A)) ->
- (eqm A (alist_semantics (aapp l l')) (alist_semantics (aapp l' l))).
+ Lemma alist_semantics_disjoint_comm :
+ forall l l':alist,
+ eqmap A (MapDomRestrTo A A (Map_of_alist l) (Map_of_alist l')) (M0 A) ->
+ eqm A (alist_semantics (aapp l l')) (alist_semantics (aapp l' l)).
Proof.
- Unfold eqm. Intros. Rewrite (alist_semantics_app l l' a). Rewrite (alist_semantics_app l' l a).
- Rewrite <- (alist_of_Map_of_alist l a). Rewrite <- (alist_of_Map_of_alist l' a).
- Rewrite <- (alist_semantics_app (alist_of_Map (Map_of_alist l))
- (alist_of_Map (Map_of_alist l')) a).
- Rewrite <- (alist_semantics_app (alist_of_Map (Map_of_alist l'))
- (alist_of_Map (Map_of_alist l)) a).
- Rewrite (alist_MapMerge_semantics (Map_of_alist l) (Map_of_alist l') a).
- Rewrite (alist_MapMerge_semantics_disjoint (Map_of_alist l) (Map_of_alist l') H a).
- Reflexivity.
+ unfold eqm in |- *. intros. rewrite (alist_semantics_app l l' a). rewrite (alist_semantics_app l' l a).
+ rewrite <- (alist_of_Map_of_alist l a). rewrite <- (alist_of_Map_of_alist l' a).
+ rewrite <-
+ (alist_semantics_app (alist_of_Map (Map_of_alist l))
+ (alist_of_Map (Map_of_alist l')) a).
+ rewrite <-
+ (alist_semantics_app (alist_of_Map (Map_of_alist l'))
+ (alist_of_Map (Map_of_alist l)) a).
+ rewrite (alist_MapMerge_semantics (Map_of_alist l) (Map_of_alist l') a).
+ rewrite
+ (alist_MapMerge_semantics_disjoint (Map_of_alist l) (
+ Map_of_alist l') H a).
+ reflexivity.
Qed.
End MapIter.
-
diff --git a/theories/IntMap/Maplists.v b/theories/IntMap/Maplists.v
index 6e5e40814..bcb87179c 100644
--- a/theories/IntMap/Maplists.v
+++ b/theories/IntMap/Maplists.v
@@ -7,304 +7,334 @@
(***********************************************************************)
(*i $Id$ i*)
-Require Addr.
-Require Addec.
-Require Map.
-Require Fset.
-Require Mapaxioms.
-Require Mapsubset.
-Require Mapcard.
-Require Mapcanon.
-Require Mapc.
-Require Bool.
-Require Sumbool.
-Require PolyList.
-Require Arith.
-Require Mapiter.
-Require Mapfold.
+Require Import Addr.
+Require Import Addec.
+Require Import Map.
+Require Import Fset.
+Require Import Mapaxioms.
+Require Import Mapsubset.
+Require Import Mapcard.
+Require Import Mapcanon.
+Require Import Mapc.
+Require Import Bool.
+Require Import Sumbool.
+Require Import List.
+Require Import Arith.
+Require Import Mapiter.
+Require Import Mapfold.
Section MapLists.
- Fixpoint ad_in_list [a:ad;l:(list ad)] : bool :=
- Cases l of
- nil => false
- | (cons a' l') => (orb (ad_eq a a') (ad_in_list a l'))
+ Fixpoint ad_in_list (a:ad) (l:list ad) {struct l} : bool :=
+ match l with
+ | nil => false
+ | a' :: l' => orb (ad_eq a a') (ad_in_list a l')
end.
- Fixpoint ad_list_stutters [l:(list ad)] : bool :=
- Cases l of
- nil => false
- | (cons a l') => (orb (ad_in_list a l') (ad_list_stutters l'))
+ Fixpoint ad_list_stutters (l:list ad) : bool :=
+ match l with
+ | nil => false
+ | a :: l' => orb (ad_in_list a l') (ad_list_stutters l')
end.
- Lemma ad_in_list_forms_circuit : (x:ad) (l:(list ad)) (ad_in_list x l)=true ->
- {l1 : (list ad) & {l2 : (list ad) | l=(app l1 (cons x l2))}}.
- Proof.
- Induction l. Intro. Discriminate H.
- Intros. Elim (sumbool_of_bool (ad_eq x a)). Intro H1. Simpl in H0. Split with (nil ad).
- Split with l0. Rewrite (ad_eq_complete ? ? H1). Reflexivity.
- Intro H2. Simpl in H0. Rewrite H2 in H0. Simpl in H0. Elim (H H0). Intros l'1 H3.
- Split with (cons a l'1). Elim H3. Intros l2 H4. Split with l2. Rewrite H4. Reflexivity.
- Qed.
-
- Lemma ad_list_stutters_has_circuit : (l:(list ad)) (ad_list_stutters l)=true ->
- {x:ad & {l0 : (list ad) & {l1 : (list ad) & {l2 : (list ad) |
- l=(app l0 (cons x (app l1 (cons x l2))))}}}}.
- Proof.
- Induction l. Intro. Discriminate H.
- Intros. Simpl in H0. Elim (orb_true_elim ? ? H0). Intro H1. Split with a.
- Split with (nil ad). Simpl. Elim (ad_in_list_forms_circuit a l0 H1). Intros l1 H2.
- Split with l1. Elim H2. Intros l2 H3. Split with l2. Rewrite H3. Reflexivity.
- Intro H1. Elim (H H1). Intros x H2. Split with x. Elim H2. Intros l1 H3.
- Split with (cons a l1). Elim H3. Intros l2 H4. Split with l2. Elim H4. Intros l3 H5.
- Split with l3. Rewrite H5. Reflexivity.
- Qed.
-
- Fixpoint Elems [l:(list ad)] : FSet :=
- Cases l of
- nil => (M0 unit)
- | (cons a l') => (MapPut ? (Elems l') a tt)
+ Lemma ad_in_list_forms_circuit :
+ forall (x:ad) (l:list ad),
+ ad_in_list x l = true ->
+ {l1 : list ad & {l2 : list ad | l = l1 ++ x :: l2}}.
+ Proof.
+ simple induction l. intro. discriminate H.
+ intros. elim (sumbool_of_bool (ad_eq x a)). intro H1. simpl in H0. split with (nil (A:=ad)).
+ split with l0. rewrite (ad_eq_complete _ _ H1). reflexivity.
+ intro H2. simpl in H0. rewrite H2 in H0. simpl in H0. elim (H H0). intros l'1 H3.
+ split with (a :: l'1). elim H3. intros l2 H4. split with l2. rewrite H4. reflexivity.
+ Qed.
+
+ Lemma ad_list_stutters_has_circuit :
+ forall l:list ad,
+ ad_list_stutters l = true ->
+ {x : ad &
+ {l0 : list ad &
+ {l1 : list ad & {l2 : list ad | l = l0 ++ x :: l1 ++ x :: l2}}}}.
+ Proof.
+ simple induction l. intro. discriminate H.
+ intros. simpl in H0. elim (orb_true_elim _ _ H0). intro H1. split with a.
+ split with (nil (A:=ad)). simpl in |- *. elim (ad_in_list_forms_circuit a l0 H1). intros l1 H2.
+ split with l1. elim H2. intros l2 H3. split with l2. rewrite H3. reflexivity.
+ intro H1. elim (H H1). intros x H2. split with x. elim H2. intros l1 H3.
+ split with (a :: l1). elim H3. intros l2 H4. split with l2. elim H4. intros l3 H5.
+ split with l3. rewrite H5. reflexivity.
+ Qed.
+
+ Fixpoint Elems (l:list ad) : FSet :=
+ match l with
+ | nil => M0 unit
+ | a :: l' => MapPut _ (Elems l') a tt
end.
- Lemma Elems_canon : (l:(list ad)) (mapcanon ? (Elems l)).
+ Lemma Elems_canon : forall l:list ad, mapcanon _ (Elems l).
Proof.
- Induction l. Exact (M0_canon unit).
- Intros. Simpl. Apply MapPut_canon. Assumption.
+ simple induction l. exact (M0_canon unit).
+ intros. simpl in |- *. apply MapPut_canon. assumption.
Qed.
- Lemma Elems_app : (l,l':(list ad)) (Elems (app l l'))=(FSetUnion (Elems l) (Elems l')).
+ Lemma Elems_app :
+ forall l l':list ad, Elems (l ++ l') = FSetUnion (Elems l) (Elems l').
Proof.
- Induction l. Trivial.
- Intros. Simpl. Rewrite (MapPut_as_Merge_c unit (Elems l0)).
- Rewrite (MapPut_as_Merge_c unit (Elems (app l0 l'))).
- Change (FSetUnion (Elems (app l0 l')) (M1 unit a tt))
- =(FSetUnion (FSetUnion (Elems l0) (M1 unit a tt)) (Elems l')).
- Rewrite FSetUnion_comm_c. Rewrite (FSetUnion_comm_c (Elems l0) (M1 unit a tt)).
- Rewrite FSetUnion_assoc_c. Rewrite (H l'). Reflexivity.
- Apply M1_canon.
- Apply Elems_canon.
- Apply Elems_canon.
- Apply Elems_canon.
- Apply M1_canon.
- Apply Elems_canon.
- Apply M1_canon.
- Apply Elems_canon.
- Apply Elems_canon.
+ simple induction l. trivial.
+ intros. simpl in |- *. rewrite (MapPut_as_Merge_c unit (Elems l0)).
+ rewrite (MapPut_as_Merge_c unit (Elems (l0 ++ l'))).
+ change
+ (FSetUnion (Elems (l0 ++ l')) (M1 unit a tt) =
+ FSetUnion (FSetUnion (Elems l0) (M1 unit a tt)) (Elems l'))
+ in |- *.
+ rewrite FSetUnion_comm_c. rewrite (FSetUnion_comm_c (Elems l0) (M1 unit a tt)).
+ rewrite FSetUnion_assoc_c. rewrite (H l'). reflexivity.
+ apply M1_canon.
+ apply Elems_canon.
+ apply Elems_canon.
+ apply Elems_canon.
+ apply M1_canon.
+ apply Elems_canon.
+ apply M1_canon.
+ apply Elems_canon.
+ apply Elems_canon.
Qed.
- Lemma Elems_rev : (l:(list ad)) (Elems (rev l))=(Elems l).
+ Lemma Elems_rev : forall l:list ad, Elems (rev l) = Elems l.
Proof.
- Induction l. Trivial.
- Intros. Simpl. Rewrite Elems_app. Simpl. Rewrite (MapPut_as_Merge_c unit (Elems l0)).
- Rewrite H. Reflexivity.
- Apply Elems_canon.
+ simple induction l. trivial.
+ intros. simpl in |- *. rewrite Elems_app. simpl in |- *. rewrite (MapPut_as_Merge_c unit (Elems l0)).
+ rewrite H. reflexivity.
+ apply Elems_canon.
Qed.
- Lemma ad_in_elems_in_list : (l:(list ad)) (a:ad) (in_FSet a (Elems l))=(ad_in_list a l).
+ Lemma ad_in_elems_in_list :
+ forall (l:list ad) (a:ad), in_FSet a (Elems l) = ad_in_list a l.
Proof.
- Induction l. Trivial.
- Simpl. Unfold in_FSet. Intros. Rewrite (in_dom_put ? (Elems l0) a tt a0).
- Rewrite (H a0). Reflexivity.
+ simple induction l. trivial.
+ simpl in |- *. unfold in_FSet in |- *. intros. rewrite (in_dom_put _ (Elems l0) a tt a0).
+ rewrite (H a0). reflexivity.
Qed.
- Lemma ad_list_not_stutters_card : (l:(list ad)) (ad_list_stutters l)=false ->
- (length l)=(MapCard ? (Elems l)).
+ Lemma ad_list_not_stutters_card :
+ forall l:list ad,
+ ad_list_stutters l = false -> length l = MapCard _ (Elems l).
Proof.
- Induction l. Trivial.
- Simpl. Intros. Rewrite MapCard_Put_2_conv. Rewrite H. Reflexivity.
- Elim (orb_false_elim ? ? H0). Trivial.
- Elim (sumbool_of_bool (in_FSet a (Elems l0))). Rewrite ad_in_elems_in_list.
- Intro H1. Rewrite H1 in H0. Discriminate H0.
- Exact (in_dom_none unit (Elems l0) a).
+ simple induction l. trivial.
+ simpl in |- *. intros. rewrite MapCard_Put_2_conv. rewrite H. reflexivity.
+ elim (orb_false_elim _ _ H0). trivial.
+ elim (sumbool_of_bool (in_FSet a (Elems l0))). rewrite ad_in_elems_in_list.
+ intro H1. rewrite H1 in H0. discriminate H0.
+ exact (in_dom_none unit (Elems l0) a).
Qed.
- Lemma ad_list_card : (l:(list ad)) (le (MapCard ? (Elems l)) (length l)).
+ Lemma ad_list_card : forall l:list ad, MapCard _ (Elems l) <= length l.
Proof.
- Induction l. Trivial.
- Intros. Simpl. Apply le_trans with m:=(S (MapCard ? (Elems l0))). Apply MapCard_Put_ub.
- Apply le_n_S. Assumption.
+ simple induction l. trivial.
+ intros. simpl in |- *. apply le_trans with (m := S (MapCard _ (Elems l0))). apply MapCard_Put_ub.
+ apply le_n_S. assumption.
Qed.
- Lemma ad_list_stutters_card : (l:(list ad)) (ad_list_stutters l)=true ->
- (lt (MapCard ? (Elems l)) (length l)).
+ Lemma ad_list_stutters_card :
+ forall l:list ad,
+ ad_list_stutters l = true -> MapCard _ (Elems l) < length l.
Proof.
- Induction l. Intro. Discriminate H.
- Intros. Simpl. Simpl in H0. Elim (orb_true_elim ? ? H0). Intro H1.
- Rewrite <- (ad_in_elems_in_list l0 a) in H1. Elim (in_dom_some ? ? ? H1). Intros y H2.
- Rewrite (MapCard_Put_1_conv ? ? ? ? tt H2). Apply le_lt_trans with m:=(length l0).
- Apply ad_list_card.
- Apply lt_n_Sn.
- Intro H1. Apply le_lt_trans with m:=(S (MapCard ? (Elems l0))). Apply MapCard_Put_ub.
- Apply lt_n_S. Apply H. Assumption.
+ simple induction l. intro. discriminate H.
+ intros. simpl in |- *. simpl in H0. elim (orb_true_elim _ _ H0). intro H1.
+ rewrite <- (ad_in_elems_in_list l0 a) in H1. elim (in_dom_some _ _ _ H1). intros y H2.
+ rewrite (MapCard_Put_1_conv _ _ _ _ tt H2). apply le_lt_trans with (m := length l0).
+ apply ad_list_card.
+ apply lt_n_Sn.
+ intro H1. apply le_lt_trans with (m := S (MapCard _ (Elems l0))). apply MapCard_Put_ub.
+ apply lt_n_S. apply H. assumption.
Qed.
- Lemma ad_list_not_stutters_card_conv : (l:(list ad)) (length l)=(MapCard ? (Elems l)) ->
- (ad_list_stutters l)=false.
+ Lemma ad_list_not_stutters_card_conv :
+ forall l:list ad,
+ length l = MapCard _ (Elems l) -> ad_list_stutters l = false.
Proof.
- Intros. Elim (sumbool_of_bool (ad_list_stutters l)). Intro H0.
- Cut (lt (MapCard ? (Elems l)) (length l)). Intro. Rewrite H in H1. Elim (lt_n_n ? H1).
- Exact (ad_list_stutters_card ? H0).
- Trivial.
+ intros. elim (sumbool_of_bool (ad_list_stutters l)). intro H0.
+ cut (MapCard _ (Elems l) < length l). intro. rewrite H in H1. elim (lt_irrefl _ H1).
+ exact (ad_list_stutters_card _ H0).
+ trivial.
Qed.
- Lemma ad_list_stutters_card_conv : (l:(list ad)) (lt (MapCard ? (Elems l)) (length l)) ->
- (ad_list_stutters l)=true.
+ Lemma ad_list_stutters_card_conv :
+ forall l:list ad,
+ MapCard _ (Elems l) < length l -> ad_list_stutters l = true.
Proof.
- Intros. Elim (sumbool_of_bool (ad_list_stutters l)). Trivial.
- Intro H0. Rewrite (ad_list_not_stutters_card ? H0) in H. Elim (lt_n_n ? H).
+ intros. elim (sumbool_of_bool (ad_list_stutters l)). trivial.
+ intro H0. rewrite (ad_list_not_stutters_card _ H0) in H. elim (lt_irrefl _ H).
Qed.
- Lemma ad_in_list_l : (l,l':(list ad)) (a:ad) (ad_in_list a l)=true ->
- (ad_in_list a (app l l'))=true.
+ Lemma ad_in_list_l :
+ forall (l l':list ad) (a:ad),
+ ad_in_list a l = true -> ad_in_list a (l ++ l') = true.
Proof.
- Induction l. Intros. Discriminate H.
- Intros. Simpl. Simpl in H0. Elim (orb_true_elim ? ? H0). Intro H1. Rewrite H1. Reflexivity.
- Intro H1. Rewrite (H l' a0 H1). Apply orb_b_true.
+ simple induction l. intros. discriminate H.
+ intros. simpl in |- *. simpl in H0. elim (orb_true_elim _ _ H0). intro H1. rewrite H1. reflexivity.
+ intro H1. rewrite (H l' a0 H1). apply orb_b_true.
Qed.
- Lemma ad_list_stutters_app_l : (l,l':(list ad)) (ad_list_stutters l)=true ->
- (ad_list_stutters (app l l'))=true.
+ Lemma ad_list_stutters_app_l :
+ forall l l':list ad,
+ ad_list_stutters l = true -> ad_list_stutters (l ++ l') = true.
Proof.
- Induction l. Intros. Discriminate H.
- Intros. Simpl. Simpl in H0. Elim (orb_true_elim ? ? H0). Intro H1.
- Rewrite (ad_in_list_l l0 l' a H1). Reflexivity.
- Intro H1. Rewrite (H l' H1). Apply orb_b_true.
+ simple induction l. intros. discriminate H.
+ intros. simpl in |- *. simpl in H0. elim (orb_true_elim _ _ H0). intro H1.
+ rewrite (ad_in_list_l l0 l' a H1). reflexivity.
+ intro H1. rewrite (H l' H1). apply orb_b_true.
Qed.
- Lemma ad_in_list_r : (l,l':(list ad)) (a:ad) (ad_in_list a l')=true ->
- (ad_in_list a (app l l'))=true.
+ Lemma ad_in_list_r :
+ forall (l l':list ad) (a:ad),
+ ad_in_list a l' = true -> ad_in_list a (l ++ l') = true.
Proof.
- Induction l. Trivial.
- Intros. Simpl. Rewrite (H l' a0 H0). Apply orb_b_true.
+ simple induction l. trivial.
+ intros. simpl in |- *. rewrite (H l' a0 H0). apply orb_b_true.
Qed.
- Lemma ad_list_stutters_app_r : (l,l':(list ad)) (ad_list_stutters l')=true ->
- (ad_list_stutters (app l l'))=true.
+ Lemma ad_list_stutters_app_r :
+ forall l l':list ad,
+ ad_list_stutters l' = true -> ad_list_stutters (l ++ l') = true.
Proof.
- Induction l. Trivial.
- Intros. Simpl. Rewrite (H l' H0). Apply orb_b_true.
+ simple induction l. trivial.
+ intros. simpl in |- *. rewrite (H l' H0). apply orb_b_true.
Qed.
- Lemma ad_list_stutters_app_conv_l : (l,l':(list ad)) (ad_list_stutters (app l l'))=false ->
- (ad_list_stutters l)=false.
+ Lemma ad_list_stutters_app_conv_l :
+ forall l l':list ad,
+ ad_list_stutters (l ++ l') = false -> ad_list_stutters l = false.
Proof.
- Intros. Elim (sumbool_of_bool (ad_list_stutters l)). Intro H0.
- Rewrite (ad_list_stutters_app_l l l' H0) in H. Discriminate H.
- Trivial.
+ intros. elim (sumbool_of_bool (ad_list_stutters l)). intro H0.
+ rewrite (ad_list_stutters_app_l l l' H0) in H. discriminate H.
+ trivial.
Qed.
- Lemma ad_list_stutters_app_conv_r : (l,l':(list ad)) (ad_list_stutters (app l l'))=false ->
- (ad_list_stutters l')=false.
+ Lemma ad_list_stutters_app_conv_r :
+ forall l l':list ad,
+ ad_list_stutters (l ++ l') = false -> ad_list_stutters l' = false.
Proof.
- Intros. Elim (sumbool_of_bool (ad_list_stutters l')). Intro H0.
- Rewrite (ad_list_stutters_app_r l l' H0) in H. Discriminate H.
- Trivial.
+ intros. elim (sumbool_of_bool (ad_list_stutters l')). intro H0.
+ rewrite (ad_list_stutters_app_r l l' H0) in H. discriminate H.
+ trivial.
Qed.
- Lemma ad_in_list_app_1 : (l,l':(list ad)) (x:ad) (ad_in_list x (app l (cons x l')))=true.
+ Lemma ad_in_list_app_1 :
+ forall (l l':list ad) (x:ad), ad_in_list x (l ++ x :: l') = true.
Proof.
- Induction l. Simpl. Intros. Rewrite (ad_eq_correct x). Reflexivity.
- Intros. Simpl. Rewrite (H l' x). Apply orb_b_true.
+ simple induction l. simpl in |- *. intros. rewrite (ad_eq_correct x). reflexivity.
+ intros. simpl in |- *. rewrite (H l' x). apply orb_b_true.
Qed.
- Lemma ad_in_list_app : (l,l':(list ad)) (x:ad)
- (ad_in_list x (app l l'))=(orb (ad_in_list x l) (ad_in_list x l')).
+ Lemma ad_in_list_app :
+ forall (l l':list ad) (x:ad),
+ ad_in_list x (l ++ l') = orb (ad_in_list x l) (ad_in_list x l').
Proof.
- Induction l. Trivial.
- Intros. Simpl. Rewrite <- orb_assoc. Rewrite (H l' x). Reflexivity.
+ simple induction l. trivial.
+ intros. simpl in |- *. rewrite <- orb_assoc. rewrite (H l' x). reflexivity.
Qed.
- Lemma ad_in_list_rev : (l:(list ad)) (x:ad)
- (ad_in_list x (rev l))=(ad_in_list x l).
+ Lemma ad_in_list_rev :
+ forall (l:list ad) (x:ad), ad_in_list x (rev l) = ad_in_list x l.
Proof.
- Induction l. Trivial.
- Intros. Simpl. Rewrite ad_in_list_app. Rewrite (H x). Simpl. Rewrite orb_b_false.
- Apply orb_sym.
+ simple induction l. trivial.
+ intros. simpl in |- *. rewrite ad_in_list_app. rewrite (H x). simpl in |- *. rewrite orb_b_false.
+ apply orb_comm.
Qed.
- Lemma ad_list_has_circuit_stutters : (l0,l1,l2:(list ad)) (x:ad)
- (ad_list_stutters (app l0 (cons x (app l1 (cons x l2)))))=true.
+ Lemma ad_list_has_circuit_stutters :
+ forall (l0 l1 l2:list ad) (x:ad),
+ ad_list_stutters (l0 ++ x :: l1 ++ x :: l2) = true.
Proof.
- Induction l0. Simpl. Intros. Rewrite (ad_in_list_app_1 l1 l2 x). Reflexivity.
- Intros. Simpl. Rewrite (H l1 l2 x). Apply orb_b_true.
+ simple induction l0. simpl in |- *. intros. rewrite (ad_in_list_app_1 l1 l2 x). reflexivity.
+ intros. simpl in |- *. rewrite (H l1 l2 x). apply orb_b_true.
Qed.
- Lemma ad_list_stutters_prev_l : (l,l':(list ad)) (x:ad) (ad_in_list x l)=true ->
- (ad_list_stutters (app l (cons x l')))=true.
+ Lemma ad_list_stutters_prev_l :
+ forall (l l':list ad) (x:ad),
+ ad_in_list x l = true -> ad_list_stutters (l ++ x :: l') = true.
Proof.
- Intros. Elim (ad_in_list_forms_circuit ? ? H). Intros l0 H0. Elim H0. Intros l1 H1.
- Rewrite H1. Rewrite app_ass. Simpl. Apply ad_list_has_circuit_stutters.
+ intros. elim (ad_in_list_forms_circuit _ _ H). intros l0 H0. elim H0. intros l1 H1.
+ rewrite H1. rewrite app_ass. simpl in |- *. apply ad_list_has_circuit_stutters.
Qed.
- Lemma ad_list_stutters_prev_conv_l : (l,l':(list ad)) (x:ad)
- (ad_list_stutters (app l (cons x l')))=false -> (ad_in_list x l)=false.
+ Lemma ad_list_stutters_prev_conv_l :
+ forall (l l':list ad) (x:ad),
+ ad_list_stutters (l ++ x :: l') = false -> ad_in_list x l = false.
Proof.
- Intros. Elim (sumbool_of_bool (ad_in_list x l)). Intro H0.
- Rewrite (ad_list_stutters_prev_l l l' x H0) in H. Discriminate H.
- Trivial.
+ intros. elim (sumbool_of_bool (ad_in_list x l)). intro H0.
+ rewrite (ad_list_stutters_prev_l l l' x H0) in H. discriminate H.
+ trivial.
Qed.
- Lemma ad_list_stutters_prev_r : (l,l':(list ad)) (x:ad) (ad_in_list x l')=true ->
- (ad_list_stutters (app l (cons x l')))=true.
+ Lemma ad_list_stutters_prev_r :
+ forall (l l':list ad) (x:ad),
+ ad_in_list x l' = true -> ad_list_stutters (l ++ x :: l') = true.
Proof.
- Intros. Elim (ad_in_list_forms_circuit ? ? H). Intros l0 H0. Elim H0. Intros l1 H1.
- Rewrite H1. Apply ad_list_has_circuit_stutters.
+ intros. elim (ad_in_list_forms_circuit _ _ H). intros l0 H0. elim H0. intros l1 H1.
+ rewrite H1. apply ad_list_has_circuit_stutters.
Qed.
- Lemma ad_list_stutters_prev_conv_r : (l,l':(list ad)) (x:ad)
- (ad_list_stutters (app l (cons x l')))=false -> (ad_in_list x l')=false.
+ Lemma ad_list_stutters_prev_conv_r :
+ forall (l l':list ad) (x:ad),
+ ad_list_stutters (l ++ x :: l') = false -> ad_in_list x l' = false.
Proof.
- Intros. Elim (sumbool_of_bool (ad_in_list x l')). Intro H0.
- Rewrite (ad_list_stutters_prev_r l l' x H0) in H. Discriminate H.
- Trivial.
+ intros. elim (sumbool_of_bool (ad_in_list x l')). intro H0.
+ rewrite (ad_list_stutters_prev_r l l' x H0) in H. discriminate H.
+ trivial.
Qed.
- Lemma ad_list_Elems : (l,l':(list ad)) (MapCard ? (Elems l))=(MapCard ? (Elems l')) ->
- (length l)=(length l') ->
- (ad_list_stutters l)=(ad_list_stutters l').
+ Lemma ad_list_Elems :
+ forall l l':list ad,
+ MapCard _ (Elems l) = MapCard _ (Elems l') ->
+ length l = length l' -> ad_list_stutters l = ad_list_stutters l'.
Proof.
- Intros. Elim (sumbool_of_bool (ad_list_stutters l)). Intro H1. Rewrite H1. Apply sym_eq.
- Apply ad_list_stutters_card_conv. Rewrite <- H. Rewrite <- H0. Apply ad_list_stutters_card.
- Assumption.
- Intro H1. Rewrite H1. Apply sym_eq. Apply ad_list_not_stutters_card_conv. Rewrite <- H.
- Rewrite <- H0. Apply ad_list_not_stutters_card. Assumption.
+ intros. elim (sumbool_of_bool (ad_list_stutters l)). intro H1. rewrite H1. apply sym_eq.
+ apply ad_list_stutters_card_conv. rewrite <- H. rewrite <- H0. apply ad_list_stutters_card.
+ assumption.
+ intro H1. rewrite H1. apply sym_eq. apply ad_list_not_stutters_card_conv. rewrite <- H.
+ rewrite <- H0. apply ad_list_not_stutters_card. assumption.
Qed.
- Lemma ad_list_app_length : (l,l':(list ad)) (length (app l l'))=(plus (length l) (length l')).
+ Lemma ad_list_app_length :
+ forall l l':list ad, length (l ++ l') = length l + length l'.
Proof.
- Induction l. Trivial.
- Intros. Simpl. Rewrite (H l'). Reflexivity.
+ simple induction l. trivial.
+ intros. simpl in |- *. rewrite (H l'). reflexivity.
Qed.
- Lemma ad_list_stutters_permute : (l,l':(list ad))
- (ad_list_stutters (app l l'))=(ad_list_stutters (app l' l)).
+ Lemma ad_list_stutters_permute :
+ forall l l':list ad,
+ ad_list_stutters (l ++ l') = ad_list_stutters (l' ++ l).
Proof.
- Intros. Apply ad_list_Elems. Rewrite Elems_app. Rewrite Elems_app.
- Rewrite (FSetUnion_comm_c ? ? (Elems_canon l) (Elems_canon l')). Reflexivity.
- Rewrite ad_list_app_length. Rewrite ad_list_app_length. Apply plus_sym.
+ intros. apply ad_list_Elems. rewrite Elems_app. rewrite Elems_app.
+ rewrite (FSetUnion_comm_c _ _ (Elems_canon l) (Elems_canon l')). reflexivity.
+ rewrite ad_list_app_length. rewrite ad_list_app_length. apply plus_comm.
Qed.
- Lemma ad_list_rev_length : (l:(list ad)) (length (rev l))=(length l).
+ Lemma ad_list_rev_length : forall l:list ad, length (rev l) = length l.
Proof.
- Induction l. Trivial.
- Intros. Simpl. Rewrite ad_list_app_length. Simpl. Rewrite H. Rewrite <- plus_Snm_nSm.
- Rewrite <- plus_n_O. Reflexivity.
+ simple induction l. trivial.
+ intros. simpl in |- *. rewrite ad_list_app_length. simpl in |- *. rewrite H. rewrite <- plus_Snm_nSm.
+ rewrite <- plus_n_O. reflexivity.
Qed.
- Lemma ad_list_stutters_rev : (l:(list ad)) (ad_list_stutters (rev l))=(ad_list_stutters l).
+ Lemma ad_list_stutters_rev :
+ forall l:list ad, ad_list_stutters (rev l) = ad_list_stutters l.
Proof.
- Intros. Apply ad_list_Elems. Rewrite Elems_rev. Reflexivity.
- Apply ad_list_rev_length.
+ intros. apply ad_list_Elems. rewrite Elems_rev. reflexivity.
+ apply ad_list_rev_length.
Qed.
- Lemma ad_list_app_rev : (l,l':(list ad)) (x:ad)
- (app (rev l) (cons x l'))=(app (rev (cons x l)) l').
+ Lemma ad_list_app_rev :
+ forall (l l':list ad) (x:ad), rev l ++ x :: l' = rev (x :: l) ++ l'.
Proof.
- Induction l. Trivial.
- Intros. Simpl. Rewrite (app_ass (rev l0) (cons a (nil ad)) (cons x l')). Simpl.
- Rewrite (H (cons x l') a). Simpl.
- Rewrite (app_ass (rev l0) (cons a (nil ad)) (cons x (nil ad))). Simpl.
- Rewrite app_ass. Simpl. Rewrite app_ass. Reflexivity.
+ simple induction l. trivial.
+ intros. simpl in |- *. rewrite (app_ass (rev l0) (a :: nil) (x :: l')). simpl in |- *.
+ rewrite (H (x :: l') a). simpl in |- *.
+ rewrite (app_ass (rev l0) (a :: nil) (x :: nil)). simpl in |- *.
+ rewrite app_ass. simpl in |- *. rewrite app_ass. reflexivity.
Qed.
Section ListOfDomDef.
@@ -312,88 +342,96 @@ Section MapLists.
Variable A : Set.
Definition ad_list_of_dom :=
- (MapFold A (list ad) (nil ad) (!app ad) [a:ad][_:A] (cons a (nil ad))).
+ MapFold A (list ad) nil (app (A:=ad)) (fun (a:ad) (_:A) => a :: nil).
- Lemma ad_in_list_of_dom_in_dom : (m:(Map A)) (a:ad)
- (ad_in_list a (ad_list_of_dom m))=(in_dom A a m).
+ Lemma ad_in_list_of_dom_in_dom :
+ forall (m:Map A) (a:ad), ad_in_list a (ad_list_of_dom m) = in_dom A a m.
Proof.
- Unfold ad_list_of_dom. Intros.
- Rewrite (MapFold_distr_l A (list ad) (nil ad) (!app ad) bool false orb
- ad [a:ad][l:(list ad)](ad_in_list a l) [c:ad](refl_equal ? ?)
- ad_in_list_app [a0:ad][_:A](cons a0 (nil ad)) m a).
- Simpl. Rewrite (MapFold_orb A [a0:ad][_:A](orb (ad_eq a a0) false) m).
- Elim (option_sum ? (MapSweep A [a0:ad][_:A](orb (ad_eq a a0) false) m)). Intro H. Elim H.
- Intro r. Elim r. Intros a0 y H0. Rewrite H0. Unfold in_dom.
- Elim (orb_prop ? ? (MapSweep_semantics_1 ? ? ? ? ? H0)). Intro H1.
- Rewrite (ad_eq_complete ? ? H1). Rewrite (MapSweep_semantics_2 A ? ? ? ? H0). Reflexivity.
- Intro H1. Discriminate H1.
- Intro H. Rewrite H. Elim (sumbool_of_bool (in_dom A a m)). Intro H0.
- Elim (in_dom_some A m a H0). Intros y H1.
- Elim (orb_false_elim ? ? (MapSweep_semantics_3 ? ? ? H ? ? H1)). Intro H2.
- Rewrite (ad_eq_correct a) in H2. Discriminate H2.
- Exact (sym_eq ? ? ?).
+ unfold ad_list_of_dom in |- *. intros.
+ rewrite
+ (MapFold_distr_l A (list ad) nil (app (A:=ad)) bool false orb ad
+ (fun (a:ad) (l:list ad) => ad_in_list a l) (
+ fun c:ad => refl_equal _) ad_in_list_app
+ (fun (a0:ad) (_:A) => a0 :: nil) m a).
+ simpl in |- *. rewrite (MapFold_orb A (fun (a0:ad) (_:A) => orb (ad_eq a a0) false) m).
+ elim
+ (option_sum _
+ (MapSweep A (fun (a0:ad) (_:A) => orb (ad_eq a a0) false) m)). intro H. elim H.
+ intro r. elim r. intros a0 y H0. rewrite H0. unfold in_dom in |- *.
+ elim (orb_prop _ _ (MapSweep_semantics_1 _ _ _ _ _ H0)). intro H1.
+ rewrite (ad_eq_complete _ _ H1). rewrite (MapSweep_semantics_2 A _ _ _ _ H0). reflexivity.
+ intro H1. discriminate H1.
+ intro H. rewrite H. elim (sumbool_of_bool (in_dom A a m)). intro H0.
+ elim (in_dom_some A m a H0). intros y H1.
+ elim (orb_false_elim _ _ (MapSweep_semantics_3 _ _ _ H _ _ H1)). intro H2.
+ rewrite (ad_eq_correct a) in H2. discriminate H2.
+ exact (sym_eq (y:=_)).
Qed.
- Lemma Elems_of_list_of_dom :
- (m:(Map A)) (eqmap unit (Elems (ad_list_of_dom m)) (MapDom A m)).
+ Lemma Elems_of_list_of_dom :
+ forall m:Map A, eqmap unit (Elems (ad_list_of_dom m)) (MapDom A m).
Proof.
- Unfold eqmap eqm. Intros. Elim (sumbool_of_bool (in_FSet a (Elems (ad_list_of_dom m)))).
- Intro H. Elim (in_dom_some ? ? ? H). Intro t. Elim t. Intro H0.
- Rewrite (ad_in_elems_in_list (ad_list_of_dom m) a) in H.
- Rewrite (ad_in_list_of_dom_in_dom m a) in H. Rewrite (MapDom_Dom A m a) in H.
- Elim (in_dom_some ? ? ? H). Intro t'. Elim t'. Intro H1. Rewrite H1. Assumption.
- Intro H. Rewrite (in_dom_none ? ? ? H).
- Rewrite (ad_in_elems_in_list (ad_list_of_dom m) a) in H.
- Rewrite (ad_in_list_of_dom_in_dom m a) in H. Rewrite (MapDom_Dom A m a) in H.
- Rewrite (in_dom_none ? ? ? H). Reflexivity.
+ unfold eqmap, eqm in |- *. intros. elim (sumbool_of_bool (in_FSet a (Elems (ad_list_of_dom m)))).
+ intro H. elim (in_dom_some _ _ _ H). intro t. elim t. intro H0.
+ rewrite (ad_in_elems_in_list (ad_list_of_dom m) a) in H.
+ rewrite (ad_in_list_of_dom_in_dom m a) in H. rewrite (MapDom_Dom A m a) in H.
+ elim (in_dom_some _ _ _ H). intro t'. elim t'. intro H1. rewrite H1. assumption.
+ intro H. rewrite (in_dom_none _ _ _ H).
+ rewrite (ad_in_elems_in_list (ad_list_of_dom m) a) in H.
+ rewrite (ad_in_list_of_dom_in_dom m a) in H. rewrite (MapDom_Dom A m a) in H.
+ rewrite (in_dom_none _ _ _ H). reflexivity.
Qed.
- Lemma Elems_of_list_of_dom_c : (m:(Map A)) (mapcanon A m) ->
- (Elems (ad_list_of_dom m))=(MapDom A m).
+ Lemma Elems_of_list_of_dom_c :
+ forall m:Map A, mapcanon A m -> Elems (ad_list_of_dom m) = MapDom A m.
Proof.
- Intros. Apply (mapcanon_unique unit). Apply Elems_canon.
- Apply MapDom_canon. Assumption.
- Apply Elems_of_list_of_dom.
+ intros. apply (mapcanon_unique unit). apply Elems_canon.
+ apply MapDom_canon. assumption.
+ apply Elems_of_list_of_dom.
Qed.
- Lemma ad_list_of_dom_card_1 : (m:(Map A)) (pf:ad->ad)
- (length (MapFold1 A (list ad) (nil ad) (app 1!ad) [a:ad][_:A](cons a (nil ad)) pf m))=
- (MapCard A m).
+ Lemma ad_list_of_dom_card_1 :
+ forall (m:Map A) (pf:ad -> ad),
+ length
+ (MapFold1 A (list ad) nil (app (A:=ad)) (fun (a:ad) (_:A) => a :: nil)
+ pf m) = MapCard A m.
Proof.
- Induction m; Try Trivial. Simpl. Intros. Rewrite ad_list_app_length.
- Rewrite (H [a0:ad](pf (ad_double a0))). Rewrite (H0 [a0:ad](pf (ad_double_plus_un a0))).
- Reflexivity.
+ simple induction m; try trivial. simpl in |- *. intros. rewrite ad_list_app_length.
+ rewrite (H (fun a0:ad => pf (ad_double a0))). rewrite (H0 (fun a0:ad => pf (ad_double_plus_un a0))).
+ reflexivity.
Qed.
- Lemma ad_list_of_dom_card : (m:(Map A)) (length (ad_list_of_dom m))=(MapCard A m).
+ Lemma ad_list_of_dom_card :
+ forall m:Map A, length (ad_list_of_dom m) = MapCard A m.
Proof.
- Exact [m:(Map A)](ad_list_of_dom_card_1 m [a:ad]a).
+ exact (fun m:Map A => ad_list_of_dom_card_1 m (fun a:ad => a)).
Qed.
- Lemma ad_list_of_dom_not_stutters :
- (m:(Map A)) (ad_list_stutters (ad_list_of_dom m))=false.
+ Lemma ad_list_of_dom_not_stutters :
+ forall m:Map A, ad_list_stutters (ad_list_of_dom m) = false.
Proof.
- Intro. Apply ad_list_not_stutters_card_conv. Rewrite ad_list_of_dom_card. Apply sym_eq.
- Rewrite (MapCard_Dom A m). Apply MapCard_ext. Exact (Elems_of_list_of_dom m).
+ intro. apply ad_list_not_stutters_card_conv. rewrite ad_list_of_dom_card. apply sym_eq.
+ rewrite (MapCard_Dom A m). apply MapCard_ext. exact (Elems_of_list_of_dom m).
Qed.
End ListOfDomDef.
- Lemma ad_list_of_dom_Dom_1 : (A:Set)
- (m:(Map A)) (pf:ad->ad)
- (MapFold1 A (list ad) (nil ad) (app 1!ad)
- [a:ad][_:A](cons a (nil ad)) pf m)=
- (MapFold1 unit (list ad) (nil ad) (app 1!ad)
- [a:ad][_:unit](cons a (nil ad)) pf (MapDom A m)).
+ Lemma ad_list_of_dom_Dom_1 :
+ forall (A:Set) (m:Map A) (pf:ad -> ad),
+ MapFold1 A (list ad) nil (app (A:=ad)) (fun (a:ad) (_:A) => a :: nil) pf
+ m =
+ MapFold1 unit (list ad) nil (app (A:=ad))
+ (fun (a:ad) (_:unit) => a :: nil) pf (MapDom A m).
Proof.
- Induction m; Try Trivial. Simpl. Intros. Rewrite (H [a0:ad](pf (ad_double a0))).
- Rewrite (H0 [a0:ad](pf (ad_double_plus_un a0))). Reflexivity.
+ simple induction m; try trivial. simpl in |- *. intros. rewrite (H (fun a0:ad => pf (ad_double a0))).
+ rewrite (H0 (fun a0:ad => pf (ad_double_plus_un a0))). reflexivity.
Qed.
- Lemma ad_list_of_dom_Dom : (A:Set) (m:(Map A))
- (ad_list_of_dom A m)=(ad_list_of_dom unit (MapDom A m)).
+ Lemma ad_list_of_dom_Dom :
+ forall (A:Set) (m:Map A),
+ ad_list_of_dom A m = ad_list_of_dom unit (MapDom A m).
Proof.
- Intros. Exact (ad_list_of_dom_Dom_1 A m [a0:ad]a0).
+ intros. exact (ad_list_of_dom_Dom_1 A m (fun a0:ad => a0)).
Qed.
-End MapLists.
+End MapLists. \ No newline at end of file
diff --git a/theories/IntMap/Mapsubset.v b/theories/IntMap/Mapsubset.v
index defe49712..cff8f670b 100644
--- a/theories/IntMap/Mapsubset.v
+++ b/theories/IntMap/Mapsubset.v
@@ -7,548 +7,600 @@
(***********************************************************************)
(*i $Id$ i*)
-Require Bool.
-Require Sumbool.
-Require Arith.
-Require ZArith.
-Require Addr.
-Require Adist.
-Require Addec.
-Require Map.
-Require Fset.
-Require Mapaxioms.
-Require Mapiter.
+Require Import Bool.
+Require Import Sumbool.
+Require Import Arith.
+Require Import ZArith.
+Require Import Addr.
+Require Import Adist.
+Require Import Addec.
+Require Import Map.
+Require Import Fset.
+Require Import Mapaxioms.
+Require Import Mapiter.
Section MapSubsetDef.
- Variable A, B : Set.
+ Variables A B : Set.
- Definition MapSubset := [m:(Map A)] [m':(Map B)]
- (a:ad) (in_dom A a m)=true -> (in_dom B a m')=true.
+ Definition MapSubset (m:Map A) (m':Map B) :=
+ forall a:ad, in_dom A a m = true -> in_dom B a m' = true.
- Definition MapSubset_1 := [m:(Map A)] [m':(Map B)]
- Cases (MapSweep A [a:ad][_:A] (negb (in_dom B a m')) m) of
- NONE => true
- | _ => false
- end.
+ Definition MapSubset_1 (m:Map A) (m':Map B) :=
+ match MapSweep A (fun (a:ad) (_:A) => negb (in_dom B a m')) m with
+ | NONE => true
+ | _ => false
+ end.
- Definition MapSubset_2 := [m:(Map A)] [m':(Map B)]
- (eqmap A (MapDomRestrBy A B m m') (M0 A)).
+ Definition MapSubset_2 (m:Map A) (m':Map B) :=
+ eqmap A (MapDomRestrBy A B m m') (M0 A).
- Lemma MapSubset_imp_1 : (m:(Map A)) (m':(Map B))
- (MapSubset m m') -> (MapSubset_1 m m')=true.
+ Lemma MapSubset_imp_1 :
+ forall (m:Map A) (m':Map B), MapSubset m m' -> MapSubset_1 m m' = true.
Proof.
- Unfold MapSubset MapSubset_1. Intros.
- Elim (option_sum ? (MapSweep A [a:ad][_:A](negb (in_dom B a m')) m)).
- Intro H0. Elim H0. Intro r. Elim r. Intros a y H1. Cut (negb (in_dom B a m'))=true.
- Intro. Cut (in_dom A a m)=false. Intro. Unfold in_dom in H3.
- Rewrite (MapSweep_semantics_2 ? ? m a y H1) in H3. Discriminate H3.
- Elim (sumbool_of_bool (in_dom A a m)). Intro H3. Rewrite (H a H3) in H2. Discriminate H2.
- Trivial.
- Exact (MapSweep_semantics_1 ? ? m a y H1).
- Intro H0. Rewrite H0. Reflexivity.
+ unfold MapSubset, MapSubset_1 in |- *. intros.
+ elim
+ (option_sum _ (MapSweep A (fun (a:ad) (_:A) => negb (in_dom B a m')) m)).
+ intro H0. elim H0. intro r. elim r. intros a y H1. cut (negb (in_dom B a m') = true).
+ intro. cut (in_dom A a m = false). intro. unfold in_dom in H3.
+ rewrite (MapSweep_semantics_2 _ _ m a y H1) in H3. discriminate H3.
+ elim (sumbool_of_bool (in_dom A a m)). intro H3. rewrite (H a H3) in H2. discriminate H2.
+ trivial.
+ exact (MapSweep_semantics_1 _ _ m a y H1).
+ intro H0. rewrite H0. reflexivity.
Qed.
- Lemma MapSubset_1_imp : (m:(Map A)) (m':(Map B))
- (MapSubset_1 m m')=true -> (MapSubset m m').
+ Lemma MapSubset_1_imp :
+ forall (m:Map A) (m':Map B), MapSubset_1 m m' = true -> MapSubset m m'.
Proof.
- Unfold MapSubset MapSubset_1. Unfold 2 in_dom. Intros. Elim (option_sum ? (MapGet A m a)).
- Intro H1. Elim H1. Intros y H2.
- Elim (option_sum ? (MapSweep A [a:ad][_:A](negb (in_dom B a m')) m)). Intro H3.
- Elim H3. Intro r. Elim r. Intros a' y' H4. Rewrite H4 in H. Discriminate H.
- Intro H3. Cut (negb (in_dom B a m'))=false. Intro. Rewrite (negb_intro (in_dom B a m')).
- Rewrite H4. Reflexivity.
- Exact (MapSweep_semantics_3 ? ? m H3 a y H2).
- Intro H1. Rewrite H1 in H0. Discriminate H0.
+ unfold MapSubset, MapSubset_1 in |- *. unfold in_dom at 2 in |- *. intros. elim (option_sum _ (MapGet A m a)).
+ intro H1. elim H1. intros y H2.
+ elim
+ (option_sum _ (MapSweep A (fun (a:ad) (_:A) => negb (in_dom B a m')) m)). intro H3.
+ elim H3. intro r. elim r. intros a' y' H4. rewrite H4 in H. discriminate H.
+ intro H3. cut (negb (in_dom B a m') = false). intro. rewrite (negb_intro (in_dom B a m')).
+ rewrite H4. reflexivity.
+ exact (MapSweep_semantics_3 _ _ m H3 a y H2).
+ intro H1. rewrite H1 in H0. discriminate H0.
Qed.
- Lemma map_dom_empty_1 :
- (m:(Map A)) (eqmap A m (M0 A)) -> (a:ad) (in_dom ? a m)=false.
+ Lemma map_dom_empty_1 :
+ forall m:Map A, eqmap A m (M0 A) -> forall a:ad, in_dom _ a m = false.
Proof.
- Unfold eqmap eqm in_dom. Intros. Rewrite (H a). Reflexivity.
+ unfold eqmap, eqm, in_dom in |- *. intros. rewrite (H a). reflexivity.
Qed.
- Lemma map_dom_empty_2 :
- (m:(Map A)) ((a:ad) (in_dom ? a m)=false) -> (eqmap A m (M0 A)).
+ Lemma map_dom_empty_2 :
+ forall m:Map A, (forall a:ad, in_dom _ a m = false) -> eqmap A m (M0 A).
Proof.
- Unfold eqmap eqm in_dom. Intros.
- Cut (Cases (MapGet A m a) of NONE => false | (SOME _) => true end)=false.
- Case (MapGet A m a). Trivial.
- Intros. Discriminate H0.
- Exact (H a).
+ unfold eqmap, eqm, in_dom in |- *. intros.
+ cut
+ (match MapGet A m a with
+ | NONE => false
+ | SOME _ => true
+ end = false).
+ case (MapGet A m a). trivial.
+ intros. discriminate H0.
+ exact (H a).
Qed.
- Lemma MapSubset_imp_2 :
- (m:(Map A)) (m':(Map B)) (MapSubset m m') -> (MapSubset_2 m m').
+ Lemma MapSubset_imp_2 :
+ forall (m:Map A) (m':Map B), MapSubset m m' -> MapSubset_2 m m'.
Proof.
- Unfold MapSubset MapSubset_2. Intros. Apply map_dom_empty_2. Intro. Rewrite in_dom_restrby.
- Elim (sumbool_of_bool (in_dom A a m)). Intro H0. Rewrite H0. Rewrite (H a H0). Reflexivity.
- Intro H0. Rewrite H0. Reflexivity.
+ unfold MapSubset, MapSubset_2 in |- *. intros. apply map_dom_empty_2. intro. rewrite in_dom_restrby.
+ elim (sumbool_of_bool (in_dom A a m)). intro H0. rewrite H0. rewrite (H a H0). reflexivity.
+ intro H0. rewrite H0. reflexivity.
Qed.
- Lemma MapSubset_2_imp :
- (m:(Map A)) (m':(Map B)) (MapSubset_2 m m') -> (MapSubset m m').
+ Lemma MapSubset_2_imp :
+ forall (m:Map A) (m':Map B), MapSubset_2 m m' -> MapSubset m m'.
Proof.
- Unfold MapSubset MapSubset_2. Intros. Cut (in_dom ? a (MapDomRestrBy A B m m'))=false.
- Rewrite in_dom_restrby. Intro. Elim (andb_false_elim ? ? H1). Rewrite H0.
- Intro H2. Discriminate H2.
- Intro H2. Rewrite (negb_intro (in_dom B a m')). Rewrite H2. Reflexivity.
- Exact (map_dom_empty_1 ? H a).
+ unfold MapSubset, MapSubset_2 in |- *. intros. cut (in_dom _ a (MapDomRestrBy A B m m') = false).
+ rewrite in_dom_restrby. intro. elim (andb_false_elim _ _ H1). rewrite H0.
+ intro H2. discriminate H2.
+ intro H2. rewrite (negb_intro (in_dom B a m')). rewrite H2. reflexivity.
+ exact (map_dom_empty_1 _ H a).
Qed.
End MapSubsetDef.
Section MapSubsetOrder.
- Variable A, B, C : Set.
+ Variables A B C : Set.
- Lemma MapSubset_refl : (m:(Map A)) (MapSubset A A m m).
+ Lemma MapSubset_refl : forall m:Map A, MapSubset A A m m.
Proof.
- Unfold MapSubset. Trivial.
+ unfold MapSubset in |- *. trivial.
Qed.
- Lemma MapSubset_antisym : (m:(Map A)) (m':(Map B))
- (MapSubset A B m m') -> (MapSubset B A m' m) ->
- (eqmap unit (MapDom A m) (MapDom B m')).
+ Lemma MapSubset_antisym :
+ forall (m:Map A) (m':Map B),
+ MapSubset A B m m' ->
+ MapSubset B A m' m -> eqmap unit (MapDom A m) (MapDom B m').
Proof.
- Unfold MapSubset eqmap eqm. Intros. Elim (option_sum ? (MapGet ? (MapDom A m) a)).
- Intro H1. Elim H1. Intro t. Elim t. Intro H2. Elim (option_sum ? (MapGet ? (MapDom B m') a)).
- Intro H3. Elim H3. Intro t'. Elim t'. Intro H4. Rewrite H4. Exact H2.
- Intro H3. Cut (in_dom B a m')=true. Intro. Rewrite (MapDom_Dom B m' a) in H4.
- Unfold in_FSet in_dom in H4. Rewrite H3 in H4. Discriminate H4.
- Apply H. Rewrite (MapDom_Dom A m a). Unfold in_FSet in_dom. Rewrite H2. Reflexivity.
- Intro H1. Elim (option_sum ? (MapGet ? (MapDom B m') a)). Intro H2. Elim H2. Intros t H3.
- Cut (in_dom A a m)=true. Intro. Rewrite (MapDom_Dom A m a) in H4. Unfold in_FSet in_dom in H4.
- Rewrite H1 in H4. Discriminate H4.
- Apply H0. Rewrite (MapDom_Dom B m' a). Unfold in_FSet in_dom. Rewrite H3. Reflexivity.
- Intro H2. Rewrite H2. Exact H1.
+ unfold MapSubset, eqmap, eqm in |- *. intros. elim (option_sum _ (MapGet _ (MapDom A m) a)).
+ intro H1. elim H1. intro t. elim t. intro H2. elim (option_sum _ (MapGet _ (MapDom B m') a)).
+ intro H3. elim H3. intro t'. elim t'. intro H4. rewrite H4. exact H2.
+ intro H3. cut (in_dom B a m' = true). intro. rewrite (MapDom_Dom B m' a) in H4.
+ unfold in_FSet, in_dom in H4. rewrite H3 in H4. discriminate H4.
+ apply H. rewrite (MapDom_Dom A m a). unfold in_FSet, in_dom in |- *. rewrite H2. reflexivity.
+ intro H1. elim (option_sum _ (MapGet _ (MapDom B m') a)). intro H2. elim H2. intros t H3.
+ cut (in_dom A a m = true). intro. rewrite (MapDom_Dom A m a) in H4. unfold in_FSet, in_dom in H4.
+ rewrite H1 in H4. discriminate H4.
+ apply H0. rewrite (MapDom_Dom B m' a). unfold in_FSet, in_dom in |- *. rewrite H3. reflexivity.
+ intro H2. rewrite H2. exact H1.
Qed.
- Lemma MapSubset_trans : (m:(Map A)) (m':(Map B)) (m'':(Map C))
- (MapSubset A B m m') -> (MapSubset B C m' m'') -> (MapSubset A C m m'').
+ Lemma MapSubset_trans :
+ forall (m:Map A) (m':Map B) (m'':Map C),
+ MapSubset A B m m' -> MapSubset B C m' m'' -> MapSubset A C m m''.
Proof.
- Unfold MapSubset. Intros. Apply H0. Apply H. Assumption.
+ unfold MapSubset in |- *. intros. apply H0. apply H. assumption.
Qed.
End MapSubsetOrder.
Section FSubsetOrder.
- Lemma FSubset_refl : (s:FSet) (MapSubset ? ? s s).
+ Lemma FSubset_refl : forall s:FSet, MapSubset _ _ s s.
Proof.
- Exact (MapSubset_refl unit).
+ exact (MapSubset_refl unit).
Qed.
- Lemma FSubset_antisym : (s,s':FSet)
- (MapSubset ? ? s s') -> (MapSubset ? ? s' s) -> (eqmap unit s s').
+ Lemma FSubset_antisym :
+ forall s s':FSet,
+ MapSubset _ _ s s' -> MapSubset _ _ s' s -> eqmap unit s s'.
Proof.
- Intros. Rewrite <- (FSet_Dom s). Rewrite <- (FSet_Dom s').
- Exact (MapSubset_antisym ? ? s s' H H0).
+ intros. rewrite <- (FSet_Dom s). rewrite <- (FSet_Dom s').
+ exact (MapSubset_antisym _ _ s s' H H0).
Qed.
- Lemma FSubset_trans : (s,s',s'':FSet)
- (MapSubset ? ? s s') -> (MapSubset ? ? s' s'') -> (MapSubset ? ? s s'').
+ Lemma FSubset_trans :
+ forall s s' s'':FSet,
+ MapSubset _ _ s s' -> MapSubset _ _ s' s'' -> MapSubset _ _ s s''.
Proof.
- Exact (MapSubset_trans unit unit unit).
+ exact (MapSubset_trans unit unit unit).
Qed.
End FSubsetOrder.
Section MapSubsetExtra.
- Variable A, B : Set.
+ Variables A B : Set.
- Lemma MapSubset_Dom_1 : (m:(Map A)) (m':(Map B))
- (MapSubset A B m m') -> (MapSubset unit unit (MapDom A m) (MapDom B m')).
+ Lemma MapSubset_Dom_1 :
+ forall (m:Map A) (m':Map B),
+ MapSubset A B m m' -> MapSubset unit unit (MapDom A m) (MapDom B m').
Proof.
- Unfold MapSubset. Intros. Elim (MapDom_semantics_2 ? m a H0). Intros y H1.
- Cut (in_dom A a m)=true->(in_dom B a m')=true. Intro. Unfold in_dom in H2.
- Rewrite H1 in H2. Elim (option_sum ? (MapGet B m' a)). Intro H3. Elim H3.
- Intros y' H4. Exact (MapDom_semantics_1 ? m' a y' H4).
- Intro H3. Rewrite H3 in H2. Cut false=true. Intro. Discriminate H4.
- Apply H2. Reflexivity.
- Exact (H a).
+ unfold MapSubset in |- *. intros. elim (MapDom_semantics_2 _ m a H0). intros y H1.
+ cut (in_dom A a m = true -> in_dom B a m' = true). intro. unfold in_dom in H2.
+ rewrite H1 in H2. elim (option_sum _ (MapGet B m' a)). intro H3. elim H3.
+ intros y' H4. exact (MapDom_semantics_1 _ m' a y' H4).
+ intro H3. rewrite H3 in H2. cut (false = true). intro. discriminate H4.
+ apply H2. reflexivity.
+ exact (H a).
Qed.
- Lemma MapSubset_Dom_2 : (m:(Map A)) (m':(Map B))
- (MapSubset unit unit (MapDom A m) (MapDom B m')) -> (MapSubset A B m m').
+ Lemma MapSubset_Dom_2 :
+ forall (m:Map A) (m':Map B),
+ MapSubset unit unit (MapDom A m) (MapDom B m') -> MapSubset A B m m'.
Proof.
- Unfold MapSubset. Intros. Unfold in_dom in H0. Elim (option_sum ? (MapGet A m a)).
- Intro H1. Elim H1. Intros y H2.
- Elim (MapDom_semantics_2 ? ? ? (H a (MapDom_semantics_1 ? ? ? ? H2))). Intros y' H3.
- Unfold in_dom. Rewrite H3. Reflexivity.
- Intro H1. Rewrite H1 in H0. Discriminate H0.
+ unfold MapSubset in |- *. intros. unfold in_dom in H0. elim (option_sum _ (MapGet A m a)).
+ intro H1. elim H1. intros y H2.
+ elim (MapDom_semantics_2 _ _ _ (H a (MapDom_semantics_1 _ _ _ _ H2))). intros y' H3.
+ unfold in_dom in |- *. rewrite H3. reflexivity.
+ intro H1. rewrite H1 in H0. discriminate H0.
Qed.
- Lemma MapSubset_1_Dom : (m:(Map A)) (m':(Map B))
- (MapSubset_1 A B m m')=(MapSubset_1 unit unit (MapDom A m) (MapDom B m')).
+ Lemma MapSubset_1_Dom :
+ forall (m:Map A) (m':Map B),
+ MapSubset_1 A B m m' = MapSubset_1 unit unit (MapDom A m) (MapDom B m').
Proof.
- Intros. Elim (sumbool_of_bool (MapSubset_1 A B m m')). Intro H. Rewrite H.
- Apply sym_eq. Apply MapSubset_imp_1. Apply MapSubset_Dom_1. Exact (MapSubset_1_imp ? ? ? ? H).
- Intro H. Rewrite H. Elim (sumbool_of_bool (MapSubset_1 unit unit (MapDom A m) (MapDom B m'))).
- Intro H0.
- Rewrite (MapSubset_imp_1 ? ? ? ? (MapSubset_Dom_2 ? ? (MapSubset_1_imp ? ? ? ? H0))) in H.
- Discriminate H.
- Intro. Apply sym_eq. Assumption.
+ intros. elim (sumbool_of_bool (MapSubset_1 A B m m')). intro H. rewrite H.
+ apply sym_eq. apply MapSubset_imp_1. apply MapSubset_Dom_1. exact (MapSubset_1_imp _ _ _ _ H).
+ intro H. rewrite H. elim (sumbool_of_bool (MapSubset_1 unit unit (MapDom A m) (MapDom B m'))).
+ intro H0.
+ rewrite
+ (MapSubset_imp_1 _ _ _ _
+ (MapSubset_Dom_2 _ _ (MapSubset_1_imp _ _ _ _ H0)))
+ in H.
+ discriminate H.
+ intro. apply sym_eq. assumption.
Qed.
- Lemma MapSubset_Put : (m:(Map A)) (a:ad) (y:A) (MapSubset A A m (MapPut A m a y)).
+ Lemma MapSubset_Put :
+ forall (m:Map A) (a:ad) (y:A), MapSubset A A m (MapPut A m a y).
Proof.
- Unfold MapSubset. Intros. Rewrite in_dom_put. Rewrite H. Apply orb_b_true.
+ unfold MapSubset in |- *. intros. rewrite in_dom_put. rewrite H. apply orb_b_true.
Qed.
- Lemma MapSubset_Put_mono : (m:(Map A)) (m':(Map B)) (a:ad) (y:A) (y':B)
- (MapSubset A B m m') -> (MapSubset A B (MapPut A m a y) (MapPut B m' a y')).
+ Lemma MapSubset_Put_mono :
+ forall (m:Map A) (m':Map B) (a:ad) (y:A) (y':B),
+ MapSubset A B m m' -> MapSubset A B (MapPut A m a y) (MapPut B m' a y').
Proof.
- Unfold MapSubset. Intros. Rewrite in_dom_put. Rewrite (in_dom_put A m a y a0) in H0.
- Elim (orb_true_elim ? ? H0). Intro H1. Rewrite H1. Reflexivity.
- Intro H1. Rewrite (H ? H1). Apply orb_b_true.
+ unfold MapSubset in |- *. intros. rewrite in_dom_put. rewrite (in_dom_put A m a y a0) in H0.
+ elim (orb_true_elim _ _ H0). intro H1. rewrite H1. reflexivity.
+ intro H1. rewrite (H _ H1). apply orb_b_true.
Qed.
- Lemma MapSubset_Put_behind :
- (m:(Map A)) (a:ad) (y:A) (MapSubset A A m (MapPut_behind A m a y)).
+ Lemma MapSubset_Put_behind :
+ forall (m:Map A) (a:ad) (y:A), MapSubset A A m (MapPut_behind A m a y).
Proof.
- Unfold MapSubset. Intros. Rewrite in_dom_put_behind. Rewrite H. Apply orb_b_true.
+ unfold MapSubset in |- *. intros. rewrite in_dom_put_behind. rewrite H. apply orb_b_true.
Qed.
- Lemma MapSubset_Put_behind_mono : (m:(Map A)) (m':(Map B)) (a:ad) (y:A) (y':B)
- (MapSubset A B m m') ->
- (MapSubset A B (MapPut_behind A m a y) (MapPut_behind B m' a y')).
+ Lemma MapSubset_Put_behind_mono :
+ forall (m:Map A) (m':Map B) (a:ad) (y:A) (y':B),
+ MapSubset A B m m' ->
+ MapSubset A B (MapPut_behind A m a y) (MapPut_behind B m' a y').
Proof.
- Unfold MapSubset. Intros. Rewrite in_dom_put_behind.
- Rewrite (in_dom_put_behind A m a y a0) in H0.
- Elim (orb_true_elim ? ? H0). Intro H1. Rewrite H1. Reflexivity.
- Intro H1. Rewrite (H ? H1). Apply orb_b_true.
+ unfold MapSubset in |- *. intros. rewrite in_dom_put_behind.
+ rewrite (in_dom_put_behind A m a y a0) in H0.
+ elim (orb_true_elim _ _ H0). intro H1. rewrite H1. reflexivity.
+ intro H1. rewrite (H _ H1). apply orb_b_true.
Qed.
- Lemma MapSubset_Remove : (m:(Map A)) (a:ad) (MapSubset A A (MapRemove A m a) m).
+ Lemma MapSubset_Remove :
+ forall (m:Map A) (a:ad), MapSubset A A (MapRemove A m a) m.
Proof.
- Unfold MapSubset. Intros. Unfold MapSubset. Intros. Rewrite (in_dom_remove ? m a a0) in H.
- Elim (andb_prop ? ? H). Trivial.
+ unfold MapSubset in |- *. intros. unfold MapSubset in |- *. intros. rewrite (in_dom_remove _ m a a0) in H.
+ elim (andb_prop _ _ H). trivial.
Qed.
- Lemma MapSubset_Remove_mono : (m:(Map A)) (m':(Map B)) (a:ad)
- (MapSubset A B m m') -> (MapSubset A B (MapRemove A m a) (MapRemove B m' a)).
+ Lemma MapSubset_Remove_mono :
+ forall (m:Map A) (m':Map B) (a:ad),
+ MapSubset A B m m' -> MapSubset A B (MapRemove A m a) (MapRemove B m' a).
Proof.
- Unfold MapSubset. Intros. Rewrite in_dom_remove. Rewrite (in_dom_remove A m a a0) in H0.
- Elim (andb_prop ? ? H0). Intros. Rewrite H1. Rewrite (H ? H2). Reflexivity.
+ unfold MapSubset in |- *. intros. rewrite in_dom_remove. rewrite (in_dom_remove A m a a0) in H0.
+ elim (andb_prop _ _ H0). intros. rewrite H1. rewrite (H _ H2). reflexivity.
Qed.
- Lemma MapSubset_Merge_l : (m,m':(Map A)) (MapSubset A A m (MapMerge A m m')).
+ Lemma MapSubset_Merge_l :
+ forall m m':Map A, MapSubset A A m (MapMerge A m m').
Proof.
- Unfold MapSubset. Intros. Rewrite in_dom_merge. Rewrite H. Reflexivity.
+ unfold MapSubset in |- *. intros. rewrite in_dom_merge. rewrite H. reflexivity.
Qed.
- Lemma MapSubset_Merge_r : (m,m':(Map A)) (MapSubset A A m' (MapMerge A m m')).
+ Lemma MapSubset_Merge_r :
+ forall m m':Map A, MapSubset A A m' (MapMerge A m m').
Proof.
- Unfold MapSubset. Intros. Rewrite in_dom_merge. Rewrite H. Apply orb_b_true.
+ unfold MapSubset in |- *. intros. rewrite in_dom_merge. rewrite H. apply orb_b_true.
Qed.
- Lemma MapSubset_Merge_mono : (m,m':(Map A)) (m'',m''':(Map B))
- (MapSubset A B m m'') -> (MapSubset A B m' m''') ->
- (MapSubset A B (MapMerge A m m') (MapMerge B m'' m''')).
+ Lemma MapSubset_Merge_mono :
+ forall (m m':Map A) (m'' m''':Map B),
+ MapSubset A B m m'' ->
+ MapSubset A B m' m''' ->
+ MapSubset A B (MapMerge A m m') (MapMerge B m'' m''').
Proof.
- Unfold MapSubset. Intros. Rewrite in_dom_merge. Rewrite (in_dom_merge A m m' a) in H1.
- Elim (orb_true_elim ? ? H1). Intro H2. Rewrite (H ? H2). Reflexivity.
- Intro H2. Rewrite (H0 ? H2). Apply orb_b_true.
+ unfold MapSubset in |- *. intros. rewrite in_dom_merge. rewrite (in_dom_merge A m m' a) in H1.
+ elim (orb_true_elim _ _ H1). intro H2. rewrite (H _ H2). reflexivity.
+ intro H2. rewrite (H0 _ H2). apply orb_b_true.
Qed.
- Lemma MapSubset_DomRestrTo_l : (m:(Map A)) (m':(Map B))
- (MapSubset A A (MapDomRestrTo A B m m') m).
+ Lemma MapSubset_DomRestrTo_l :
+ forall (m:Map A) (m':Map B), MapSubset A A (MapDomRestrTo A B m m') m.
Proof.
- Unfold MapSubset. Intros. Rewrite (in_dom_restrto ? ? m m' a) in H. Elim (andb_prop ? ? H).
- Trivial.
+ unfold MapSubset in |- *. intros. rewrite (in_dom_restrto _ _ m m' a) in H. elim (andb_prop _ _ H).
+ trivial.
Qed.
- Lemma MapSubset_DomRestrTo_r: (m:(Map A)) (m':(Map B))
- (MapSubset A B (MapDomRestrTo A B m m') m').
+ Lemma MapSubset_DomRestrTo_r :
+ forall (m:Map A) (m':Map B), MapSubset A B (MapDomRestrTo A B m m') m'.
Proof.
- Unfold MapSubset. Intros. Rewrite (in_dom_restrto ? ? m m' a) in H. Elim (andb_prop ? ? H).
- Trivial.
+ unfold MapSubset in |- *. intros. rewrite (in_dom_restrto _ _ m m' a) in H. elim (andb_prop _ _ H).
+ trivial.
Qed.
- Lemma MapSubset_ext : (m0,m1:(Map A)) (m2,m3:(Map B))
- (eqmap A m0 m1) -> (eqmap B m2 m3) ->
- (MapSubset A B m0 m2) -> (MapSubset A B m1 m3).
+ Lemma MapSubset_ext :
+ forall (m0 m1:Map A) (m2 m3:Map B),
+ eqmap A m0 m1 ->
+ eqmap B m2 m3 -> MapSubset A B m0 m2 -> MapSubset A B m1 m3.
Proof.
- Intros. Apply MapSubset_2_imp. Unfold MapSubset_2.
- Apply eqmap_trans with m':=(MapDomRestrBy A B m0 m2). Apply MapDomRestrBy_ext. Apply eqmap_sym.
- Assumption.
- Apply eqmap_sym. Assumption.
- Exact (MapSubset_imp_2 ? ? ? ? H1).
+ intros. apply MapSubset_2_imp. unfold MapSubset_2 in |- *.
+ apply eqmap_trans with (m' := MapDomRestrBy A B m0 m2). apply MapDomRestrBy_ext. apply eqmap_sym.
+ assumption.
+ apply eqmap_sym. assumption.
+ exact (MapSubset_imp_2 _ _ _ _ H1).
Qed.
- Variable C, D : Set.
+ Variables C D : Set.
- Lemma MapSubset_DomRestrTo_mono :
- (m:(Map A)) (m':(Map B)) (m'':(Map C)) (m''':(Map D))
- (MapSubset ? ? m m'') -> (MapSubset ? ? m' m''') ->
- (MapSubset ? ? (MapDomRestrTo ? ? m m') (MapDomRestrTo ? ? m'' m''')).
+ Lemma MapSubset_DomRestrTo_mono :
+ forall (m:Map A) (m':Map B) (m'':Map C) (m''':Map D),
+ MapSubset _ _ m m'' ->
+ MapSubset _ _ m' m''' ->
+ MapSubset _ _ (MapDomRestrTo _ _ m m') (MapDomRestrTo _ _ m'' m''').
Proof.
- Unfold MapSubset. Intros. Rewrite in_dom_restrto. Rewrite (in_dom_restrto A B m m' a) in H1.
- Elim (andb_prop ? ? H1). Intros. Rewrite (H ? H2). Rewrite (H0 ? H3). Reflexivity.
+ unfold MapSubset in |- *. intros. rewrite in_dom_restrto. rewrite (in_dom_restrto A B m m' a) in H1.
+ elim (andb_prop _ _ H1). intros. rewrite (H _ H2). rewrite (H0 _ H3). reflexivity.
Qed.
- Lemma MapSubset_DomRestrBy_l : (m:(Map A)) (m':(Map B))
- (MapSubset A A (MapDomRestrBy A B m m') m).
+ Lemma MapSubset_DomRestrBy_l :
+ forall (m:Map A) (m':Map B), MapSubset A A (MapDomRestrBy A B m m') m.
Proof.
- Unfold MapSubset. Intros. Rewrite (in_dom_restrby ? ? m m' a) in H. Elim (andb_prop ? ? H).
- Trivial.
+ unfold MapSubset in |- *. intros. rewrite (in_dom_restrby _ _ m m' a) in H. elim (andb_prop _ _ H).
+ trivial.
Qed.
- Lemma MapSubset_DomRestrBy_mono :
- (m:(Map A)) (m':(Map B)) (m'':(Map C)) (m''':(Map D))
- (MapSubset ? ? m m'') -> (MapSubset ? ? m''' m') ->
- (MapSubset ? ? (MapDomRestrBy ? ? m m') (MapDomRestrBy ? ? m'' m''')).
+ Lemma MapSubset_DomRestrBy_mono :
+ forall (m:Map A) (m':Map B) (m'':Map C) (m''':Map D),
+ MapSubset _ _ m m'' ->
+ MapSubset _ _ m''' m' ->
+ MapSubset _ _ (MapDomRestrBy _ _ m m') (MapDomRestrBy _ _ m'' m''').
Proof.
- Unfold MapSubset. Intros. Rewrite in_dom_restrby. Rewrite (in_dom_restrby A B m m' a) in H1.
- Elim (andb_prop ? ? H1). Intros. Rewrite (H ? H2). Elim (sumbool_of_bool (in_dom D a m''')).
- Intro H4. Rewrite (H0 ? H4) in H3. Discriminate H3.
- Intro H4. Rewrite H4. Reflexivity.
+ unfold MapSubset in |- *. intros. rewrite in_dom_restrby. rewrite (in_dom_restrby A B m m' a) in H1.
+ elim (andb_prop _ _ H1). intros. rewrite (H _ H2). elim (sumbool_of_bool (in_dom D a m''')).
+ intro H4. rewrite (H0 _ H4) in H3. discriminate H3.
+ intro H4. rewrite H4. reflexivity.
Qed.
End MapSubsetExtra.
Section MapDisjointDef.
- Variable A, B : Set.
+ Variables A B : Set.
- Definition MapDisjoint := [m:(Map A)] [m':(Map B)]
- (a:ad) (in_dom A a m)=true -> (in_dom B a m')=true -> False.
+ Definition MapDisjoint (m:Map A) (m':Map B) :=
+ forall a:ad, in_dom A a m = true -> in_dom B a m' = true -> False.
- Definition MapDisjoint_1 := [m:(Map A)] [m':(Map B)]
- Cases (MapSweep A [a:ad][_:A] (in_dom B a m') m) of
- NONE => true
- | _ => false
- end.
+ Definition MapDisjoint_1 (m:Map A) (m':Map B) :=
+ match MapSweep A (fun (a:ad) (_:A) => in_dom B a m') m with
+ | NONE => true
+ | _ => false
+ end.
- Definition MapDisjoint_2 := [m:(Map A)] [m':(Map B)]
- (eqmap A (MapDomRestrTo A B m m') (M0 A)).
+ Definition MapDisjoint_2 (m:Map A) (m':Map B) :=
+ eqmap A (MapDomRestrTo A B m m') (M0 A).
- Lemma MapDisjoint_imp_1 : (m:(Map A)) (m':(Map B))
- (MapDisjoint m m') -> (MapDisjoint_1 m m')=true.
+ Lemma MapDisjoint_imp_1 :
+ forall (m:Map A) (m':Map B), MapDisjoint m m' -> MapDisjoint_1 m m' = true.
Proof.
- Unfold MapDisjoint MapDisjoint_1. Intros.
- Elim (option_sum ? (MapSweep A [a:ad][_:A](in_dom B a m') m)). Intro H0. Elim H0.
- Intro r. Elim r. Intros a y H1. Cut (in_dom A a m)=true->(in_dom B a m')=true->False.
- Intro. Unfold 1 in_dom in H2. Rewrite (MapSweep_semantics_2 ? ? ? ? ? H1) in H2.
- Rewrite (MapSweep_semantics_1 ? ? ? ? ? H1) in H2. Elim (H2 (refl_equal ? ?) (refl_equal ? ?)).
- Exact (H a).
- Intro H0. Rewrite H0. Reflexivity.
+ unfold MapDisjoint, MapDisjoint_1 in |- *. intros.
+ elim (option_sum _ (MapSweep A (fun (a:ad) (_:A) => in_dom B a m') m)). intro H0. elim H0.
+ intro r. elim r. intros a y H1. cut (in_dom A a m = true -> in_dom B a m' = true -> False).
+ intro. unfold in_dom at 1 in H2. rewrite (MapSweep_semantics_2 _ _ _ _ _ H1) in H2.
+ rewrite (MapSweep_semantics_1 _ _ _ _ _ H1) in H2. elim (H2 (refl_equal _) (refl_equal _)).
+ exact (H a).
+ intro H0. rewrite H0. reflexivity.
Qed.
- Lemma MapDisjoint_1_imp : (m:(Map A)) (m':(Map B))
- (MapDisjoint_1 m m')=true -> (MapDisjoint m m').
+ Lemma MapDisjoint_1_imp :
+ forall (m:Map A) (m':Map B), MapDisjoint_1 m m' = true -> MapDisjoint m m'.
Proof.
- Unfold MapDisjoint MapDisjoint_1. Intros.
- Elim (option_sum ? (MapSweep A [a:ad][_:A](in_dom B a m') m)). Intro H2. Elim H2.
- Intro r. Elim r. Intros a' y' H3. Rewrite H3 in H. Discriminate H.
- Intro H2. Unfold in_dom in H0. Elim (option_sum ? (MapGet A m a)). Intro H3. Elim H3.
- Intros y H4. Rewrite (MapSweep_semantics_3 ? ? ? H2 a y H4) in H1. Discriminate H1.
- Intro H3. Rewrite H3 in H0. Discriminate H0.
+ unfold MapDisjoint, MapDisjoint_1 in |- *. intros.
+ elim (option_sum _ (MapSweep A (fun (a:ad) (_:A) => in_dom B a m') m)). intro H2. elim H2.
+ intro r. elim r. intros a' y' H3. rewrite H3 in H. discriminate H.
+ intro H2. unfold in_dom in H0. elim (option_sum _ (MapGet A m a)). intro H3. elim H3.
+ intros y H4. rewrite (MapSweep_semantics_3 _ _ _ H2 a y H4) in H1. discriminate H1.
+ intro H3. rewrite H3 in H0. discriminate H0.
Qed.
- Lemma MapDisjoint_imp_2 : (m:(Map A)) (m':(Map B)) (MapDisjoint m m') ->
- (MapDisjoint_2 m m').
+ Lemma MapDisjoint_imp_2 :
+ forall (m:Map A) (m':Map B), MapDisjoint m m' -> MapDisjoint_2 m m'.
Proof.
- Unfold MapDisjoint MapDisjoint_2. Unfold eqmap eqm. Intros.
- Rewrite (MapDomRestrTo_semantics A B m m' a).
- Cut (in_dom A a m)=true->(in_dom B a m')=true->False. Intro.
- Elim (option_sum ? (MapGet A m a)). Intro H1. Elim H1. Intros y H2. Unfold 1 in_dom in H0.
- Elim (option_sum ? (MapGet B m' a)). Intro H3. Elim H3. Intros y' H4. Unfold 1 in_dom in H0.
- Rewrite H4 in H0. Rewrite H2 in H0. Elim (H0 (refl_equal ? ?) (refl_equal ? ?)).
- Intro H3. Rewrite H3. Reflexivity.
- Intro H1. Rewrite H1. Case (MapGet B m' a); Reflexivity.
- Exact (H a).
+ unfold MapDisjoint, MapDisjoint_2 in |- *. unfold eqmap, eqm in |- *. intros.
+ rewrite (MapDomRestrTo_semantics A B m m' a).
+ cut (in_dom A a m = true -> in_dom B a m' = true -> False). intro.
+ elim (option_sum _ (MapGet A m a)). intro H1. elim H1. intros y H2. unfold in_dom at 1 in H0.
+ elim (option_sum _ (MapGet B m' a)). intro H3. elim H3. intros y' H4. unfold in_dom at 1 in H0.
+ rewrite H4 in H0. rewrite H2 in H0. elim (H0 (refl_equal _) (refl_equal _)).
+ intro H3. rewrite H3. reflexivity.
+ intro H1. rewrite H1. case (MapGet B m' a); reflexivity.
+ exact (H a).
Qed.
- Lemma MapDisjoint_2_imp : (m:(Map A)) (m':(Map B)) (MapDisjoint_2 m m') ->
- (MapDisjoint m m').
+ Lemma MapDisjoint_2_imp :
+ forall (m:Map A) (m':Map B), MapDisjoint_2 m m' -> MapDisjoint m m'.
Proof.
- Unfold MapDisjoint MapDisjoint_2. Unfold eqmap eqm. Intros. Elim (in_dom_some ? ? ? H0).
- Intros y H2. Elim (in_dom_some ? ? ? H1). Intros y' H3.
- Cut (MapGet A (MapDomRestrTo A B m m') a)=(NONE A). Intro.
- Rewrite (MapDomRestrTo_semantics ? ? m m' a) in H4. Rewrite H3 in H4. Rewrite H2 in H4.
- Discriminate H4.
- Exact (H a).
+ unfold MapDisjoint, MapDisjoint_2 in |- *. unfold eqmap, eqm in |- *. intros. elim (in_dom_some _ _ _ H0).
+ intros y H2. elim (in_dom_some _ _ _ H1). intros y' H3.
+ cut (MapGet A (MapDomRestrTo A B m m') a = NONE A). intro.
+ rewrite (MapDomRestrTo_semantics _ _ m m' a) in H4. rewrite H3 in H4. rewrite H2 in H4.
+ discriminate H4.
+ exact (H a).
Qed.
- Lemma Map_M0_disjoint : (m:(Map B)) (MapDisjoint (M0 A) m).
+ Lemma Map_M0_disjoint : forall m:Map B, MapDisjoint (M0 A) m.
Proof.
- Unfold MapDisjoint in_dom. Intros. Discriminate H.
+ unfold MapDisjoint, in_dom in |- *. intros. discriminate H.
Qed.
- Lemma Map_disjoint_M0 : (m:(Map A)) (MapDisjoint m (M0 B)).
+ Lemma Map_disjoint_M0 : forall m:Map A, MapDisjoint m (M0 B).
Proof.
- Unfold MapDisjoint in_dom. Intros. Discriminate H0.
+ unfold MapDisjoint, in_dom in |- *. intros. discriminate H0.
Qed.
End MapDisjointDef.
Section MapDisjointExtra.
- Variable A, B : Set.
+ Variables A B : Set.
- Lemma MapDisjoint_ext : (m0,m1:(Map A)) (m2,m3:(Map B))
- (eqmap A m0 m1) -> (eqmap B m2 m3) ->
- (MapDisjoint A B m0 m2) -> (MapDisjoint A B m1 m3).
+ Lemma MapDisjoint_ext :
+ forall (m0 m1:Map A) (m2 m3:Map B),
+ eqmap A m0 m1 ->
+ eqmap B m2 m3 -> MapDisjoint A B m0 m2 -> MapDisjoint A B m1 m3.
Proof.
- Intros. Apply MapDisjoint_2_imp. Unfold MapDisjoint_2.
- Apply eqmap_trans with m':=(MapDomRestrTo A B m0 m2). Apply eqmap_sym. Apply MapDomRestrTo_ext.
- Assumption.
- Assumption.
- Exact (MapDisjoint_imp_2 ? ? ? ? H1).
+ intros. apply MapDisjoint_2_imp. unfold MapDisjoint_2 in |- *.
+ apply eqmap_trans with (m' := MapDomRestrTo A B m0 m2). apply eqmap_sym. apply MapDomRestrTo_ext.
+ assumption.
+ assumption.
+ exact (MapDisjoint_imp_2 _ _ _ _ H1).
Qed.
- Lemma MapMerge_disjoint : (m,m':(Map A)) (MapDisjoint A A m m') ->
- (a:ad) (in_dom A a (MapMerge A m m'))=
- (orb (andb (in_dom A a m) (negb (in_dom A a m')))
- (andb (in_dom A a m') (negb (in_dom A a m)))).
+ Lemma MapMerge_disjoint :
+ forall m m':Map A,
+ MapDisjoint A A m m' ->
+ forall a:ad,
+ in_dom A a (MapMerge A m m') =
+ orb (andb (in_dom A a m) (negb (in_dom A a m')))
+ (andb (in_dom A a m') (negb (in_dom A a m))).
Proof.
- Unfold MapDisjoint. Intros. Rewrite in_dom_merge. Elim (sumbool_of_bool (in_dom A a m)).
- Intro H0. Rewrite H0. Elim (sumbool_of_bool (in_dom A a m')). Intro H1. Elim (H a H0 H1).
- Intro H1. Rewrite H1. Reflexivity.
- Intro H0. Rewrite H0. Simpl. Rewrite andb_b_true. Reflexivity.
+ unfold MapDisjoint in |- *. intros. rewrite in_dom_merge. elim (sumbool_of_bool (in_dom A a m)).
+ intro H0. rewrite H0. elim (sumbool_of_bool (in_dom A a m')). intro H1. elim (H a H0 H1).
+ intro H1. rewrite H1. reflexivity.
+ intro H0. rewrite H0. simpl in |- *. rewrite andb_b_true. reflexivity.
Qed.
- Lemma MapDisjoint_M2_l : (m0,m1:(Map A)) (m2,m3:(Map B))
- (MapDisjoint A B (M2 A m0 m1) (M2 B m2 m3)) -> (MapDisjoint A B m0 m2).
+ Lemma MapDisjoint_M2_l :
+ forall (m0 m1:Map A) (m2 m3:Map B),
+ MapDisjoint A B (M2 A m0 m1) (M2 B m2 m3) -> MapDisjoint A B m0 m2.
Proof.
- Unfold MapDisjoint in_dom. Intros. Elim (option_sum ? (MapGet A m0 a)). Intro H2.
- Elim H2. Intros y H3. Elim (option_sum ? (MapGet B m2 a)). Intro H4. Elim H4.
- Intros y' H5. Apply (H (ad_double a)).
- Rewrite (MapGet_M2_bit_0_0 ? (ad_double a) (ad_double_bit_0 a) m0 m1).
- Rewrite (ad_double_div_2 a). Rewrite H3. Reflexivity.
- Rewrite (MapGet_M2_bit_0_0 ? (ad_double a) (ad_double_bit_0 a) m2 m3).
- Rewrite (ad_double_div_2 a). Rewrite H5. Reflexivity.
- Intro H4. Rewrite H4 in H1. Discriminate H1.
- Intro H2. Rewrite H2 in H0. Discriminate H0.
+ unfold MapDisjoint, in_dom in |- *. intros. elim (option_sum _ (MapGet A m0 a)). intro H2.
+ elim H2. intros y H3. elim (option_sum _ (MapGet B m2 a)). intro H4. elim H4.
+ intros y' H5. apply (H (ad_double a)).
+ rewrite (MapGet_M2_bit_0_0 _ (ad_double a) (ad_double_bit_0 a) m0 m1).
+ rewrite (ad_double_div_2 a). rewrite H3. reflexivity.
+ rewrite (MapGet_M2_bit_0_0 _ (ad_double a) (ad_double_bit_0 a) m2 m3).
+ rewrite (ad_double_div_2 a). rewrite H5. reflexivity.
+ intro H4. rewrite H4 in H1. discriminate H1.
+ intro H2. rewrite H2 in H0. discriminate H0.
Qed.
- Lemma MapDisjoint_M2_r : (m0,m1:(Map A)) (m2,m3:(Map B))
- (MapDisjoint A B (M2 A m0 m1) (M2 B m2 m3)) -> (MapDisjoint A B m1 m3).
+ Lemma MapDisjoint_M2_r :
+ forall (m0 m1:Map A) (m2 m3:Map B),
+ MapDisjoint A B (M2 A m0 m1) (M2 B m2 m3) -> MapDisjoint A B m1 m3.
Proof.
- Unfold MapDisjoint in_dom. Intros. Elim (option_sum ? (MapGet A m1 a)). Intro H2.
- Elim H2. Intros y H3. Elim (option_sum ? (MapGet B m3 a)). Intro H4. Elim H4.
- Intros y' H5. Apply (H (ad_double_plus_un a)).
- Rewrite (MapGet_M2_bit_0_1 ? (ad_double_plus_un a) (ad_double_plus_un_bit_0 a) m0 m1).
- Rewrite (ad_double_plus_un_div_2 a). Rewrite H3. Reflexivity.
- Rewrite (MapGet_M2_bit_0_1 ? (ad_double_plus_un a) (ad_double_plus_un_bit_0 a) m2 m3).
- Rewrite (ad_double_plus_un_div_2 a). Rewrite H5. Reflexivity.
- Intro H4. Rewrite H4 in H1. Discriminate H1.
- Intro H2. Rewrite H2 in H0. Discriminate H0.
+ unfold MapDisjoint, in_dom in |- *. intros. elim (option_sum _ (MapGet A m1 a)). intro H2.
+ elim H2. intros y H3. elim (option_sum _ (MapGet B m3 a)). intro H4. elim H4.
+ intros y' H5. apply (H (ad_double_plus_un a)).
+ rewrite
+ (MapGet_M2_bit_0_1 _ (ad_double_plus_un a) (ad_double_plus_un_bit_0 a)
+ m0 m1).
+ rewrite (ad_double_plus_un_div_2 a). rewrite H3. reflexivity.
+ rewrite
+ (MapGet_M2_bit_0_1 _ (ad_double_plus_un a) (ad_double_plus_un_bit_0 a)
+ m2 m3).
+ rewrite (ad_double_plus_un_div_2 a). rewrite H5. reflexivity.
+ intro H4. rewrite H4 in H1. discriminate H1.
+ intro H2. rewrite H2 in H0. discriminate H0.
Qed.
- Lemma MapDisjoint_M2 : (m0,m1:(Map A)) (m2,m3:(Map B))
- (MapDisjoint A B m0 m2) -> (MapDisjoint A B m1 m3) ->
- (MapDisjoint A B (M2 A m0 m1) (M2 B m2 m3)).
+ Lemma MapDisjoint_M2 :
+ forall (m0 m1:Map A) (m2 m3:Map B),
+ MapDisjoint A B m0 m2 ->
+ MapDisjoint A B m1 m3 -> MapDisjoint A B (M2 A m0 m1) (M2 B m2 m3).
Proof.
- Unfold MapDisjoint in_dom. Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H3.
- Rewrite (MapGet_M2_bit_0_1 A a H3 m0 m1) in H1.
- Rewrite (MapGet_M2_bit_0_1 B a H3 m2 m3) in H2. Exact (H0 (ad_div_2 a) H1 H2).
- Intro H3. Rewrite (MapGet_M2_bit_0_0 A a H3 m0 m1) in H1.
- Rewrite (MapGet_M2_bit_0_0 B a H3 m2 m3) in H2. Exact (H (ad_div_2 a) H1 H2).
+ unfold MapDisjoint, in_dom in |- *. intros. elim (sumbool_of_bool (ad_bit_0 a)). intro H3.
+ rewrite (MapGet_M2_bit_0_1 A a H3 m0 m1) in H1.
+ rewrite (MapGet_M2_bit_0_1 B a H3 m2 m3) in H2. exact (H0 (ad_div_2 a) H1 H2).
+ intro H3. rewrite (MapGet_M2_bit_0_0 A a H3 m0 m1) in H1.
+ rewrite (MapGet_M2_bit_0_0 B a H3 m2 m3) in H2. exact (H (ad_div_2 a) H1 H2).
Qed.
- Lemma MapDisjoint_M1_l : (m:(Map A)) (a:ad) (y:B)
- (MapDisjoint B A (M1 B a y) m) -> (in_dom A a m)=false.
+ Lemma MapDisjoint_M1_l :
+ forall (m:Map A) (a:ad) (y:B),
+ MapDisjoint B A (M1 B a y) m -> in_dom A a m = false.
Proof.
- Unfold MapDisjoint. Intros. Elim (sumbool_of_bool (in_dom A a m)). Intro H0.
- Elim (H a (in_dom_M1_1 B a y) H0).
- Trivial.
+ unfold MapDisjoint in |- *. intros. elim (sumbool_of_bool (in_dom A a m)). intro H0.
+ elim (H a (in_dom_M1_1 B a y) H0).
+ trivial.
Qed.
- Lemma MapDisjoint_M1_r : (m:(Map A)) (a:ad) (y:B)
- (MapDisjoint A B m (M1 B a y)) -> (in_dom A a m)=false.
+ Lemma MapDisjoint_M1_r :
+ forall (m:Map A) (a:ad) (y:B),
+ MapDisjoint A B m (M1 B a y) -> in_dom A a m = false.
Proof.
- Unfold MapDisjoint. Intros. Elim (sumbool_of_bool (in_dom A a m)). Intro H0.
- Elim (H a H0 (in_dom_M1_1 B a y)).
- Trivial.
+ unfold MapDisjoint in |- *. intros. elim (sumbool_of_bool (in_dom A a m)). intro H0.
+ elim (H a H0 (in_dom_M1_1 B a y)).
+ trivial.
Qed.
- Lemma MapDisjoint_M1_conv_l : (m:(Map A)) (a:ad) (y:B)
- (in_dom A a m)=false -> (MapDisjoint B A (M1 B a y) m).
+ Lemma MapDisjoint_M1_conv_l :
+ forall (m:Map A) (a:ad) (y:B),
+ in_dom A a m = false -> MapDisjoint B A (M1 B a y) m.
Proof.
- Unfold MapDisjoint. Intros. Rewrite (in_dom_M1_2 B a a0 y H0) in H. Rewrite H1 in H.
- Discriminate H.
+ unfold MapDisjoint in |- *. intros. rewrite (in_dom_M1_2 B a a0 y H0) in H. rewrite H1 in H.
+ discriminate H.
Qed.
- Lemma MapDisjoint_M1_conv_r : (m:(Map A)) (a:ad) (y:B)
- (in_dom A a m)=false -> (MapDisjoint A B m (M1 B a y)).
+ Lemma MapDisjoint_M1_conv_r :
+ forall (m:Map A) (a:ad) (y:B),
+ in_dom A a m = false -> MapDisjoint A B m (M1 B a y).
Proof.
- Unfold MapDisjoint. Intros. Rewrite (in_dom_M1_2 B a a0 y H1) in H. Rewrite H0 in H.
- Discriminate H.
+ unfold MapDisjoint in |- *. intros. rewrite (in_dom_M1_2 B a a0 y H1) in H. rewrite H0 in H.
+ discriminate H.
Qed.
- Lemma MapDisjoint_sym : (m:(Map A)) (m':(Map B))
- (MapDisjoint A B m m') -> (MapDisjoint B A m' m).
+ Lemma MapDisjoint_sym :
+ forall (m:Map A) (m':Map B), MapDisjoint A B m m' -> MapDisjoint B A m' m.
Proof.
- Unfold MapDisjoint. Intros. Exact (H ? H1 H0).
+ unfold MapDisjoint in |- *. intros. exact (H _ H1 H0).
Qed.
- Lemma MapDisjoint_empty : (m:(Map A)) (MapDisjoint A A m m) -> (eqmap A m (M0 A)).
+ Lemma MapDisjoint_empty :
+ forall m:Map A, MapDisjoint A A m m -> eqmap A m (M0 A).
Proof.
- Unfold eqmap eqm. Intros. Rewrite <- (MapDomRestrTo_idempotent A m a).
- Exact (MapDisjoint_imp_2 A A m m H a).
+ unfold eqmap, eqm in |- *. intros. rewrite <- (MapDomRestrTo_idempotent A m a).
+ exact (MapDisjoint_imp_2 A A m m H a).
Qed.
- Lemma MapDelta_disjoint : (m,m':(Map A)) (MapDisjoint A A m m') ->
- (eqmap A (MapDelta A m m') (MapMerge A m m')).
+ Lemma MapDelta_disjoint :
+ forall m m':Map A,
+ MapDisjoint A A m m' -> eqmap A (MapDelta A m m') (MapMerge A m m').
Proof.
- Intros.
- Apply eqmap_trans with m':=(MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m m')).
- Apply MapDelta_as_DomRestrBy.
- Apply eqmap_trans with m':=(MapDomRestrBy A A (MapMerge A m m') (M0 A)).
- Apply MapDomRestrBy_ext. Apply eqmap_refl.
- Exact (MapDisjoint_imp_2 A A m m' H).
- Apply MapDomRestrBy_m_empty.
+ intros.
+ apply eqmap_trans with
+ (m' := MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m m')).
+ apply MapDelta_as_DomRestrBy.
+ apply eqmap_trans with (m' := MapDomRestrBy A A (MapMerge A m m') (M0 A)).
+ apply MapDomRestrBy_ext. apply eqmap_refl.
+ exact (MapDisjoint_imp_2 A A m m' H).
+ apply MapDomRestrBy_m_empty.
Qed.
Variable C : Set.
- Lemma MapDomRestr_disjoint : (m:(Map A)) (m':(Map B)) (m'':(Map C))
- (MapDisjoint A B (MapDomRestrTo A C m m'') (MapDomRestrBy B C m' m'')).
+ Lemma MapDomRestr_disjoint :
+ forall (m:Map A) (m':Map B) (m'':Map C),
+ MapDisjoint A B (MapDomRestrTo A C m m'') (MapDomRestrBy B C m' m'').
Proof.
- Unfold MapDisjoint. Intros m m' m'' a. Rewrite in_dom_restrto. Rewrite in_dom_restrby.
- Intros. Elim (andb_prop ? ? H). Elim (andb_prop ? ? H0). Intros. Rewrite H4 in H2.
- Discriminate H2.
+ unfold MapDisjoint in |- *. intros m m' m'' a. rewrite in_dom_restrto. rewrite in_dom_restrby.
+ intros. elim (andb_prop _ _ H). elim (andb_prop _ _ H0). intros. rewrite H4 in H2.
+ discriminate H2.
Qed.
- Lemma MapDelta_RestrTo_disjoint : (m,m':(Map A))
- (MapDisjoint A A (MapDelta A m m') (MapDomRestrTo A A m m')).
+ Lemma MapDelta_RestrTo_disjoint :
+ forall m m':Map A,
+ MapDisjoint A A (MapDelta A m m') (MapDomRestrTo A A m m').
Proof.
- Unfold MapDisjoint. Intros m m' a. Rewrite in_dom_delta. Rewrite in_dom_restrto.
- Intros. Elim (andb_prop ? ? H0). Intros. Rewrite H1 in H. Rewrite H2 in H. Discriminate H.
+ unfold MapDisjoint in |- *. intros m m' a. rewrite in_dom_delta. rewrite in_dom_restrto.
+ intros. elim (andb_prop _ _ H0). intros. rewrite H1 in H. rewrite H2 in H. discriminate H.
Qed.
- Lemma MapDelta_RestrTo_disjoint_2 : (m,m':(Map A))
- (MapDisjoint A A (MapDelta A m m') (MapDomRestrTo A A m' m)).
+ Lemma MapDelta_RestrTo_disjoint_2 :
+ forall m m':Map A,
+ MapDisjoint A A (MapDelta A m m') (MapDomRestrTo A A m' m).
Proof.
- Unfold MapDisjoint. Intros m m' a. Rewrite in_dom_delta. Rewrite in_dom_restrto.
- Intros. Elim (andb_prop ? ? H0). Intros. Rewrite H1 in H. Rewrite H2 in H. Discriminate H.
+ unfold MapDisjoint in |- *. intros m m' a. rewrite in_dom_delta. rewrite in_dom_restrto.
+ intros. elim (andb_prop _ _ H0). intros. rewrite H1 in H. rewrite H2 in H. discriminate H.
Qed.
Variable D : Set.
- Lemma MapSubset_Disjoint : (m:(Map A)) (m':(Map B)) (m'':(Map C)) (m''':(Map D))
- (MapSubset ? ? m m') -> (MapSubset ? ? m'' m''') -> (MapDisjoint ? ? m' m''') ->
- (MapDisjoint ? ? m m'').
+ Lemma MapSubset_Disjoint :
+ forall (m:Map A) (m':Map B) (m'':Map C) (m''':Map D),
+ MapSubset _ _ m m' ->
+ MapSubset _ _ m'' m''' ->
+ MapDisjoint _ _ m' m''' -> MapDisjoint _ _ m m''.
Proof.
- Unfold MapSubset MapDisjoint. Intros. Exact (H1 ? (H ? H2) (H0 ? H3)).
+ unfold MapSubset, MapDisjoint in |- *. intros. exact (H1 _ (H _ H2) (H0 _ H3)).
Qed.
- Lemma MapSubset_Disjoint_l : (m:(Map A)) (m':(Map B)) (m'':(Map C))
- (MapSubset ? ? m m') -> (MapDisjoint ? ? m' m'') ->
- (MapDisjoint ? ? m m'').
+ Lemma MapSubset_Disjoint_l :
+ forall (m:Map A) (m':Map B) (m'':Map C),
+ MapSubset _ _ m m' -> MapDisjoint _ _ m' m'' -> MapDisjoint _ _ m m''.
Proof.
- Unfold MapSubset MapDisjoint. Intros. Exact (H0 ? (H ? H1) H2).
+ unfold MapSubset, MapDisjoint in |- *. intros. exact (H0 _ (H _ H1) H2).
Qed.
- Lemma MapSubset_Disjoint_r : (m:(Map A)) (m'':(Map C)) (m''':(Map D))
- (MapSubset ? ? m'' m''') -> (MapDisjoint ? ? m m''') ->
- (MapDisjoint ? ? m m'').
+ Lemma MapSubset_Disjoint_r :
+ forall (m:Map A) (m'':Map C) (m''':Map D),
+ MapSubset _ _ m'' m''' ->
+ MapDisjoint _ _ m m''' -> MapDisjoint _ _ m m''.
Proof.
- Unfold MapSubset MapDisjoint. Intros. Exact (H0 ? H1 (H ? H2)).
+ unfold MapSubset, MapDisjoint in |- *. intros. exact (H0 _ H1 (H _ H2)).
Qed.
-End MapDisjointExtra.
+End MapDisjointExtra. \ No newline at end of file
diff --git a/theories/Lists/List.v b/theories/Lists/List.v
index 7e6cf4c88..1eb095c14 100755
--- a/theories/Lists/List.v
+++ b/theories/Lists/List.v
@@ -8,254 +8,643 @@
(*i $Id$ i*)
-(* This file is a copy of file MonoList.v *)
+Require Import Le.
-(** THIS IS A OLD CONTRIB. IT IS NO LONGER MAINTAINED ***)
-Require Le.
+Section Lists.
-Parameter List_Dom:Set.
-Definition A := List_Dom.
+Variable A : Set.
-Inductive list : Set := nil : list | cons : A -> list -> list.
+Set Implicit Arguments.
-Fixpoint app [l:list] : list -> list
- := [m:list]<list>Cases l of
- nil => m
- | (cons a l1) => (cons a (app l1 m))
- end.
+Inductive list : Set :=
+ | nil : list
+ | cons : A -> list -> list.
+Infix "::" := cons (at level 60, right associativity) : list_scope.
-Lemma app_nil_end : (l:list)(l=(app l nil)).
+Open Scope list_scope.
+
+(*************************)
+(** Discrimination *)
+(*************************)
+
+Lemma nil_cons : forall (a:A) (m:list), nil <> a :: m.
Proof.
- Intro l ; Elim l ; Simpl ; Auto.
- Induction 1; Auto.
+ intros; discriminate.
Qed.
-Hints Resolve app_nil_end : list v62.
-Lemma app_ass : (l,m,n : list)(app (app l m) n)=(app l (app m n)).
+(*************************)
+(** Concatenation *)
+(*************************)
+
+Fixpoint app (l m:list) {struct l} : list :=
+ match l with
+ | nil => m
+ | a :: l1 => a :: app l1 m
+ end.
+
+Infix "++" := app (right associativity, at level 60) : list_scope.
+
+Lemma app_nil_end : forall l:list, l = l ++ nil.
Proof.
- Intros l m n ; Elim l ; Simpl ; Auto with list.
- Induction 1; Auto with list.
+ induction l; simpl in |- *; auto.
+ rewrite <- IHl; auto.
Qed.
-Hints Resolve app_ass : list v62.
+Hint Resolve app_nil_end.
+
+Ltac now_show c := change c in |- *.
-Lemma ass_app : (l,m,n : list)(app l (app m n))=(app (app l m) n).
+Lemma app_ass : forall l m n:list, (l ++ m) ++ n = l ++ m ++ n.
Proof.
- Auto with list.
+ intros. induction l; simpl in |- *; auto.
+ now_show (a :: (l ++ m) ++ n = a :: l ++ m ++ n).
+ rewrite <- IHl; auto.
Qed.
-Hints Resolve ass_app : list v62.
+Hint Resolve app_ass.
-Definition tail :=
- [l:list] <list>Cases l of (cons _ m) => m | _ => nil end : list->list.
-
+Lemma ass_app : forall l m n:list, l ++ m ++ n = (l ++ m) ++ n.
+Proof.
+ auto.
+Qed.
+Hint Resolve ass_app.
-Lemma nil_cons : (a:A)(m:list)~nil=(cons a m).
- Intros; Discriminate.
+Lemma app_comm_cons : forall (x y:list) (a:A), a :: x ++ y = (a :: x) ++ y.
+Proof.
+ auto.
Qed.
+Lemma app_eq_nil : forall x y:list, x ++ y = nil -> x = nil /\ y = nil.
+Proof.
+ destruct x as [| a l]; [ destruct y as [| a l] | destruct y as [| a0 l0] ];
+ simpl in |- *; auto.
+ intros H; discriminate H.
+ intros; discriminate H.
+Qed.
+
+Lemma app_cons_not_nil : forall (x y:list) (a:A), nil <> x ++ a :: y.
+Proof.
+unfold not in |- *.
+ destruct x as [| a l]; simpl in |- *; intros.
+ discriminate H.
+ discriminate H.
+Qed.
+
+Lemma app_eq_unit :
+ forall (x y:list) (a:A),
+ x ++ y = a :: nil -> x = nil /\ y = a :: nil \/ x = a :: nil /\ y = nil.
+
+Proof.
+ destruct x as [| a l]; [ destruct y as [| a l] | destruct y as [| a0 l0] ];
+ simpl in |- *.
+ intros a H; discriminate H.
+ left; split; auto.
+ right; split; auto.
+ generalize H.
+ generalize (app_nil_end l); intros E.
+ rewrite <- E; auto.
+ intros.
+ injection H.
+ intro.
+ cut (nil = l ++ a0 :: l0); auto.
+ intro.
+ generalize (app_cons_not_nil _ _ _ H1); intro.
+ elim H2.
+Qed.
+
+Lemma app_inj_tail :
+ forall (x y:list) (a b:A), x ++ a :: nil = y ++ b :: nil -> x = y /\ a = b.
+Proof.
+ induction x as [| x l IHl];
+ [ destruct y as [| a l] | destruct y as [| a l0] ];
+ simpl in |- *; auto.
+ intros a b H.
+ injection H.
+ auto.
+ intros a0 b H.
+ injection H; intros.
+ generalize (app_cons_not_nil _ _ _ H0); destruct 1.
+ intros a b H.
+ injection H; intros.
+ cut (nil = l ++ a :: nil); auto.
+ intro.
+ generalize (app_cons_not_nil _ _ _ H2); destruct 1.
+ intros a0 b H.
+ injection H; intros.
+ destruct (IHl l0 a0 b H0).
+ split; auto.
+ rewrite <- H1; rewrite <- H2; reflexivity.
+Qed.
+
+(*************************)
+(** Head and tail *)
+(*************************)
+
+Definition head (l:list) :=
+ match l with
+ | nil => error
+ | x :: _ => value x
+ end.
+
+Definition tail (l:list) : list :=
+ match l with
+ | nil => nil
+ | a :: m => m
+ end.
+
(****************************************)
-(* Length of lists *)
+(** Length of lists *)
(****************************************)
-Fixpoint length [l:list] : nat
- := <nat>Cases l of (cons _ m) => (S (length m)) | _ => O end.
+Fixpoint length (l:list) : nat :=
+ match l with
+ | nil => 0
+ | _ :: m => S (length m)
+ end.
(******************************)
-(* Length order of lists *)
+(** Length order of lists *)
(******************************)
Section length_order.
-Definition lel := [l,m:list](le (length l) (length m)).
+Definition lel (l m:list) := length l <= length m.
-Hints Unfold lel : list.
+Variables a b : A.
+Variables l m n : list.
-Variables a,b:A.
-Variables l,m,n:list.
-
-Lemma lel_refl : (lel l l).
+Lemma lel_refl : lel l l.
Proof.
- Unfold lel ; Auto with list.
+ unfold lel in |- *; auto with arith.
Qed.
-Lemma lel_trans : (lel l m)->(lel m n)->(lel l n).
+Lemma lel_trans : lel l m -> lel m n -> lel l n.
Proof.
- Unfold lel ; Intros.
- Apply le_trans with (length m) ; Auto with list.
+ unfold lel in |- *; intros.
+ now_show (length l <= length n).
+ apply le_trans with (length m); auto with arith.
Qed.
-Lemma lel_cons_cons : (lel l m)->(lel (cons a l) (cons b m)).
+Lemma lel_cons_cons : lel l m -> lel (a :: l) (b :: m).
Proof.
- Unfold lel ; Simpl ; Auto with list arith.
+ unfold lel in |- *; simpl in |- *; auto with arith.
Qed.
-Lemma lel_cons : (lel l m)->(lel l (cons b m)).
+Lemma lel_cons : lel l m -> lel l (b :: m).
Proof.
- Unfold lel ; Simpl ; Auto with list arith.
+ unfold lel in |- *; simpl in |- *; auto with arith.
Qed.
-Lemma lel_tail : (lel (cons a l) (cons b m)) -> (lel l m).
+Lemma lel_tail : lel (a :: l) (b :: m) -> lel l m.
Proof.
- Unfold lel ; Simpl ; Auto with list arith.
+ unfold lel in |- *; simpl in |- *; auto with arith.
Qed.
-Lemma lel_nil : (l':list)(lel l' nil)->(nil=l').
+Lemma lel_nil : forall l':list, lel l' nil -> nil = l'.
Proof.
- Intro l' ; Elim l' ; Auto with list arith.
- Intros a' y H H0.
- (* <list>nil=(cons a' y)
- ============================
- H0 : (lel (cons a' y) nil)
- H : (lel y nil)->(<list>nil=y)
- y : list
- a' : A
- l' : list *)
- Absurd (le (S (length y)) O); Auto with list arith.
+ intro l'; elim l'; auto with arith.
+ intros a' y H H0.
+ now_show (nil = a' :: y).
+ absurd (S (length y) <= 0); auto with arith.
Qed.
End length_order.
-Hints Resolve lel_refl lel_cons_cons lel_cons lel_nil lel_nil nil_cons : list v62.
+Hint Resolve lel_refl lel_cons_cons lel_cons lel_nil lel_nil nil_cons.
+
+(*********************************)
+(** The [In] predicate *)
+(*********************************)
+
+Fixpoint In (a:A) (l:list) {struct l} : Prop :=
+ match l with
+ | nil => False
+ | b :: m => b = a \/ In a m
+ end.
+
+Lemma in_eq : forall (a:A) (l:list), In a (a :: l).
+Proof.
+ simpl in |- *; auto.
+Qed.
+Hint Resolve in_eq.
+
+Lemma in_cons : forall (a b:A) (l:list), In b l -> In b (a :: l).
+Proof.
+ simpl in |- *; auto.
+Qed.
+Hint Resolve in_cons.
+
+Lemma in_nil : forall a:A, ~ In a nil.
+Proof.
+ unfold not in |- *; intros a H; inversion_clear H.
+Qed.
+
+
+Lemma in_inv : forall (a b:A) (l:list), In b (a :: l) -> a = b \/ In b l.
+Proof.
+ intros a b l H; inversion_clear H; auto.
+Qed.
+
+Lemma In_dec :
+ (forall x y:A, {x = y} + {x <> y}) ->
+ forall (a:A) (l:list), {In a l} + {~ In a l}.
+
+Proof.
+ induction l as [| a0 l IHl].
+ right; apply in_nil.
+ destruct (H a0 a); simpl in |- *; auto.
+ destruct IHl; simpl in |- *; auto.
+ right; unfold not in |- *; intros [Hc1| Hc2]; auto.
+Qed.
+
+Lemma in_app_or : forall (l m:list) (a:A), In a (l ++ m) -> In a l \/ In a m.
+Proof.
+ intros l m a.
+ elim l; simpl in |- *; auto.
+ intros a0 y H H0.
+ now_show ((a0 = a \/ In a y) \/ In a m).
+ elim H0; auto.
+ intro H1.
+ now_show ((a0 = a \/ In a y) \/ In a m).
+ elim (H H1); auto.
+Qed.
+Hint Immediate in_app_or.
+
+Lemma in_or_app : forall (l m:list) (a:A), In a l \/ In a m -> In a (l ++ m).
+Proof.
+ intros l m a.
+ elim l; simpl in |- *; intro H.
+ now_show (In a m).
+ elim H; auto; intro H0.
+ now_show (In a m).
+ elim H0. (* subProof completed *)
+ intros y H0 H1.
+ now_show (H = a \/ In a (y ++ m)).
+ elim H1; auto 4.
+ intro H2.
+ now_show (H = a \/ In a (y ++ m)).
+ elim H2; auto.
+Qed.
+Hint Resolve in_or_app.
+
+(***************************)
+(** Set inclusion on list *)
+(***************************)
-Fixpoint In [a:A;l:list] : Prop :=
- Cases l of
- nil => False
- | (cons b m) => (b=a)\/(In a m)
- end.
+Definition incl (l m:list) := forall a:A, In a l -> In a m.
+Hint Unfold incl.
-Lemma in_eq : (a:A)(l:list)(In a (cons a l)).
+Lemma incl_refl : forall l:list, incl l l.
Proof.
- Simpl ; Auto with list.
+ auto.
Qed.
-Hints Resolve in_eq : list v62.
+Hint Resolve incl_refl.
-Lemma in_cons : (a,b:A)(l:list)(In b l)->(In b (cons a l)).
+Lemma incl_tl : forall (a:A) (l m:list), incl l m -> incl l (a :: m).
Proof.
- Simpl ; Auto with list.
+ auto.
Qed.
-Hints Resolve in_cons : list v62.
+Hint Immediate incl_tl.
-Lemma in_app_or : (l,m:list)(a:A)(In a (app l m))->((In a l)\/(In a m)).
+Lemma incl_tran : forall l m n:list, incl l m -> incl m n -> incl l n.
Proof.
- Intros l m a.
- Elim l ; Simpl ; Auto with list.
- Intros a0 y H H0.
- (* ((<A>a0=a)\/(In a y))\/(In a m)
- ============================
- H0 : (<A>a0=a)\/(In a (app y m))
- H : (In a (app y m))->((In a y)\/(In a m))
- y : list
- a0 : A
- a : A
- m : list
- l : list *)
- Elim H0 ; Auto with list.
- Intro H1.
- (* ((<A>a0=a)\/(In a y))\/(In a m)
- ============================
- H1 : (In a (app y m)) *)
- Elim (H H1) ; Auto with list.
-Qed.
-Hints Immediate in_app_or : list v62.
-
-Lemma in_or_app : (l,m:list)(a:A)((In a l)\/(In a m))->(In a (app l m)).
+ auto.
+Qed.
+
+Lemma incl_appl : forall l m n:list, incl l n -> incl l (n ++ m).
Proof.
- Intros l m a.
- Elim l ; Simpl ; Intro H.
- (* 1 (In a m)
- ============================
- H : False\/(In a m)
- a : A
- m : list
- l : list *)
- Elim H ; Auto with list ; Intro H0.
- (* (In a m)
- ============================
- H0 : False *)
- Elim H0. (* subProof completed *)
- Intros y H0 H1.
- (* 2 (<A>H=a)\/(In a (app y m))
- ============================
- H1 : ((<A>H=a)\/(In a y))\/(In a m)
- H0 : ((In a y)\/(In a m))->(In a (app y m))
- y : list *)
- Elim H1 ; Auto 4 with list.
- Intro H2.
- (* (<A>H=a)\/(In a (app y m))
- ============================
- H2 : (<A>H=a)\/(In a y) *)
- Elim H2 ; Auto with list.
-Qed.
-Hints Resolve in_or_app : list v62.
-
-Definition incl := [l,m:list](a:A)(In a l)->(In a m).
-
-Hints Unfold incl : list v62.
-
-Lemma incl_refl : (l:list)(incl l l).
+ auto.
+Qed.
+Hint Immediate incl_appl.
+
+Lemma incl_appr : forall l m n:list, incl l n -> incl l (m ++ n).
Proof.
- Auto with list.
+ auto.
Qed.
-Hints Resolve incl_refl : list v62.
+Hint Immediate incl_appr.
-Lemma incl_tl : (a:A)(l,m:list)(incl l m)->(incl l (cons a m)).
+Lemma incl_cons :
+ forall (a:A) (l m:list), In a m -> incl l m -> incl (a :: l) m.
Proof.
- Auto with list.
+ unfold incl in |- *; simpl in |- *; intros a l m H H0 a0 H1.
+ now_show (In a0 m).
+ elim H1.
+ now_show (a = a0 -> In a0 m).
+ elim H1; auto; intro H2.
+ now_show (a = a0 -> In a0 m).
+ elim H2; auto. (* solves subgoal *)
+ now_show (In a0 l -> In a0 m).
+ auto.
Qed.
-Hints Immediate incl_tl : list v62.
+Hint Resolve incl_cons.
-Lemma incl_tran : (l,m,n:list)(incl l m)->(incl m n)->(incl l n).
+Lemma incl_app : forall l m n:list, incl l n -> incl m n -> incl (l ++ m) n.
Proof.
- Auto with list.
+ unfold incl in |- *; simpl in |- *; intros l m n H H0 a H1.
+ now_show (In a n).
+ elim (in_app_or _ _ _ H1); auto.
+Qed.
+Hint Resolve incl_app.
+
+(**************************)
+(** Nth element of a list *)
+(**************************)
+
+Fixpoint nth (n:nat) (l:list) (default:A) {struct l} : A :=
+ match n, l with
+ | O, x :: l' => x
+ | O, other => default
+ | S m, nil => default
+ | S m, x :: t => nth m t default
+ end.
+
+Fixpoint nth_ok (n:nat) (l:list) (default:A) {struct l} : bool :=
+ match n, l with
+ | O, x :: l' => true
+ | O, other => false
+ | S m, nil => false
+ | S m, x :: t => nth_ok m t default
+ end.
+
+Lemma nth_in_or_default :
+ forall (n:nat) (l:list) (d:A), {In (nth n l d) l} + {nth n l d = d}.
+(* Realizer nth_ok. Program_all. *)
+Proof.
+ intros n l d; generalize n; induction l; intro n0.
+ right; case n0; trivial.
+ case n0; simpl in |- *.
+ auto.
+ intro n1; elim (IHl n1); auto.
Qed.
-Lemma incl_appl : (l,m,n:list)(incl l n)->(incl l (app n m)).
+Lemma nth_S_cons :
+ forall (n:nat) (l:list) (d a:A),
+ In (nth n l d) l -> In (nth (S n) (a :: l) d) (a :: l).
Proof.
- Auto with list.
+ simpl in |- *; auto.
+Qed.
+
+Fixpoint nth_error (l:list) (n:nat) {struct n} : Exc A :=
+ match n, l with
+ | O, x :: _ => value x
+ | S n, _ :: l => nth_error l n
+ | _, _ => error
+ end.
+
+Definition nth_default (default:A) (l:list) (n:nat) : A :=
+ match nth_error l n with
+ | Some x => x
+ | None => default
+ end.
+
+Lemma nth_In :
+ forall (n:nat) (l:list) (d:A), n < length l -> In (nth n l d) l.
+
+Proof.
+unfold lt in |- *; induction n as [| n hn]; simpl in |- *.
+destruct l; simpl in |- *; [ inversion 2 | auto ].
+destruct l as [| a l hl]; simpl in |- *.
+inversion 2.
+intros d ie; right; apply hn; auto with arith.
+Qed.
+
+(********************************)
+(** Decidable equality on lists *)
+(********************************)
+
+
+Lemma list_eq_dec :
+ (forall x y:A, {x = y} + {x <> y}) -> forall x y:list, {x = y} + {x <> y}.
+Proof.
+ induction x as [| a l IHl]; destruct y as [| a0 l0]; auto.
+ destruct (H a a0) as [e| e].
+ destruct (IHl l0) as [e'| e'].
+ left; rewrite e; rewrite e'; trivial.
+ right; red in |- *; intro.
+ apply e'; injection H0; trivial.
+ right; red in |- *; intro.
+ apply e; injection H0; trivial.
+Qed.
+
+(*************************)
+(** Reverse *)
+(*************************)
+
+Fixpoint rev (l:list) : list :=
+ match l with
+ | nil => nil
+ | x :: l' => rev l' ++ x :: nil
+ end.
+
+Lemma distr_rev : forall x y:list, rev (x ++ y) = rev y ++ rev x.
+Proof.
+ induction x as [| a l IHl].
+ destruct y as [| a l].
+ simpl in |- *.
+ auto.
+
+ simpl in |- *.
+ apply app_nil_end; auto.
+
+ intro y.
+ simpl in |- *.
+ rewrite (IHl y).
+ apply (app_ass (rev y) (rev l) (a :: nil)).
+Qed.
+
+Remark rev_unit : forall (l:list) (a:A), rev (l ++ a :: nil) = a :: rev l.
+Proof.
+ intros.
+ apply (distr_rev l (a :: nil)); simpl in |- *; auto.
+Qed.
+
+Lemma rev_involutive : forall l:list, rev (rev l) = l.
+Proof.
+ induction l as [| a l IHl].
+ simpl in |- *; auto.
+
+ simpl in |- *.
+ rewrite (rev_unit (rev l) a).
+ rewrite IHl; auto.
+Qed.
+
+(*********************************************)
+(** Reverse Induction Principle on Lists *)
+(*********************************************)
+
+Section Reverse_Induction.
+
+Unset Implicit Arguments.
+
+Remark rev_list_ind :
+ forall P:list -> Prop,
+ P nil ->
+ (forall (a:A) (l:list), P (rev l) -> P (rev (a :: l))) ->
+ forall l:list, P (rev l).
+Proof.
+ induction l; auto.
+Qed.
+Set Implicit Arguments.
+
+Lemma rev_ind :
+ forall P:list -> Prop,
+ P nil ->
+ (forall (x:A) (l:list), P l -> P (l ++ x :: nil)) -> forall l:list, P l.
+Proof.
+ intros.
+ generalize (rev_involutive l).
+ intros E; rewrite <- E.
+ apply (rev_list_ind P).
+ auto.
+
+ simpl in |- *.
+ intros.
+ apply (H0 a (rev l0)).
+ auto.
Qed.
-Hints Immediate incl_appl : list v62.
-Lemma incl_appr : (l,m,n:list)(incl l n)->(incl l (app m n)).
+End Reverse_Induction.
+
+End Lists.
+
+Implicit Arguments nil [A].
+
+Hint Resolve nil_cons app_nil_end ass_app app_ass: datatypes v62.
+Hint Resolve app_comm_cons app_cons_not_nil: datatypes v62.
+Hint Immediate app_eq_nil: datatypes v62.
+Hint Resolve app_eq_unit app_inj_tail: datatypes v62.
+Hint Resolve lel_refl lel_cons_cons lel_cons lel_nil lel_nil nil_cons:
+ datatypes v62.
+Hint Resolve in_eq in_cons in_inv in_nil in_app_or in_or_app: datatypes v62.
+Hint Resolve incl_refl incl_tl incl_tran incl_appl incl_appr incl_cons
+ incl_app: datatypes v62.
+
+Section Functions_on_lists.
+
+(****************************************************************)
+(** Some generic functions on lists and basic functions of them *)
+(****************************************************************)
+
+Section Map.
+Variables A B : Set.
+Variable f : A -> B.
+Fixpoint map (l:list A) : list B :=
+ match l with
+ | nil => nil
+ | cons a t => cons (f a) (map t)
+ end.
+End Map.
+
+Lemma in_map :
+ forall (A B:Set) (f:A -> B) (l:list A) (x:A), In x l -> In (f x) (map f l).
Proof.
- Auto with list.
+ induction l as [| a l IHl]; simpl in |- *;
+ [ auto
+ | destruct 1; [ left; apply f_equal with (f := f); assumption | auto ] ].
Qed.
-Hints Immediate incl_appr : list v62.
-Lemma incl_cons : (a:A)(l,m:list)(In a m)->(incl l m)->(incl (cons a l) m).
+Fixpoint flat_map (A B:Set) (f:A -> list B) (l:list A) {struct l} :
+ list B :=
+ match l with
+ | nil => nil
+ | cons x t => app (f x) (flat_map f t)
+ end.
+
+Fixpoint list_prod (A B:Set) (l:list A) (l':list B) {struct l} :
+ list (A * B) :=
+ match l with
+ | nil => nil
+ | cons x t => app (map (fun y:B => (x, y)) l') (list_prod t l')
+ end.
+
+Lemma in_prod_aux :
+ forall (A B:Set) (x:A) (y:B) (l:list B),
+ In y l -> In (x, y) (map (fun y0:B => (x, y0)) l).
Proof.
- Unfold incl ; Simpl ; Intros a l m H H0 a0 H1.
- (* (In a0 m)
- ============================
- H1 : (<A>a=a0)\/(In a0 l)
- a0 : A
- H0 : (a:A)(In a l)->(In a m)
- H : (In a m)
- m : list
- l : list
- a : A *)
- Elim H1.
- (* 1 (<A>a=a0)->(In a0 m) *)
- Elim H1 ; Auto with list ; Intro H2.
- (* (<A>a=a0)->(In a0 m)
- ============================
- H2 : <A>a=a0 *)
- Elim H2 ; Auto with list. (* solves subgoal *)
- (* 2 (In a0 l)->(In a0 m) *)
- Auto with list.
-Qed.
-Hints Resolve incl_cons : list v62.
-
-Lemma incl_app : (l,m,n:list)(incl l n)->(incl m n)->(incl (app l m) n).
+ induction l;
+ [ simpl in |- *; auto
+ | simpl in |- *; destruct 1 as [H1| ];
+ [ left; rewrite H1; trivial | right; auto ] ].
+Qed.
+
+Lemma in_prod :
+ forall (A B:Set) (l:list A) (l':list B) (x:A) (y:B),
+ In x l -> In y l' -> In (x, y) (list_prod l l').
Proof.
- Unfold incl ; Simpl ; Intros l m n H H0 a H1.
- (* (In a n)
- ============================
- H1 : (In a (app l m))
- a : A
- H0 : (a:A)(In a m)->(In a n)
- H : (a:A)(In a l)->(In a n)
- n : list
- m : list
- l : list *)
- Elim (in_app_or l m a) ; Auto with list.
-Qed.
-Hints Resolve incl_app : list v62.
+ induction l;
+ [ simpl in |- *; tauto
+ | simpl in |- *; intros; apply in_or_app; destruct H;
+ [ left; rewrite H; apply in_prod_aux; assumption | right; auto ] ].
+Qed.
+
+(** [(list_power x y)] is [y^x], or the set of sequences of elts of [y]
+ indexed by elts of [x], sorted in lexicographic order. *)
+
+Fixpoint list_power (A B:Set) (l:list A) (l':list B) {struct l} :
+ list (list (A * B)) :=
+ match l with
+ | nil => cons nil nil
+ | cons x t =>
+ flat_map (fun f:list (A * B) => map (fun y:B => cons (x, y) f) l')
+ (list_power t l')
+ end.
+
+(************************************)
+(** Left-to-right iterator on lists *)
+(************************************)
+
+Section Fold_Left_Recursor.
+Variables A B : Set.
+Variable f : A -> B -> A.
+Fixpoint fold_left (l:list B) (a0:A) {struct l} : A :=
+ match l with
+ | nil => a0
+ | cons b t => fold_left t (f a0 b)
+ end.
+End Fold_Left_Recursor.
+
+(************************************)
+(** Right-to-left iterator on lists *)
+(************************************)
+
+Section Fold_Right_Recursor.
+Variables A B : Set.
+Variable f : B -> A -> A.
+Variable a0 : A.
+Fixpoint fold_right (l:list B) : A :=
+ match l with
+ | nil => a0
+ | cons b t => f b (fold_right t)
+ end.
+End Fold_Right_Recursor.
+
+Theorem fold_symmetric :
+ forall (A:Set) (f:A -> A -> A),
+ (forall x y z:A, f x (f y z) = f (f x y) z) ->
+ (forall x y:A, f x y = f y x) ->
+ forall (a0:A) (l:list A), fold_left f l a0 = fold_right f a0 l.
+Proof.
+destruct l as [| a l].
+reflexivity.
+simpl in |- *.
+rewrite <- H0.
+generalize a0 a.
+induction l as [| a3 l IHl]; simpl in |- *.
+trivial.
+intros.
+rewrite H.
+rewrite (H0 a2).
+rewrite <- (H a1).
+rewrite (H0 a1).
+rewrite IHl.
+reflexivity.
+Qed.
+
+End Functions_on_lists.
+
+
+(** Exporting list notations *)
+
+Infix "::" := cons (at level 60, right associativity) : list_scope.
+
+Infix "++" := app (right associativity, at level 60) : list_scope.
+
+Open Scope list_scope. \ No newline at end of file
diff --git a/theories/Lists/ListSet.v b/theories/Lists/ListSet.v
index 4b7083c0a..f2fb20f72 100644
--- a/theories/Lists/ListSet.v
+++ b/theories/Lists/ListSet.v
@@ -16,374 +16,383 @@
This allow to "hide" the definitions, functions and theorems of PolyList
and to see only the ones of ListSet *)
-Require PolyList.
+Require Import List.
Set Implicit Arguments.
-V7only [Implicits nil [1].].
Section first_definitions.
Variable A : Set.
- Hypothesis Aeq_dec : (x,y:A){x=y}+{~x=y}.
+ Hypothesis Aeq_dec : forall x y:A, {x = y} + {x <> y}.
- Definition set := (list A).
+ Definition set := list A.
- Definition empty_set := (!nil ?) : set.
+ Definition empty_set : set := nil.
- Fixpoint set_add [a:A; x:set] : set :=
- Cases x of
- | nil => (cons a nil)
- | (cons a1 x1) => Cases (Aeq_dec a a1) of
- | (left _) => (cons a1 x1)
- | (right _) => (cons a1 (set_add a x1))
- end
+ Fixpoint set_add (a:A) (x:set) {struct x} : set :=
+ match x with
+ | nil => a :: nil
+ | a1 :: x1 =>
+ match Aeq_dec a a1 with
+ | left _ => a1 :: x1
+ | right _ => a1 :: set_add a x1
+ end
end.
- Fixpoint set_mem [a:A; x:set] : bool :=
- Cases x of
+ Fixpoint set_mem (a:A) (x:set) {struct x} : bool :=
+ match x with
| nil => false
- | (cons a1 x1) => Cases (Aeq_dec a a1) of
- | (left _) => true
- | (right _) => (set_mem a x1)
- end
+ | a1 :: x1 =>
+ match Aeq_dec a a1 with
+ | left _ => true
+ | right _ => set_mem a x1
+ end
end.
(** If [a] belongs to [x], removes [a] from [x]. If not, does nothing *)
- Fixpoint set_remove [a:A; x:set] : set :=
- Cases x of
+ Fixpoint set_remove (a:A) (x:set) {struct x} : set :=
+ match x with
| nil => empty_set
- | (cons a1 x1) => Cases (Aeq_dec a a1) of
- | (left _) => x1
- | (right _) => (cons a1 (set_remove a x1))
- end
+ | a1 :: x1 =>
+ match Aeq_dec a a1 with
+ | left _ => x1
+ | right _ => a1 :: set_remove a x1
+ end
end.
- Fixpoint set_inter [x:set] : set -> set :=
- Cases x of
- | nil => [y]nil
- | (cons a1 x1) => [y]if (set_mem a1 y)
- then (cons a1 (set_inter x1 y))
- else (set_inter x1 y)
+ Fixpoint set_inter (x:set) : set -> set :=
+ match x with
+ | nil => fun y => nil
+ | a1 :: x1 =>
+ fun y =>
+ if set_mem a1 y then a1 :: set_inter x1 y else set_inter x1 y
end.
- Fixpoint set_union [x,y:set] : set :=
- Cases y of
+ Fixpoint set_union (x y:set) {struct y} : set :=
+ match y with
| nil => x
- | (cons a1 y1) => (set_add a1 (set_union x y1))
+ | a1 :: y1 => set_add a1 (set_union x y1)
end.
(** returns the set of all els of [x] that does not belong to [y] *)
- Fixpoint set_diff [x:set] : set -> set :=
- [y]Cases x of
+ Fixpoint set_diff (x y:set) {struct x} : set :=
+ match x with
| nil => nil
- | (cons a1 x1) => if (set_mem a1 y)
- then (set_diff x1 y)
- else (set_add a1 (set_diff x1 y))
+ | a1 :: x1 =>
+ if set_mem a1 y then set_diff x1 y else set_add a1 (set_diff x1 y)
end.
- Definition set_In : A -> set -> Prop := (In 1!A).
+ Definition set_In : A -> set -> Prop := In (A:=A).
- Lemma set_In_dec : (a:A; x:set){(set_In a x)}+{~(set_In a x)}.
+ Lemma set_In_dec : forall (a:A) (x:set), {set_In a x} + {~ set_In a x}.
Proof.
- Unfold set_In.
+ unfold set_In in |- *.
(*** Realizer set_mem. Program_all. ***)
- Induction x.
- Auto.
- Intros a0 x0 Ha0. Case (Aeq_dec a a0); Intro eq.
- Rewrite eq; Simpl; Auto with datatypes.
- Elim Ha0.
- Auto with datatypes.
- Right; Simpl; Unfold not; Intros [Hc1 | Hc2 ]; Auto with datatypes.
+ simple induction x.
+ auto.
+ intros a0 x0 Ha0. case (Aeq_dec a a0); intro eq.
+ rewrite eq; simpl in |- *; auto with datatypes.
+ elim Ha0.
+ auto with datatypes.
+ right; simpl in |- *; unfold not in |- *; intros [Hc1| Hc2];
+ auto with datatypes.
Qed.
- Lemma set_mem_ind :
- (B:Set)(P:B->Prop)(y,z:B)(a:A)(x:set)
- ((set_In a x) -> (P y))
- ->(P z)
- ->(P (if (set_mem a x) then y else z)).
+ Lemma set_mem_ind :
+ forall (B:Set) (P:B -> Prop) (y z:B) (a:A) (x:set),
+ (set_In a x -> P y) -> P z -> P (if set_mem a x then y else z).
Proof.
- Induction x; Simpl; Intros.
- Assumption.
- Elim (Aeq_dec a a0); Auto with datatypes.
+ simple induction x; simpl in |- *; intros.
+ assumption.
+ elim (Aeq_dec a a0); auto with datatypes.
Qed.
- Lemma set_mem_ind2 :
- (B:Set)(P:B->Prop)(y,z:B)(a:A)(x:set)
- ((set_In a x) -> (P y))
- ->(~(set_In a x) -> (P z))
- ->(P (if (set_mem a x) then y else z)).
+ Lemma set_mem_ind2 :
+ forall (B:Set) (P:B -> Prop) (y z:B) (a:A) (x:set),
+ (set_In a x -> P y) ->
+ (~ set_In a x -> P z) -> P (if set_mem a x then y else z).
Proof.
- Induction x; Simpl; Intros.
- Apply H0; Red; Trivial.
- Case (Aeq_dec a a0); Auto with datatypes.
- Intro; Apply H; Intros; Auto.
- Apply H1; Red; Intro.
- Case H3; Auto.
+ simple induction x; simpl in |- *; intros.
+ apply H0; red in |- *; trivial.
+ case (Aeq_dec a a0); auto with datatypes.
+ intro; apply H; intros; auto.
+ apply H1; red in |- *; intro.
+ case H3; auto.
Qed.
Lemma set_mem_correct1 :
- (a:A)(x:set)(set_mem a x)=true -> (set_In a x).
+ forall (a:A) (x:set), set_mem a x = true -> set_In a x.
Proof.
- Induction x; Simpl.
- Discriminate.
- Intros a0 l; Elim (Aeq_dec a a0); Auto with datatypes.
+ simple induction x; simpl in |- *.
+ discriminate.
+ intros a0 l; elim (Aeq_dec a a0); auto with datatypes.
Qed.
Lemma set_mem_correct2 :
- (a:A)(x:set)(set_In a x) -> (set_mem a x)=true.
+ forall (a:A) (x:set), set_In a x -> set_mem a x = true.
Proof.
- Induction x; Simpl.
- Intro Ha; Elim Ha.
- Intros a0 l; Elim (Aeq_dec a a0); Auto with datatypes.
- Intros H1 H2 [H3 | H4].
- Absurd a0=a; Auto with datatypes.
- Auto with datatypes.
+ simple induction x; simpl in |- *.
+ intro Ha; elim Ha.
+ intros a0 l; elim (Aeq_dec a a0); auto with datatypes.
+ intros H1 H2 [H3| H4].
+ absurd (a0 = a); auto with datatypes.
+ auto with datatypes.
Qed.
Lemma set_mem_complete1 :
- (a:A)(x:set)(set_mem a x)=false -> ~(set_In a x).
+ forall (a:A) (x:set), set_mem a x = false -> ~ set_In a x.
Proof.
- Induction x; Simpl.
- Tauto.
- Intros a0 l; Elim (Aeq_dec a a0).
- Intros; Discriminate H0.
- Unfold not; Intros; Elim H1; Auto with datatypes.
+ simple induction x; simpl in |- *.
+ tauto.
+ intros a0 l; elim (Aeq_dec a a0).
+ intros; discriminate H0.
+ unfold not in |- *; intros; elim H1; auto with datatypes.
Qed.
Lemma set_mem_complete2 :
- (a:A)(x:set)~(set_In a x) -> (set_mem a x)=false.
+ forall (a:A) (x:set), ~ set_In a x -> set_mem a x = false.
Proof.
- Induction x; Simpl.
- Tauto.
- Intros a0 l; Elim (Aeq_dec a a0).
- Intros; Elim H0; Auto with datatypes.
- Tauto.
+ simple induction x; simpl in |- *.
+ tauto.
+ intros a0 l; elim (Aeq_dec a a0).
+ intros; elim H0; auto with datatypes.
+ tauto.
Qed.
- Lemma set_add_intro1 : (a,b:A)(x:set)
- (set_In a x) -> (set_In a (set_add b x)).
+ Lemma set_add_intro1 :
+ forall (a b:A) (x:set), set_In a x -> set_In a (set_add b x).
Proof.
- Unfold set_In; Induction x; Simpl.
- Auto with datatypes.
- Intros a0 l H [ Ha0a | Hal ].
- Elim (Aeq_dec b a0); Left; Assumption.
- Elim (Aeq_dec b a0); Right; [ Assumption | Auto with datatypes ].
+ unfold set_In in |- *; simple induction x; simpl in |- *.
+ auto with datatypes.
+ intros a0 l H [Ha0a| Hal].
+ elim (Aeq_dec b a0); left; assumption.
+ elim (Aeq_dec b a0); right; [ assumption | auto with datatypes ].
Qed.
- Lemma set_add_intro2 : (a,b:A)(x:set)
- a=b -> (set_In a (set_add b x)).
+ Lemma set_add_intro2 :
+ forall (a b:A) (x:set), a = b -> set_In a (set_add b x).
Proof.
- Unfold set_In; Induction x; Simpl.
- Auto with datatypes.
- Intros a0 l H Hab.
- Elim (Aeq_dec b a0);
- [ Rewrite Hab; Intro Hba0; Rewrite Hba0; Simpl; Auto with datatypes
- | Auto with datatypes ].
+ unfold set_In in |- *; simple induction x; simpl in |- *.
+ auto with datatypes.
+ intros a0 l H Hab.
+ elim (Aeq_dec b a0);
+ [ rewrite Hab; intro Hba0; rewrite Hba0; simpl in |- *;
+ auto with datatypes
+ | auto with datatypes ].
Qed.
- Hints Resolve set_add_intro1 set_add_intro2.
+ Hint Resolve set_add_intro1 set_add_intro2.
- Lemma set_add_intro : (a,b:A)(x:set)
- a=b\/(set_In a x) -> (set_In a (set_add b x)).
+ Lemma set_add_intro :
+ forall (a b:A) (x:set), a = b \/ set_In a x -> set_In a (set_add b x).
Proof.
- Intros a b x [H1 | H2] ; Auto with datatypes.
+ intros a b x [H1| H2]; auto with datatypes.
Qed.
- Lemma set_add_elim : (a,b:A)(x:set)
- (set_In a (set_add b x)) -> a=b\/(set_In a x).
+ Lemma set_add_elim :
+ forall (a b:A) (x:set), set_In a (set_add b x) -> a = b \/ set_In a x.
Proof.
- Unfold set_In.
- Induction x.
- Simpl; Intros [H1|H2]; Auto with datatypes.
- Simpl; Do 3 Intro.
- Elim (Aeq_dec b a0).
- Simpl; Tauto.
- Simpl; Intros; Elim H0.
- Trivial with datatypes.
- Tauto.
- Tauto.
+ unfold set_In in |- *.
+ simple induction x.
+ simpl in |- *; intros [H1| H2]; auto with datatypes.
+ simpl in |- *; do 3 intro.
+ elim (Aeq_dec b a0).
+ simpl in |- *; tauto.
+ simpl in |- *; intros; elim H0.
+ trivial with datatypes.
+ tauto.
+ tauto.
Qed.
- Lemma set_add_elim2 : (a,b:A)(x:set)
- (set_In a (set_add b x)) -> ~(a=b) -> (set_In a x).
- Intros a b x H; Case (set_add_elim H); Intros; Trivial.
- Case H1; Trivial.
+ Lemma set_add_elim2 :
+ forall (a b:A) (x:set), set_In a (set_add b x) -> a <> b -> set_In a x.
+ intros a b x H; case (set_add_elim _ _ _ H); intros; trivial.
+ case H1; trivial.
Qed.
- Hints Resolve set_add_intro set_add_elim set_add_elim2.
+ Hint Resolve set_add_intro set_add_elim set_add_elim2.
- Lemma set_add_not_empty : (a:A)(x:set)~(set_add a x)=empty_set.
+ Lemma set_add_not_empty : forall (a:A) (x:set), set_add a x <> empty_set.
Proof.
- Induction x; Simpl.
- Discriminate.
- Intros; Elim (Aeq_dec a a0); Intros; Discriminate.
+ simple induction x; simpl in |- *.
+ discriminate.
+ intros; elim (Aeq_dec a a0); intros; discriminate.
Qed.
- Lemma set_union_intro1 : (a:A)(x,y:set)
- (set_In a x) -> (set_In a (set_union x y)).
+ Lemma set_union_intro1 :
+ forall (a:A) (x y:set), set_In a x -> set_In a (set_union x y).
Proof.
- Induction y; Simpl; Auto with datatypes.
+ simple induction y; simpl in |- *; auto with datatypes.
Qed.
- Lemma set_union_intro2 : (a:A)(x,y:set)
- (set_In a y) -> (set_In a (set_union x y)).
+ Lemma set_union_intro2 :
+ forall (a:A) (x y:set), set_In a y -> set_In a (set_union x y).
Proof.
- Induction y; Simpl.
- Tauto.
- Intros; Elim H0; Auto with datatypes.
+ simple induction y; simpl in |- *.
+ tauto.
+ intros; elim H0; auto with datatypes.
Qed.
- Hints Resolve set_union_intro2 set_union_intro1.
+ Hint Resolve set_union_intro2 set_union_intro1.
- Lemma set_union_intro : (a:A)(x,y:set)
- (set_In a x)\/(set_In a y) -> (set_In a (set_union x y)).
+ Lemma set_union_intro :
+ forall (a:A) (x y:set),
+ set_In a x \/ set_In a y -> set_In a (set_union x y).
Proof.
- Intros; Elim H; Auto with datatypes.
+ intros; elim H; auto with datatypes.
Qed.
- Lemma set_union_elim : (a:A)(x,y:set)
- (set_In a (set_union x y)) -> (set_In a x)\/(set_In a y).
+ Lemma set_union_elim :
+ forall (a:A) (x y:set),
+ set_In a (set_union x y) -> set_In a x \/ set_In a y.
Proof.
- Induction y; Simpl.
- Auto with datatypes.
- Intros.
- Generalize (set_add_elim H0).
- Intros [H1 | H1].
- Auto with datatypes.
- Tauto.
+ simple induction y; simpl in |- *.
+ auto with datatypes.
+ intros.
+ generalize (set_add_elim _ _ _ H0).
+ intros [H1| H1].
+ auto with datatypes.
+ tauto.
Qed.
- Lemma set_union_emptyL : (a:A)(x:set)(set_In a (set_union empty_set x)) -> (set_In a x).
- Intros a x H; Case (set_union_elim H); Auto Orelse Contradiction.
+ Lemma set_union_emptyL :
+ forall (a:A) (x:set), set_In a (set_union empty_set x) -> set_In a x.
+ intros a x H; case (set_union_elim _ _ _ H); auto || contradiction.
Qed.
- Lemma set_union_emptyR : (a:A)(x:set)(set_In a (set_union x empty_set)) -> (set_In a x).
- Intros a x H; Case (set_union_elim H); Auto Orelse Contradiction.
+ Lemma set_union_emptyR :
+ forall (a:A) (x:set), set_In a (set_union x empty_set) -> set_In a x.
+ intros a x H; case (set_union_elim _ _ _ H); auto || contradiction.
Qed.
- Lemma set_inter_intro : (a:A)(x,y:set)
- (set_In a x) -> (set_In a y) -> (set_In a (set_inter x y)).
+ Lemma set_inter_intro :
+ forall (a:A) (x y:set),
+ set_In a x -> set_In a y -> set_In a (set_inter x y).
Proof.
- Induction x.
- Auto with datatypes.
- Simpl; Intros a0 l Hrec y [Ha0a | Hal] Hy.
- Simpl; Rewrite Ha0a.
- Generalize (!set_mem_correct1 a y).
- Generalize (!set_mem_complete1 a y).
- Elim (set_mem a y); Simpl; Intros.
- Auto with datatypes.
- Absurd (set_In a y); Auto with datatypes.
- Elim (set_mem a0 y); [ Right; Auto with datatypes | Auto with datatypes].
+ simple induction x.
+ auto with datatypes.
+ simpl in |- *; intros a0 l Hrec y [Ha0a| Hal] Hy.
+ simpl in |- *; rewrite Ha0a.
+ generalize (set_mem_correct1 a y).
+ generalize (set_mem_complete1 a y).
+ elim (set_mem a y); simpl in |- *; intros.
+ auto with datatypes.
+ absurd (set_In a y); auto with datatypes.
+ elim (set_mem a0 y); [ right; auto with datatypes | auto with datatypes ].
Qed.
- Lemma set_inter_elim1 : (a:A)(x,y:set)
- (set_In a (set_inter x y)) -> (set_In a x).
+ Lemma set_inter_elim1 :
+ forall (a:A) (x y:set), set_In a (set_inter x y) -> set_In a x.
Proof.
- Induction x.
- Auto with datatypes.
- Simpl; Intros a0 l Hrec y.
- Generalize (!set_mem_correct1 a0 y).
- Elim (set_mem a0 y); Simpl; Intros.
- Elim H0; EAuto with datatypes.
- EAuto with datatypes.
+ simple induction x.
+ auto with datatypes.
+ simpl in |- *; intros a0 l Hrec y.
+ generalize (set_mem_correct1 a0 y).
+ elim (set_mem a0 y); simpl in |- *; intros.
+ elim H0; eauto with datatypes.
+ eauto with datatypes.
Qed.
- Lemma set_inter_elim2 : (a:A)(x,y:set)
- (set_In a (set_inter x y)) -> (set_In a y).
+ Lemma set_inter_elim2 :
+ forall (a:A) (x y:set), set_In a (set_inter x y) -> set_In a y.
Proof.
- Induction x.
- Simpl; Tauto.
- Simpl; Intros a0 l Hrec y.
- Generalize (!set_mem_correct1 a0 y).
- Elim (set_mem a0 y); Simpl; Intros.
- Elim H0; [ Intro Hr; Rewrite <- Hr; EAuto with datatypes | EAuto with datatypes ] .
- EAuto with datatypes.
+ simple induction x.
+ simpl in |- *; tauto.
+ simpl in |- *; intros a0 l Hrec y.
+ generalize (set_mem_correct1 a0 y).
+ elim (set_mem a0 y); simpl in |- *; intros.
+ elim H0;
+ [ intro Hr; rewrite <- Hr; eauto with datatypes | eauto with datatypes ].
+ eauto with datatypes.
Qed.
- Hints Resolve set_inter_elim1 set_inter_elim2.
+ Hint Resolve set_inter_elim1 set_inter_elim2.
- Lemma set_inter_elim : (a:A)(x,y:set)
- (set_In a (set_inter x y)) -> (set_In a x)/\(set_In a y).
+ Lemma set_inter_elim :
+ forall (a:A) (x y:set),
+ set_In a (set_inter x y) -> set_In a x /\ set_In a y.
Proof.
- EAuto with datatypes.
+ eauto with datatypes.
Qed.
- Lemma set_diff_intro : (a:A)(x,y:set)
- (set_In a x) -> ~(set_In a y) -> (set_In a (set_diff x y)).
+ Lemma set_diff_intro :
+ forall (a:A) (x y:set),
+ set_In a x -> ~ set_In a y -> set_In a (set_diff x y).
Proof.
- Induction x.
- Simpl; Tauto.
- Simpl; Intros a0 l Hrec y [Ha0a | Hal] Hay.
- Rewrite Ha0a; Generalize (set_mem_complete2 Hay).
- Elim (set_mem a y); [ Intro Habs; Discriminate Habs | Auto with datatypes ].
- Elim (set_mem a0 y); Auto with datatypes.
+ simple induction x.
+ simpl in |- *; tauto.
+ simpl in |- *; intros a0 l Hrec y [Ha0a| Hal] Hay.
+ rewrite Ha0a; generalize (set_mem_complete2 _ _ Hay).
+ elim (set_mem a y);
+ [ intro Habs; discriminate Habs | auto with datatypes ].
+ elim (set_mem a0 y); auto with datatypes.
Qed.
- Lemma set_diff_elim1 : (a:A)(x,y:set)
- (set_In a (set_diff x y)) -> (set_In a x).
+ Lemma set_diff_elim1 :
+ forall (a:A) (x y:set), set_In a (set_diff x y) -> set_In a x.
Proof.
- Induction x.
- Simpl; Tauto.
- Simpl; Intros a0 l Hrec y; Elim (set_mem a0 y).
- EAuto with datatypes.
- Intro; Generalize (set_add_elim H).
- Intros [H1 | H2]; EAuto with datatypes.
+ simple induction x.
+ simpl in |- *; tauto.
+ simpl in |- *; intros a0 l Hrec y; elim (set_mem a0 y).
+ eauto with datatypes.
+ intro; generalize (set_add_elim _ _ _ H).
+ intros [H1| H2]; eauto with datatypes.
Qed.
- Lemma set_diff_elim2 : (a:A)(x,y:set)
- (set_In a (set_diff x y)) -> ~(set_In a y).
- Intros a x y; Elim x; Simpl.
- Intros; Contradiction.
- Intros a0 l Hrec.
- Apply set_mem_ind2; Auto.
- Intros H1 H2; Case (set_add_elim H2); Intros; Auto.
- Rewrite H; Trivial.
+ Lemma set_diff_elim2 :
+ forall (a:A) (x y:set), set_In a (set_diff x y) -> ~ set_In a y.
+ intros a x y; elim x; simpl in |- *.
+ intros; contradiction.
+ intros a0 l Hrec.
+ apply set_mem_ind2; auto.
+ intros H1 H2; case (set_add_elim _ _ _ H2); intros; auto.
+ rewrite H; trivial.
Qed.
- Lemma set_diff_trivial : (a:A)(x:set)~(set_In a (set_diff x x)).
- Red; Intros a x H.
- Apply (set_diff_elim2 H).
- Apply (set_diff_elim1 H).
+ Lemma set_diff_trivial : forall (a:A) (x:set), ~ set_In a (set_diff x x).
+ red in |- *; intros a x H.
+ apply (set_diff_elim2 _ _ _ H).
+ apply (set_diff_elim1 _ _ _ H).
Qed.
-Hints Resolve set_diff_intro set_diff_trivial.
+Hint Resolve set_diff_intro set_diff_trivial.
End first_definitions.
Section other_definitions.
- Variables A,B : Set.
+ Variables A B : Set.
- Definition set_prod : (set A) -> (set B) -> (set A*B) := (list_prod 1!A 2!B).
+ Definition set_prod : set A -> set B -> set (A * B) :=
+ list_prod (A:=A) (B:=B).
(** [B^A], set of applications from [A] to [B] *)
- Definition set_power : (set A) -> (set B) -> (set (set A*B)) :=
- (list_power 1!A 2!B).
+ Definition set_power : set A -> set B -> set (set (A * B)) :=
+ list_power (A:=A) (B:=B).
- Definition set_map : (A->B) -> (set A) -> (set B) := (map 1!A 2!B).
+ Definition set_map : (A -> B) -> set A -> set B := map (A:=A) (B:=B).
- Definition set_fold_left : (B -> A -> B) -> (set A) -> B -> B :=
- (fold_left 1!B 2!A).
+ Definition set_fold_left : (B -> A -> B) -> set A -> B -> B :=
+ fold_left (A:=B) (B:=A).
- Definition set_fold_right : (A -> B -> B) -> (set A) -> B -> B :=
- [f][x][b](fold_right f b x).
+ Definition set_fold_right (f:A -> B -> B) (x:set A)
+ (b:B) : B := fold_right f b x.
End other_definitions.
-V7only [Implicits nil [].].
-Unset Implicit Arguments.
+Unset Implicit Arguments. \ No newline at end of file
diff --git a/theories/Lists/MonoList.v b/theories/Lists/MonoList.v
index 528e61ab0..28e52a415 100755
--- a/theories/Lists/MonoList.v
+++ b/theories/Lists/MonoList.v
@@ -10,97 +10,105 @@
(** THIS IS A OLD CONTRIB. IT IS NO LONGER MAINTAINED ***)
-Require Le.
+Require Import Le.
-Parameter List_Dom:Set.
+Parameter List_Dom : Set.
Definition A := List_Dom.
-Inductive list : Set := nil : list | cons : A -> list -> list.
+Inductive list : Set :=
+ | nil : list
+ | cons : A -> list -> list.
-Fixpoint app [l:list] : list -> list
- := [m:list]<list>Cases l of
- nil => m
- | (cons a l1) => (cons a (app l1 m))
- end.
+Fixpoint app (l m:list) {struct l} : list :=
+ match l return list with
+ | nil => m
+ | cons a l1 => cons a (app l1 m)
+ end.
-Lemma app_nil_end : (l:list)(l=(app l nil)).
+Lemma app_nil_end : forall l:list, l = app l nil.
Proof.
- Intro l ; Elim l ; Simpl ; Auto.
- Induction 1; Auto.
+ intro l; elim l; simpl in |- *; auto.
+ simple induction 1; auto.
Qed.
-Hints Resolve app_nil_end : list v62.
+Hint Resolve app_nil_end: list v62.
-Lemma app_ass : (l,m,n : list)(app (app l m) n)=(app l (app m n)).
+Lemma app_ass : forall l m n:list, app (app l m) n = app l (app m n).
Proof.
- Intros l m n ; Elim l ; Simpl ; Auto with list.
- Induction 1; Auto with list.
+ intros l m n; elim l; simpl in |- *; auto with list.
+ simple induction 1; auto with list.
Qed.
-Hints Resolve app_ass : list v62.
+Hint Resolve app_ass: list v62.
-Lemma ass_app : (l,m,n : list)(app l (app m n))=(app (app l m) n).
+Lemma ass_app : forall l m n:list, app l (app m n) = app (app l m) n.
Proof.
- Auto with list.
+ auto with list.
Qed.
-Hints Resolve ass_app : list v62.
+Hint Resolve ass_app: list v62.
-Definition tail :=
- [l:list] <list>Cases l of (cons _ m) => m | _ => nil end : list->list.
+Definition tail (l:list) : list :=
+ match l return list with
+ | cons _ m => m
+ | _ => nil
+ end.
-Lemma nil_cons : (a:A)(m:list)~nil=(cons a m).
- Intros; Discriminate.
+Lemma nil_cons : forall (a:A) (m:list), nil <> cons a m.
+ intros; discriminate.
Qed.
(****************************************)
(* Length of lists *)
(****************************************)
-Fixpoint length [l:list] : nat
- := <nat>Cases l of (cons _ m) => (S (length m)) | _ => O end.
+Fixpoint length (l:list) : nat :=
+ match l return nat with
+ | cons _ m => S (length m)
+ | _ => 0
+ end.
(******************************)
(* Length order of lists *)
(******************************)
Section length_order.
-Definition lel := [l,m:list](le (length l) (length m)).
+Definition lel (l m:list) := length l <= length m.
-Hints Unfold lel : list.
+Hint Unfold lel: list.
-Variables a,b:A.
-Variables l,m,n:list.
+Variables a b : A.
+Variables l m n : list.
-Lemma lel_refl : (lel l l).
+Lemma lel_refl : lel l l.
Proof.
- Unfold lel ; Auto with list.
+ unfold lel in |- *; auto with list.
Qed.
-Lemma lel_trans : (lel l m)->(lel m n)->(lel l n).
+Lemma lel_trans : lel l m -> lel m n -> lel l n.
Proof.
- Unfold lel ; Intros.
- Apply le_trans with (length m) ; Auto with list.
+ unfold lel in |- *; intros.
+ apply le_trans with (length m); auto with list.
Qed.
-Lemma lel_cons_cons : (lel l m)->(lel (cons a l) (cons b m)).
+Lemma lel_cons_cons : lel l m -> lel (cons a l) (cons b m).
Proof.
- Unfold lel ; Simpl ; Auto with list arith.
+ unfold lel in |- *; simpl in |- *; auto with list arith.
Qed.
-Lemma lel_cons : (lel l m)->(lel l (cons b m)).
+Lemma lel_cons : lel l m -> lel l (cons b m).
Proof.
- Unfold lel ; Simpl ; Auto with list arith.
+ unfold lel in |- *; simpl in |- *; auto with list arith.
Qed.
-Lemma lel_tail : (lel (cons a l) (cons b m)) -> (lel l m).
+Lemma lel_tail : lel (cons a l) (cons b m) -> lel l m.
Proof.
- Unfold lel ; Simpl ; Auto with list arith.
+ unfold lel in |- *; simpl in |- *; auto with list arith.
Qed.
-Lemma lel_nil : (l':list)(lel l' nil)->(nil=l').
+Lemma lel_nil : forall l':list, lel l' nil -> nil = l'.
Proof.
- Intro l' ; Elim l' ; Auto with list arith.
- Intros a' y H H0.
+ intro l'; elim l'; auto with list arith.
+ intros a' y H H0.
(* <list>nil=(cons a' y)
============================
H0 : (lel (cons a' y) nil)
@@ -108,35 +116,36 @@ Proof.
y : list
a' : A
l' : list *)
- Absurd (le (S (length y)) O); Auto with list arith.
+ absurd (S (length y) <= 0); auto with list arith.
Qed.
End length_order.
-Hints Resolve lel_refl lel_cons_cons lel_cons lel_nil lel_nil nil_cons : list v62.
+Hint Resolve lel_refl lel_cons_cons lel_cons lel_nil lel_nil nil_cons: list
+ v62.
-Fixpoint In [a:A;l:list] : Prop :=
- Cases l of
- nil => False
- | (cons b m) => (b=a)\/(In a m)
- end.
+Fixpoint In (a:A) (l:list) {struct l} : Prop :=
+ match l with
+ | nil => False
+ | cons b m => b = a \/ In a m
+ end.
-Lemma in_eq : (a:A)(l:list)(In a (cons a l)).
+Lemma in_eq : forall (a:A) (l:list), In a (cons a l).
Proof.
- Simpl ; Auto with list.
+ simpl in |- *; auto with list.
Qed.
-Hints Resolve in_eq : list v62.
+Hint Resolve in_eq: list v62.
-Lemma in_cons : (a,b:A)(l:list)(In b l)->(In b (cons a l)).
+Lemma in_cons : forall (a b:A) (l:list), In b l -> In b (cons a l).
Proof.
- Simpl ; Auto with list.
+ simpl in |- *; auto with list.
Qed.
-Hints Resolve in_cons : list v62.
+Hint Resolve in_cons: list v62.
-Lemma in_app_or : (l,m:list)(a:A)(In a (app l m))->((In a l)\/(In a m)).
+Lemma in_app_or : forall (l m:list) (a:A), In a (app l m) -> In a l \/ In a m.
Proof.
- Intros l m a.
- Elim l ; Simpl ; Auto with list.
- Intros a0 y H H0.
+ intros l m a.
+ elim l; simpl in |- *; auto with list.
+ intros a0 y H H0.
(* ((<A>a0=a)\/(In a y))\/(In a m)
============================
H0 : (<A>a0=a)\/(In a (app y m))
@@ -146,81 +155,82 @@ Proof.
a : A
m : list
l : list *)
- Elim H0 ; Auto with list.
- Intro H1.
+ elim H0; auto with list.
+ intro H1.
(* ((<A>a0=a)\/(In a y))\/(In a m)
============================
H1 : (In a (app y m)) *)
- Elim (H H1) ; Auto with list.
+ elim (H H1); auto with list.
Qed.
-Hints Immediate in_app_or : list v62.
+Hint Immediate in_app_or: list v62.
-Lemma in_or_app : (l,m:list)(a:A)((In a l)\/(In a m))->(In a (app l m)).
+Lemma in_or_app : forall (l m:list) (a:A), In a l \/ In a m -> In a (app l m).
Proof.
- Intros l m a.
- Elim l ; Simpl ; Intro H.
+ intros l m a.
+ elim l; simpl in |- *; intro H.
(* 1 (In a m)
============================
H : False\/(In a m)
a : A
m : list
l : list *)
- Elim H ; Auto with list ; Intro H0.
+ elim H; auto with list; intro H0.
(* (In a m)
============================
H0 : False *)
- Elim H0. (* subProof completed *)
- Intros y H0 H1.
+ elim H0. (* subProof completed *)
+ intros y H0 H1.
(* 2 (<A>H=a)\/(In a (app y m))
============================
H1 : ((<A>H=a)\/(In a y))\/(In a m)
H0 : ((In a y)\/(In a m))->(In a (app y m))
y : list *)
- Elim H1 ; Auto 4 with list.
- Intro H2.
+ elim H1; auto 4 with list.
+ intro H2.
(* (<A>H=a)\/(In a (app y m))
============================
H2 : (<A>H=a)\/(In a y) *)
- Elim H2 ; Auto with list.
+ elim H2; auto with list.
Qed.
-Hints Resolve in_or_app : list v62.
+Hint Resolve in_or_app: list v62.
-Definition incl := [l,m:list](a:A)(In a l)->(In a m).
+Definition incl (l m:list) := forall a:A, In a l -> In a m.
-Hints Unfold incl : list v62.
+Hint Unfold incl: list v62.
-Lemma incl_refl : (l:list)(incl l l).
+Lemma incl_refl : forall l:list, incl l l.
Proof.
- Auto with list.
+ auto with list.
Qed.
-Hints Resolve incl_refl : list v62.
+Hint Resolve incl_refl: list v62.
-Lemma incl_tl : (a:A)(l,m:list)(incl l m)->(incl l (cons a m)).
+Lemma incl_tl : forall (a:A) (l m:list), incl l m -> incl l (cons a m).
Proof.
- Auto with list.
+ auto with list.
Qed.
-Hints Immediate incl_tl : list v62.
+Hint Immediate incl_tl: list v62.
-Lemma incl_tran : (l,m,n:list)(incl l m)->(incl m n)->(incl l n).
+Lemma incl_tran : forall l m n:list, incl l m -> incl m n -> incl l n.
Proof.
- Auto with list.
+ auto with list.
Qed.
-Lemma incl_appl : (l,m,n:list)(incl l n)->(incl l (app n m)).
+Lemma incl_appl : forall l m n:list, incl l n -> incl l (app n m).
Proof.
- Auto with list.
+ auto with list.
Qed.
-Hints Immediate incl_appl : list v62.
+Hint Immediate incl_appl: list v62.
-Lemma incl_appr : (l,m,n:list)(incl l n)->(incl l (app m n)).
+Lemma incl_appr : forall l m n:list, incl l n -> incl l (app m n).
Proof.
- Auto with list.
+ auto with list.
Qed.
-Hints Immediate incl_appr : list v62.
+Hint Immediate incl_appr: list v62.
-Lemma incl_cons : (a:A)(l,m:list)(In a m)->(incl l m)->(incl (cons a l) m).
+Lemma incl_cons :
+ forall (a:A) (l m:list), In a m -> incl l m -> incl (cons a l) m.
Proof.
- Unfold incl ; Simpl ; Intros a l m H H0 a0 H1.
+ unfold incl in |- *; simpl in |- *; intros a l m H H0 a0 H1.
(* (In a0 m)
============================
H1 : (<A>a=a0)\/(In a0 l)
@@ -230,21 +240,21 @@ Proof.
m : list
l : list
a : A *)
- Elim H1.
+ elim H1.
(* 1 (<A>a=a0)->(In a0 m) *)
- Elim H1 ; Auto with list ; Intro H2.
+ elim H1; auto with list; intro H2.
(* (<A>a=a0)->(In a0 m)
============================
H2 : <A>a=a0 *)
- Elim H2 ; Auto with list. (* solves subgoal *)
+ elim H2; auto with list. (* solves subgoal *)
(* 2 (In a0 l)->(In a0 m) *)
- Auto with list.
+ auto with list.
Qed.
-Hints Resolve incl_cons : list v62.
+Hint Resolve incl_cons: list v62.
-Lemma incl_app : (l,m,n:list)(incl l n)->(incl m n)->(incl (app l m) n).
+Lemma incl_app : forall l m n:list, incl l n -> incl m n -> incl (app l m) n.
Proof.
- Unfold incl ; Simpl ; Intros l m n H H0 a H1.
+ unfold incl in |- *; simpl in |- *; intros l m n H H0 a H1.
(* (In a n)
============================
H1 : (In a (app l m))
@@ -254,6 +264,6 @@ Proof.
n : list
m : list
l : list *)
- Elim (in_app_or l m a) ; Auto with list.
+ elim (in_app_or l m a); auto with list.
Qed.
-Hints Resolve incl_app : list v62.
+Hint Resolve incl_app: list v62. \ No newline at end of file
diff --git a/theories/Lists/PolyList.v b/theories/Lists/PolyList.v
deleted file mode 100644
index 50b203d4e..000000000
--- a/theories/Lists/PolyList.v
+++ /dev/null
@@ -1,642 +0,0 @@
-(***********************************************************************)
-(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA-Rocquencourt & LRI-CNRS-Orsay *)
-(* \VV/ *************************************************************)
-(* // * This file is distributed under the terms of the *)
-(* * GNU Lesser General Public License Version 2.1 *)
-(***********************************************************************)
-
-(*i $Id$ i*)
-
-Require Le.
-
-
-Section Lists.
-
-Variable A : Set.
-
-Set Implicit Arguments.
-
-Inductive list : Set := nil : list | cons : A -> list -> list.
-
-Infix "::" cons (at level 7, right associativity) : list_scope
- V8only (at level 60, right associativity).
-
-Open Scope list_scope.
-
-(*************************)
-(** Discrimination *)
-(*************************)
-
-Lemma nil_cons : (a:A)(m:list)~(nil=(cons a m)).
-Proof.
- Intros; Discriminate.
-Qed.
-
-(*************************)
-(** Concatenation *)
-(*************************)
-
-Fixpoint app [l:list] : list -> list
- := [m:list]Cases l of
- nil => m
- | (cons a l1) => (cons a (app l1 m))
- end.
-
-Infix RIGHTA 7 "^" app : list_scope
- V8only RIGHTA 60 "++".
-
-Lemma app_nil_end : (l:list)l=(l^nil).
-Proof.
- NewInduction l ; Simpl ; Auto.
- Rewrite <- IHl; Auto.
-Qed.
-Hints Resolve app_nil_end.
-
-Tactic Definition now_show c := Change c.
-V7only [Tactic Definition NowShow := now_show.].
-
-Lemma app_ass : (l,m,n : list)((l^m)^ n)=(l^(m^n)).
-Proof.
- Intros. NewInduction l ; Simpl ; Auto.
- NowShow '(cons a (app (app l m) n))=(cons a (app l (app m n))).
- Rewrite <- IHl; Auto.
-Qed.
-Hints Resolve app_ass.
-
-Lemma ass_app : (l,m,n : list)(l^(m^n))=((l^m)^n).
-Proof.
- Auto.
-Qed.
-Hints Resolve ass_app.
-
-Lemma app_comm_cons : (x,y:list)(a:A) (cons a (x^y))=((cons a x)^y).
-Proof.
- Auto.
-Qed.
-
-Lemma app_eq_nil: (x,y:list) (x^y)=nil -> x=nil /\ y=nil.
-Proof.
- NewDestruct x;NewDestruct y;Simpl;Auto.
- Intros H;Discriminate H.
- Intros;Discriminate H.
-Qed.
-
-Lemma app_cons_not_nil: (x,y:list)(a:A)~nil=(x^(cons a y)).
-Proof.
-Unfold not .
- NewDestruct x;Simpl;Intros.
- Discriminate H.
- Discriminate H.
-Qed.
-
-Lemma app_eq_unit:(x,y:list)(a:A)
- (x^y)=(cons a nil)-> (x=nil)/\ y=(cons a nil) \/ x=(cons a nil)/\ y=nil.
-
-Proof.
- NewDestruct x;NewDestruct y;Simpl.
- Intros a H;Discriminate H.
- Left;Split;Auto.
- Right;Split;Auto.
- Generalize H .
- Generalize (app_nil_end l) ;Intros E.
- Rewrite <- E;Auto.
- Intros.
- Injection H.
- Intro.
- Cut nil=(l^(cons a0 l0));Auto.
- Intro.
- Generalize (app_cons_not_nil H1); Intro.
- Elim H2.
-Qed.
-
-Lemma app_inj_tail : (x,y:list)(a,b:A)
- (x^(cons a nil))=(y^(cons b nil)) -> x=y /\ a=b.
-Proof.
- NewInduction x as [|x l IHl];NewDestruct y;Simpl;Auto.
- Intros a b H.
- Injection H.
- Auto.
- Intros a0 b H.
- Injection H;Intros.
- Generalize (app_cons_not_nil H0) ;NewDestruct 1.
- Intros a b H.
- Injection H;Intros.
- Cut nil=(l^(cons a nil));Auto.
- Intro.
- Generalize (app_cons_not_nil H2) ;NewDestruct 1.
- Intros a0 b H.
- Injection H;Intros.
- NewDestruct (IHl l0 a0 b H0).
- Split;Auto.
- Rewrite <- H1;Rewrite <- H2;Reflexivity.
-Qed.
-
-(*************************)
-(** Head and tail *)
-(*************************)
-
-Definition head :=
- [l:list]Cases l of
- | nil => Error
- | (cons x _) => (Value x)
- end.
-
-Definition tail : list -> list :=
- [l:list]Cases l of
- | nil => nil
- | (cons a m) => m
- end.
-
-(****************************************)
-(** Length of lists *)
-(****************************************)
-
-Fixpoint length [l:list] : nat
- := Cases l of nil => O | (cons _ m) => (S (length m)) end.
-
-(******************************)
-(** Length order of lists *)
-(******************************)
-
-Section length_order.
-Definition lel := [l,m:list](le (length l) (length m)).
-
-Variables a,b:A.
-Variables l,m,n:list.
-
-Lemma lel_refl : (lel l l).
-Proof.
- Unfold lel ; Auto with arith.
-Qed.
-
-Lemma lel_trans : (lel l m)->(lel m n)->(lel l n).
-Proof.
- Unfold lel ; Intros.
- NowShow '(le (length l) (length n)).
- Apply le_trans with (length m) ; Auto with arith.
-Qed.
-
-Lemma lel_cons_cons : (lel l m)->(lel (cons a l) (cons b m)).
-Proof.
- Unfold lel ; Simpl ; Auto with arith.
-Qed.
-
-Lemma lel_cons : (lel l m)->(lel l (cons b m)).
-Proof.
- Unfold lel ; Simpl ; Auto with arith.
-Qed.
-
-Lemma lel_tail : (lel (cons a l) (cons b m)) -> (lel l m).
-Proof.
- Unfold lel ; Simpl ; Auto with arith.
-Qed.
-
-Lemma lel_nil : (l':list)(lel l' nil)->(nil=l').
-Proof.
- Intro l' ; Elim l' ; Auto with arith.
- Intros a' y H H0.
- NowShow 'nil=(cons a' y).
- Absurd (le (S (length y)) O); Auto with arith.
-Qed.
-End length_order.
-
-Hints Resolve lel_refl lel_cons_cons lel_cons lel_nil lel_nil nil_cons.
-
-(*********************************)
-(** The [In] predicate *)
-(*********************************)
-
-Fixpoint In [a:A;l:list] : Prop :=
- Cases l of nil => False | (cons b m) => (b=a)\/(In a m) end.
-
-Lemma in_eq : (a:A)(l:list)(In a (cons a l)).
-Proof.
- Simpl ; Auto.
-Qed.
-Hints Resolve in_eq.
-
-Lemma in_cons : (a,b:A)(l:list)(In b l)->(In b (cons a l)).
-Proof.
- Simpl ; Auto.
-Qed.
-Hints Resolve in_cons.
-
-Lemma in_nil : (a:A)~(In a nil).
-Proof.
- Unfold not; Intros a H; Inversion_clear H.
-Qed.
-
-
-Lemma in_inv : (a,b:A)(l:list)
- (In b (cons a l)) -> a=b \/ (In b l).
-Proof.
- Intros a b l H ; Inversion_clear H ; Auto.
-Qed.
-
-Lemma In_dec : ((x,y:A){x=y}+{~x=y}) -> (a:A)(l:list){(In a l)}+{~(In a l)}.
-
-Proof.
- NewInduction l as [|a0 l IHl].
- Right; Apply in_nil.
- NewDestruct (H a0 a); Simpl; Auto.
- NewDestruct IHl; Simpl; Auto.
- Right; Unfold not; Intros [Hc1 | Hc2]; Auto.
-Qed.
-
-Lemma in_app_or : (l,m:list)(a:A)(In a (l^m))->((In a l)\/(In a m)).
-Proof.
- Intros l m a.
- Elim l ; Simpl ; Auto.
- Intros a0 y H H0.
- NowShow '(a0=a\/(In a y))\/(In a m).
- Elim H0 ; Auto.
- Intro H1.
- NowShow '(a0=a\/(In a y))\/(In a m).
- Elim (H H1) ; Auto.
-Qed.
-Hints Immediate in_app_or.
-
-Lemma in_or_app : (l,m:list)(a:A)((In a l)\/(In a m))->(In a (l^m)).
-Proof.
- Intros l m a.
- Elim l ; Simpl ; Intro H.
- NowShow '(In a m).
- Elim H ; Auto ; Intro H0.
- NowShow '(In a m).
- Elim H0. (* subProof completed *)
- Intros y H0 H1.
- NowShow 'H=a\/(In a (app y m)).
- Elim H1 ; Auto 4.
- Intro H2.
- NowShow 'H=a\/(In a (app y m)).
- Elim H2 ; Auto.
-Qed.
-Hints Resolve in_or_app.
-
-(***************************)
-(** Set inclusion on list *)
-(***************************)
-
-Definition incl := [l,m:list](a:A)(In a l)->(In a m).
-Hints Unfold incl.
-
-Lemma incl_refl : (l:list)(incl l l).
-Proof.
- Auto.
-Qed.
-Hints Resolve incl_refl.
-
-Lemma incl_tl : (a:A)(l,m:list)(incl l m)->(incl l (cons a m)).
-Proof.
- Auto.
-Qed.
-Hints Immediate incl_tl.
-
-Lemma incl_tran : (l,m,n:list)(incl l m)->(incl m n)->(incl l n).
-Proof.
- Auto.
-Qed.
-
-Lemma incl_appl : (l,m,n:list)(incl l n)->(incl l (n^m)).
-Proof.
- Auto.
-Qed.
-Hints Immediate incl_appl.
-
-Lemma incl_appr : (l,m,n:list)(incl l n)->(incl l (m^n)).
-Proof.
- Auto.
-Qed.
-Hints Immediate incl_appr.
-
-Lemma incl_cons : (a:A)(l,m:list)(In a m)->(incl l m)->(incl (cons a l) m).
-Proof.
- Unfold incl ; Simpl ; Intros a l m H H0 a0 H1.
- NowShow '(In a0 m).
- Elim H1.
- NowShow 'a=a0->(In a0 m).
- Elim H1 ; Auto ; Intro H2.
- NowShow 'a=a0->(In a0 m).
- Elim H2 ; Auto. (* solves subgoal *)
- NowShow '(In a0 l)->(In a0 m).
- Auto.
-Qed.
-Hints Resolve incl_cons.
-
-Lemma incl_app : (l,m,n:list)(incl l n)->(incl m n)->(incl (l^m) n).
-Proof.
- Unfold incl ; Simpl ; Intros l m n H H0 a H1.
- NowShow '(In a n).
- Elim (in_app_or H1); Auto.
-Qed.
-Hints Resolve incl_app.
-
-(**************************)
-(** Nth element of a list *)
-(**************************)
-
-Fixpoint nth [n:nat; l:list] : A->A :=
- [default]Cases n l of
- O (cons x l') => x
- | O other => default
- | (S m) nil => default
- | (S m) (cons x t) => (nth m t default)
- end.
-
-Fixpoint nth_ok [n:nat; l:list] : A->bool :=
- [default]Cases n l of
- O (cons x l') => true
- | O other => false
- | (S m) nil => false
- | (S m) (cons x t) => (nth_ok m t default)
- end.
-
-Lemma nth_in_or_default :
- (n:nat)(l:list)(d:A){(In (nth n l d) l)}+{(nth n l d)=d}.
-(* Realizer nth_ok. Program_all. *)
-Proof.
- Intros n l d; Generalize n; NewInduction l; Intro n0.
- Right; Case n0; Trivial.
- Case n0; Simpl.
- Auto.
- Intro n1; Elim (IHl n1); Auto.
-Qed.
-
-Lemma nth_S_cons :
- (n:nat)(l:list)(d:A)(a:A)(In (nth n l d) l)
- ->(In (nth (S n) (cons a l) d) (cons a l)).
-Proof.
- Simpl; Auto.
-Qed.
-
-Fixpoint nth_error [l:list;n:nat] : (Exc A) :=
- Cases n l of
- | O (cons x _) => (Value x)
- | (S n) (cons _ l) => (nth_error l n)
- | _ _ => Error
- end.
-
-Definition nth_default : A -> list -> nat -> A :=
- [default,l,n]Cases (nth_error l n) of
- | (Some x) => x
- | None => default
- end.
-
-Lemma nth_In :
- (n:nat)(l:list)(d:A)(lt n (length l))->(In (nth n l d) l).
-
-Proof.
-Unfold lt; NewInduction n as [|n hn]; Simpl.
-NewDestruct l ; Simpl ; [ Inversion 2 | Auto].
-NewDestruct l as [|a l hl] ; Simpl.
-Inversion 2.
-Intros d ie ; Right ; Apply hn ; Auto with arith.
-Qed.
-
-(********************************)
-(** Decidable equality on lists *)
-(********************************)
-
-
-Lemma list_eq_dec : ((x,y:A){x=y}+{~x=y})->(x,y:list){x=y}+{~x=y}.
-Proof.
- NewInduction x as [|a l IHl]; NewDestruct y as [|a0 l0]; Auto.
- NewDestruct (H a a0) as [e|e].
- NewDestruct (IHl l0) as [e'|e'].
- Left; Rewrite e; Rewrite e'; Trivial.
- Right; Red; Intro.
- Apply e'; Injection H0; Trivial.
- Right; Red; Intro.
- Apply e; Injection H0; Trivial.
-Qed.
-
-(*************************)
-(** Reverse *)
-(*************************)
-
-Fixpoint rev [l:list] : list :=
- Cases l of
- nil => nil
- | (cons x l') => (rev l')^(cons x nil)
- end.
-
-Lemma distr_rev :
- (x,y:list) (rev (x^y))=((rev y)^(rev x)).
-Proof.
- NewInduction x as [|a l IHl].
- NewDestruct y.
- Simpl.
- Auto.
-
- Simpl.
- Apply app_nil_end;Auto.
-
- Intro y.
- Simpl.
- Rewrite (IHl y).
- Apply (app_ass (rev y) (rev l) (cons a nil)).
-Qed.
-
-Remark rev_unit : (l:list)(a:A) (rev l^(cons a nil))= (cons a (rev l)).
-Proof.
- Intros.
- Apply (distr_rev l (cons a nil));Simpl;Auto.
-Qed.
-
-Lemma idempot_rev : (l:list)(rev (rev l))=l.
-Proof.
- NewInduction l as [|a l IHl].
- Simpl;Auto.
-
- Simpl.
- Rewrite (rev_unit (rev l) a).
- Rewrite -> IHl;Auto.
-Qed.
-
-(*********************************************)
-(** Reverse Induction Principle on Lists *)
-(*********************************************)
-
-Section Reverse_Induction.
-
-Unset Implicit Arguments.
-
-Remark rev_list_ind: (P:list->Prop)
- (P nil)
- ->((a:A)(l:list)(P (rev l))->(P (rev (cons a l))))
- ->(l:list) (P (rev l)).
-Proof.
- NewInduction l; Auto.
-Qed.
-Set Implicit Arguments.
-
-Lemma rev_ind :
- (P:list->Prop)
- (P nil)->
- ((x:A)(l:list)(P l)->(P l^(cons x nil)))
- ->(l:list)(P l).
-Proof.
- Intros.
- Generalize (idempot_rev l) .
- Intros E;Rewrite <- E.
- Apply (rev_list_ind P).
- Auto.
-
- Simpl.
- Intros.
- Apply (H0 a (rev l0)).
- Auto.
-Qed.
-
-End Reverse_Induction.
-
-End Lists.
-
-Implicits nil [1].
-
-Hints Resolve nil_cons app_nil_end ass_app app_ass : datatypes v62.
-Hints Resolve app_comm_cons app_cons_not_nil : datatypes v62.
-Hints Immediate app_eq_nil : datatypes v62.
-Hints Resolve app_eq_unit app_inj_tail : datatypes v62.
-Hints Resolve lel_refl lel_cons_cons lel_cons lel_nil lel_nil nil_cons
- : datatypes v62.
-Hints Resolve in_eq in_cons in_inv in_nil in_app_or in_or_app : datatypes v62.
-Hints Resolve incl_refl incl_tl incl_tran incl_appl incl_appr incl_cons incl_app
- : datatypes v62.
-
-Section Functions_on_lists.
-
-(****************************************************************)
-(** Some generic functions on lists and basic functions of them *)
-(****************************************************************)
-
-Section Map.
-Variables A,B:Set.
-Variable f:A->B.
-Fixpoint map [l:(list A)] : (list B) :=
- Cases l of
- nil => nil
- | (cons a t) => (cons (f a) (map t))
- end.
-End Map.
-
-Lemma in_map : (A,B:Set)(f:A->B)(l:(list A))(x:A)
- (In x l) -> (In (f x) (map f l)).
-Proof.
- NewInduction l as [|a l IHl]; Simpl;
- [ Auto
- | NewDestruct 1;
- [ Left; Apply f_equal with f:=f; Assumption
- | Auto]
- ].
-Qed.
-
-Fixpoint flat_map [A,B:Set; f:A->(list B); l:(list A)] : (list B) :=
- Cases l of
- nil => nil
- | (cons x t) => (app (f x) (flat_map f t))
- end.
-
-Fixpoint list_prod [A:Set; B:Set; l:(list A)] : (list B)->(list A*B) :=
- [l']Cases l of
- nil => nil
- | (cons x t) => (app (map [y:B](x,y) l')
- (list_prod t l'))
- end.
-
-Lemma in_prod_aux :
- (A:Set)(B:Set)(x:A)(y:B)(l:(list B))
- (In y l) -> (In (x,y) (map [y0:B](x,y0) l)).
-Proof.
- NewInduction l;
- [ Simpl; Auto
- | Simpl; NewDestruct 1 as [H1|];
- [ Left; Rewrite H1; Trivial
- | Right; Auto]
- ].
-Qed.
-
-Lemma in_prod : (A:Set)(B:Set)(l:(list A))(l':(list B))
- (x:A)(y:B)(In x l)->(In y l')->(In (x,y) (list_prod l l')).
-Proof.
- NewInduction l;
- [ Simpl; Tauto
- | Simpl; Intros; Apply in_or_app; NewDestruct H;
- [ Left; Rewrite H; Apply in_prod_aux; Assumption
- | Right; Auto]
- ].
-Qed.
-
-(** [(list_power x y)] is [y^x], or the set of sequences of elts of [y]
- indexed by elts of [x], sorted in lexicographic order. *)
-
-Fixpoint list_power [A,B:Set; l:(list A)] : (list B)->(list (list A*B)) :=
- [l']Cases l of
- nil => (cons nil nil)
- | (cons x t) => (flat_map [f:(list A*B)](map [y:B](cons (x,y) f) l')
- (list_power t l'))
- end.
-
-(************************************)
-(** Left-to-right iterator on lists *)
-(************************************)
-
-Section Fold_Left_Recursor.
-Variables A,B:Set.
-Variable f:A->B->A.
-Fixpoint fold_left[l:(list B)] : A -> A :=
-[a0]Cases l of
- nil => a0
- | (cons b t) => (fold_left t (f a0 b))
- end.
-End Fold_Left_Recursor.
-
-(************************************)
-(** Right-to-left iterator on lists *)
-(************************************)
-
-Section Fold_Right_Recursor.
-Variables A,B:Set.
-Variable f:B->A->A.
-Variable a0:A.
-Fixpoint fold_right [l:(list B)] : A :=
- Cases l of
- nil => a0
- | (cons b t) => (f b (fold_right t))
- end.
-End Fold_Right_Recursor.
-
-Theorem fold_symmetric :
- (A:Set)(f:A->A->A)
- ((x,y,z:A)(f x (f y z))=(f (f x y) z))
- ->((x,y:A)(f x y)=(f y x))
- ->(a0:A)(l:(list A))(fold_left f l a0)=(fold_right f a0 l).
-Proof.
-NewDestruct l as [|a l].
-Reflexivity.
-Simpl.
-Rewrite <- H0.
-Generalize a0 a.
-NewInduction l as [|a3 l IHl]; Simpl.
-Trivial.
-Intros.
-Rewrite H.
-Rewrite (H0 a2).
-Rewrite <- (H a1).
-Rewrite (H0 a1).
-Rewrite IHl.
-Reflexivity.
-Qed.
-
-End Functions_on_lists.
-
-V7only [Implicits nil [].].
-
-(** Exporting list notations *)
-
-V8Infix "::" cons (at level 60, right associativity) : list_scope.
-
-Infix RIGHTA 7 "^" app : list_scope V8only RIGHTA 60 "++".
-
-Open Scope list_scope.
diff --git a/theories/Lists/PolyListSyntax.v b/theories/Lists/PolyListSyntax.v
deleted file mode 100644
index a4b6a57aa..000000000
--- a/theories/Lists/PolyListSyntax.v
+++ /dev/null
@@ -1,10 +0,0 @@
-(***********************************************************************)
-(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA-Rocquencourt & LRI-CNRS-Orsay *)
-(* \VV/ *************************************************************)
-(* // * This file is distributed under the terms of the *)
-(* * GNU Lesser General Public License Version 2.1 *)
-(***********************************************************************)
-
-(*i $Id$ i*)
-
diff --git a/theories/Lists/Streams.v b/theories/Lists/Streams.v
index 9bbbe0e46..19c564eb9 100755
--- a/theories/Lists/Streams.v
+++ b/theories/Lists/Streams.v
@@ -16,115 +16,123 @@ Section Streams.
Variable A : Set.
-CoInductive Set Stream := Cons : A->Stream->Stream.
+CoInductive Stream : Set :=
+ Cons : A -> Stream -> Stream.
-Definition hd :=
- [x:Stream] Cases x of (Cons a _) => a end.
+Definition hd (x:Stream) := match x with
+ | Cons a _ => a
+ end.
-Definition tl :=
- [x:Stream] Cases x of (Cons _ s) => s end.
+Definition tl (x:Stream) := match x with
+ | Cons _ s => s
+ end.
-Fixpoint Str_nth_tl [n:nat] : Stream->Stream :=
- [s:Stream] Cases n of
- O => s
- |(S m) => (Str_nth_tl m (tl s))
- end.
+Fixpoint Str_nth_tl (n:nat) (s:Stream) {struct n} : Stream :=
+ match n with
+ | O => s
+ | S m => Str_nth_tl m (tl s)
+ end.
-Definition Str_nth : nat->Stream->A := [n:nat][s:Stream](hd (Str_nth_tl n s)).
+Definition Str_nth (n:nat) (s:Stream) : A := hd (Str_nth_tl n s).
-Lemma unfold_Stream :(x:Stream)x=(Cases x of (Cons a s) => (Cons a s) end).
+Lemma unfold_Stream :
+ forall x:Stream, x = match x with
+ | Cons a s => Cons a s
+ end.
Proof.
- Intro x.
- Case x.
- Trivial.
+ intro x.
+ case x.
+ trivial.
Qed.
-Lemma tl_nth_tl : (n:nat)(s:Stream)(tl (Str_nth_tl n s))=(Str_nth_tl n (tl s)).
+Lemma tl_nth_tl :
+ forall (n:nat) (s:Stream), tl (Str_nth_tl n s) = Str_nth_tl n (tl s).
Proof.
- Induction n; Simpl; Auto.
+ simple induction n; simpl in |- *; auto.
Qed.
-Hints Resolve tl_nth_tl : datatypes v62.
-
-Lemma Str_nth_tl_plus
-: (n,m:nat)(s:Stream)(Str_nth_tl n (Str_nth_tl m s))=(Str_nth_tl (plus n m) s).
-Induction n; Simpl; Intros; Auto with datatypes.
-Rewrite <- H.
-Rewrite tl_nth_tl; Trivial with datatypes.
+Hint Resolve tl_nth_tl: datatypes v62.
+
+Lemma Str_nth_tl_plus :
+ forall (n m:nat) (s:Stream),
+ Str_nth_tl n (Str_nth_tl m s) = Str_nth_tl (n + m) s.
+simple induction n; simpl in |- *; intros; auto with datatypes.
+rewrite <- H.
+rewrite tl_nth_tl; trivial with datatypes.
Qed.
-Lemma Str_nth_plus
- : (n,m:nat)(s:Stream)(Str_nth n (Str_nth_tl m s))=(Str_nth (plus n m) s).
-Intros; Unfold Str_nth; Rewrite Str_nth_tl_plus; Trivial with datatypes.
+Lemma Str_nth_plus :
+ forall (n m:nat) (s:Stream), Str_nth n (Str_nth_tl m s) = Str_nth (n + m) s.
+intros; unfold Str_nth in |- *; rewrite Str_nth_tl_plus;
+ trivial with datatypes.
Qed.
(** Extensional Equality between two streams *)
-CoInductive EqSt : Stream->Stream->Prop :=
- eqst : (s1,s2:Stream)
- ((hd s1)=(hd s2))->
- (EqSt (tl s1) (tl s2))
- ->(EqSt s1 s2).
+CoInductive EqSt : Stream -> Stream -> Prop :=
+ eqst :
+ forall s1 s2:Stream,
+ hd s1 = hd s2 -> EqSt (tl s1) (tl s2) -> EqSt s1 s2.
(** A coinduction principle *)
-Tactic Definition CoInduction proof :=
- Cofix proof; Intros; Constructor;
- [Clear proof | Try (Apply proof;Clear proof)].
+Ltac coinduction proof :=
+ cofix proof; intros; constructor;
+ [ clear proof | try (apply proof; clear proof) ].
(** Extensional equality is an equivalence relation *)
-Theorem EqSt_reflex : (s:Stream)(EqSt s s).
-CoInduction EqSt_reflex.
-Reflexivity.
+Theorem EqSt_reflex : forall s:Stream, EqSt s s.
+coinduction EqSt_reflex.
+reflexivity.
Qed.
-Theorem sym_EqSt :
- (s1:Stream)(s2:Stream)(EqSt s1 s2)->(EqSt s2 s1).
-(CoInduction Eq_sym).
-Case H;Intros;Symmetry;Assumption.
-Case H;Intros;Assumption.
+Theorem sym_EqSt : forall s1 s2:Stream, EqSt s1 s2 -> EqSt s2 s1.
+coinduction Eq_sym.
+case H; intros; symmetry in |- *; assumption.
+case H; intros; assumption.
Qed.
-Theorem trans_EqSt :
- (s1,s2,s3:Stream)(EqSt s1 s2)->(EqSt s2 s3)->(EqSt s1 s3).
-(CoInduction Eq_trans).
-Transitivity (hd s2).
-Case H; Intros; Assumption.
-Case H0; Intros; Assumption.
-Apply (Eq_trans (tl s1) (tl s2) (tl s3)).
-Case H; Trivial with datatypes.
-Case H0; Trivial with datatypes.
+Theorem trans_EqSt :
+ forall s1 s2 s3:Stream, EqSt s1 s2 -> EqSt s2 s3 -> EqSt s1 s3.
+coinduction Eq_trans.
+transitivity (hd s2).
+case H; intros; assumption.
+case H0; intros; assumption.
+apply (Eq_trans (tl s1) (tl s2) (tl s3)).
+case H; trivial with datatypes.
+case H0; trivial with datatypes.
Qed.
(** The definition given is equivalent to require the elements at each
position to be equal *)
Theorem eqst_ntheq :
- (n:nat)(s1,s2:Stream)(EqSt s1 s2)->(Str_nth n s1)=(Str_nth n s2).
-Unfold Str_nth; Induction n.
-Intros s1 s2 H; Case H; Trivial with datatypes.
-Intros m hypind.
-Simpl.
-Intros s1 s2 H.
-Apply hypind.
-Case H; Trivial with datatypes.
+ forall (n:nat) (s1 s2:Stream), EqSt s1 s2 -> Str_nth n s1 = Str_nth n s2.
+unfold Str_nth in |- *; simple induction n.
+intros s1 s2 H; case H; trivial with datatypes.
+intros m hypind.
+simpl in |- *.
+intros s1 s2 H.
+apply hypind.
+case H; trivial with datatypes.
Qed.
-Theorem ntheq_eqst :
- (s1,s2:Stream)((n:nat)(Str_nth n s1)=(Str_nth n s2))->(EqSt s1 s2).
-(CoInduction Equiv2).
-Apply (H O).
-Intros n; Apply (H (S n)).
+Theorem ntheq_eqst :
+ forall s1 s2:Stream,
+ (forall n:nat, Str_nth n s1 = Str_nth n s2) -> EqSt s1 s2.
+coinduction Equiv2.
+apply (H 0).
+intros n; apply (H (S n)).
Qed.
Section Stream_Properties.
-Variable P : Stream->Prop.
+Variable P : Stream -> Prop.
(*i
Inductive Exists : Stream -> Prop :=
@@ -132,21 +140,21 @@ Inductive Exists : Stream -> Prop :=
| Further : forall x:Stream, ~ P x -> Exists (tl x) -> Exists x.
i*)
-Inductive Exists : Stream -> Prop :=
- Here : (x:Stream)(P x) ->(Exists x) |
- Further : (x:Stream)(Exists (tl x))->(Exists x).
+Inductive Exists : Stream -> Prop :=
+ | Here : forall x:Stream, P x -> Exists x
+ | Further : forall x:Stream, Exists (tl x) -> Exists x.
-CoInductive ForAll : Stream -> Prop :=
- forall : (x:Stream)(P x)->(ForAll (tl x))->(ForAll x).
+CoInductive ForAll : Stream -> Prop :=
+ HereAndFurther : forall x:Stream, P x -> ForAll (tl x) -> ForAll x.
Section Co_Induction_ForAll.
-Variable Inv : Stream -> Prop.
-Hypothesis InvThenP : (x:Stream)(Inv x)->(P x).
-Hypothesis InvIsStable: (x:Stream)(Inv x)->(Inv (tl x)).
+Variable Inv : Stream -> Prop.
+Hypothesis InvThenP : forall x:Stream, Inv x -> P x.
+Hypothesis InvIsStable : forall x:Stream, Inv x -> Inv (tl x).
-Theorem ForAll_coind : (x:Stream)(Inv x)->(ForAll x).
-(CoInduction ForAll_coind);Auto.
+Theorem ForAll_coind : forall x:Stream, Inv x -> ForAll x.
+coinduction ForAll_coind; auto.
Qed.
End Co_Induction_ForAll.
@@ -155,16 +163,15 @@ End Stream_Properties.
End Streams.
Section Map.
-Variables A,B : Set.
-Variable f : A->B.
-CoFixpoint map : (Stream A)->(Stream B) :=
- [s:(Stream A)](Cons (f (hd s)) (map (tl s))).
+Variables A B : Set.
+Variable f : A -> B.
+CoFixpoint map (s:Stream A) : Stream B := Cons (f (hd s)) (map (tl s)).
End Map.
Section Constant_Stream.
Variable A : Set.
Variable a : A.
-CoFixpoint const : (Stream A) := (Cons a const).
+CoFixpoint const : Stream A := Cons a const.
End Constant_Stream.
-Unset Implicit Arguments.
+Unset Implicit Arguments. \ No newline at end of file
diff --git a/theories/Lists/TheoryList.v b/theories/Lists/TheoryList.v
index c7abe31da..da23394c0 100755
--- a/theories/Lists/TheoryList.v
+++ b/theories/Lists/TheoryList.v
@@ -10,32 +10,32 @@
(** Some programs and results about lists following CAML Manual *)
-Require Export PolyList.
+Require Export List.
Set Implicit Arguments.
-Chapter Lists.
+Section Lists.
-Variable A : Set.
+Variable A : Set.
(**********************)
(** The null function *)
(**********************)
-Definition Isnil : (list A) -> Prop := [l:(list A)](nil A)=l.
+Definition Isnil (l:list A) : Prop := nil = l.
-Lemma Isnil_nil : (Isnil (nil A)).
-Red; Auto.
+Lemma Isnil_nil : Isnil nil.
+red in |- *; auto.
Qed.
-Hints Resolve Isnil_nil.
+Hint Resolve Isnil_nil.
-Lemma not_Isnil_cons : (a:A)(l:(list A))~(Isnil (cons a l)).
-Unfold Isnil.
-Intros; Discriminate.
+Lemma not_Isnil_cons : forall (a:A) (l:list A), ~ Isnil (a :: l).
+unfold Isnil in |- *.
+intros; discriminate.
Qed.
-Hints Resolve Isnil_nil not_Isnil_cons.
+Hint Resolve Isnil_nil not_Isnil_cons.
-Lemma Isnil_dec : (l:(list A)){(Isnil l)}+{~(Isnil l)}.
-Intro l; Case l;Auto.
+Lemma Isnil_dec : forall l:list A, {Isnil l} + {~ Isnil l}.
+intro l; case l; auto.
(*
Realizer (fun l => match l with
| nil => true
@@ -48,10 +48,11 @@ Qed.
(** The Uncons function *)
(************************)
-Lemma Uncons : (l:(list A)){a : A & { m: (list A) | (cons a m)=l}}+{Isnil l}.
-Intro l; Case l.
-Auto.
-Intros a m; Intros; Left; Exists a; Exists m; Reflexivity.
+Lemma Uncons :
+ forall l:list A, {a : A & {m : list A | a :: m = l}} + {Isnil l}.
+intro l; case l.
+auto.
+intros a m; intros; left; exists a; exists m; reflexivity.
(*
Realizer (fun l => match l with
| nil => error
@@ -64,10 +65,11 @@ Qed.
(** The head function *)
(********************************)
-Lemma Hd : (l:(list A)){a : A | (EX m:(list A) |(cons a m)=l)}+{Isnil l}.
-Intro l; Case l.
-Auto.
-Intros a m; Intros; Left; Exists a; Exists m; Reflexivity.
+Lemma Hd :
+ forall l:list A, {a : A | exists m : list A | a :: m = l} + {Isnil l}.
+intro l; case l.
+auto.
+intros a m; intros; left; exists a; exists m; reflexivity.
(*
Realizer (fun l => match l with
| nil => error
@@ -76,11 +78,12 @@ Realizer (fun l => match l with
*)
Qed.
-Lemma Tl : (l:(list A)){m:(list A)| (EX a:A |(cons a m)=l)
- \/ ((Isnil l) /\ (Isnil m)) }.
-Intro l; Case l.
-Exists (nil A); Auto.
-Intros a m; Intros; Exists m; Left; Exists a; Reflexivity.
+Lemma Tl :
+ forall l:list A,
+ {m : list A | ( exists a : A | a :: m = l) \/ Isnil l /\ Isnil m}.
+intro l; case l.
+exists (nil (A:=A)); auto.
+intros a m; intros; exists m; left; exists a; reflexivity.
(*
Realizer (fun l => match l with
| nil => nil
@@ -94,25 +97,25 @@ Qed.
(****************************************)
(* length is defined in List *)
-Fixpoint Length_l [l:(list A)] : nat -> nat
- := [n:nat] Cases l of
- nil => n
- | (cons _ m) => (Length_l m (S n))
- end.
+Fixpoint Length_l (l:list A) (n:nat) {struct l} : nat :=
+ match l with
+ | nil => n
+ | _ :: m => Length_l m (S n)
+ end.
(* A tail recursive version *)
-Lemma Length_l_pf : (l:(list A))(n:nat){m:nat|(plus n (length l))=m}.
-NewInduction l as [|a m lrec].
-Intro n; Exists n; Simpl; Auto.
-Intro n; Elim (lrec (S n)); Simpl; Intros.
-Exists x; Transitivity (S (plus n (length m))); Auto.
+Lemma Length_l_pf : forall (l:list A) (n:nat), {m : nat | n + length l = m}.
+induction l as [| a m lrec].
+intro n; exists n; simpl in |- *; auto.
+intro n; elim (lrec (S n)); simpl in |- *; intros.
+exists x; transitivity (S (n + length m)); auto.
(*
Realizer Length_l.
*)
Qed.
-Lemma Length : (l:(list A)){m:nat|(length l)=m}.
-Intro l. Apply (Length_l_pf l O).
+Lemma Length : forall l:list A, {m : nat | length l = m}.
+intro l. apply (Length_l_pf l 0).
(*
Realizer (fun l -> Length_l_pf l O).
*)
@@ -121,43 +124,42 @@ Qed.
(*******************************)
(** Members of lists *)
(*******************************)
-Inductive In_spec [a:A] : (list A) -> Prop :=
- | in_hd : (l:(list A))(In_spec a (cons a l))
- | in_tl : (l:(list A))(b:A)(In a l)->(In_spec a (cons b l)).
-Hints Resolve in_hd in_tl.
-Hints Unfold In.
-Hints Resolve in_cons.
-
-Theorem In_In_spec : (a:A)(l:(list A))(In a l) <-> (In_spec a l).
-Split.
-Elim l; [ Intros; Contradiction
- | Intros; Elim H0;
- [ Intros; Rewrite H1; Auto
- | Auto ]].
-Intros; Elim H; Auto.
+Inductive In_spec (a:A) : list A -> Prop :=
+ | in_hd : forall l:list A, In_spec a (a :: l)
+ | in_tl : forall (l:list A) (b:A), In a l -> In_spec a (b :: l).
+Hint Resolve in_hd in_tl.
+Hint Unfold In.
+Hint Resolve in_cons.
+
+Theorem In_In_spec : forall (a:A) (l:list A), In a l <-> In_spec a l.
+split.
+elim l;
+ [ intros; contradiction
+ | intros; elim H0; [ intros; rewrite H1; auto | auto ] ].
+intros; elim H; auto.
Qed.
-Inductive AllS [P:A->Prop] : (list A) -> Prop
- := allS_nil : (AllS P (nil A))
- | allS_cons : (a:A)(l:(list A))(P a)->(AllS P l)->(AllS P (cons a l)).
-Hints Resolve allS_nil allS_cons.
+Inductive AllS (P:A -> Prop) : list A -> Prop :=
+ | allS_nil : AllS P nil
+ | allS_cons : forall (a:A) (l:list A), P a -> AllS P l -> AllS P (a :: l).
+Hint Resolve allS_nil allS_cons.
-Hypothesis eqA_dec : (a,b:A){a=b}+{~a=b}.
+Hypothesis eqA_dec : forall a b:A, {a = b} + {a <> b}.
-Fixpoint mem [a:A; l:(list A)] : bool :=
- Cases l of
- nil => false
- | (cons b m) => if (eqA_dec a b) then [H]true else [H](mem a m)
+Fixpoint mem (a:A) (l:list A) {struct l} : bool :=
+ match l with
+ | nil => false
+ | b :: m => if eqA_dec a b then fun H => true else fun H => mem a m
end.
-Hints Unfold In.
-Lemma Mem : (a:A)(l:(list A)){(In a l)}+{(AllS [b:A]~b=a l)}.
-Intros a l.
-NewInduction l.
-Auto.
-Elim (eqA_dec a a0).
-Auto.
-Simpl. Elim IHl; Auto.
+Hint Unfold In.
+Lemma Mem : forall (a:A) (l:list A), {In a l} + {AllS (fun b:A => b <> a) l}.
+intros a l.
+induction l.
+auto.
+elim (eqA_dec a a0).
+auto.
+simpl in |- *. elim IHl; auto.
(*
Realizer mem.
*)
@@ -167,146 +169,157 @@ Qed.
(** Index of elements *)
(*********************************)
-Require Le.
-Require Lt.
-
-Inductive nth_spec : (list A)->nat->A->Prop :=
- nth_spec_O : (a:A)(l:(list A))(nth_spec (cons a l) (S O) a)
-| nth_spec_S : (n:nat)(a,b:A)(l:(list A))
- (nth_spec l n a)->(nth_spec (cons b l) (S n) a).
-Hints Resolve nth_spec_O nth_spec_S.
-
-Inductive fst_nth_spec : (list A)->nat->A->Prop :=
- fst_nth_O : (a:A)(l:(list A))(fst_nth_spec (cons a l) (S O) a)
-| fst_nth_S : (n:nat)(a,b:A)(l:(list A))(~a=b)->
- (fst_nth_spec l n a)->(fst_nth_spec (cons b l) (S n) a).
-Hints Resolve fst_nth_O fst_nth_S.
-
-Lemma fst_nth_nth : (l:(list A))(n:nat)(a:A)(fst_nth_spec l n a)->(nth_spec l n a).
-NewInduction 1; Auto.
+Require Import Le.
+Require Import Lt.
+
+Inductive nth_spec : list A -> nat -> A -> Prop :=
+ | nth_spec_O : forall (a:A) (l:list A), nth_spec (a :: l) 1 a
+ | nth_spec_S :
+ forall (n:nat) (a b:A) (l:list A),
+ nth_spec l n a -> nth_spec (b :: l) (S n) a.
+Hint Resolve nth_spec_O nth_spec_S.
+
+Inductive fst_nth_spec : list A -> nat -> A -> Prop :=
+ | fst_nth_O : forall (a:A) (l:list A), fst_nth_spec (a :: l) 1 a
+ | fst_nth_S :
+ forall (n:nat) (a b:A) (l:list A),
+ a <> b -> fst_nth_spec l n a -> fst_nth_spec (b :: l) (S n) a.
+Hint Resolve fst_nth_O fst_nth_S.
+
+Lemma fst_nth_nth :
+ forall (l:list A) (n:nat) (a:A), fst_nth_spec l n a -> nth_spec l n a.
+induction 1; auto.
Qed.
-Hints Immediate fst_nth_nth.
+Hint Immediate fst_nth_nth.
-Lemma nth_lt_O : (l:(list A))(n:nat)(a:A)(nth_spec l n a)->(lt O n).
-NewInduction 1; Auto.
+Lemma nth_lt_O : forall (l:list A) (n:nat) (a:A), nth_spec l n a -> 0 < n.
+induction 1; auto.
Qed.
-Lemma nth_le_length : (l:(list A))(n:nat)(a:A)(nth_spec l n a)->(le n (length l)).
-NewInduction 1; Simpl; Auto with arith.
+Lemma nth_le_length :
+ forall (l:list A) (n:nat) (a:A), nth_spec l n a -> n <= length l.
+induction 1; simpl in |- *; auto with arith.
Qed.
-Fixpoint Nth_func [l:(list A)] : nat -> (Exc A)
- := [n:nat] Cases l n of
- (cons a _) (S O) => (value A a)
- | (cons _ l') (S (S p)) => (Nth_func l' (S p))
- | _ _ => Error
- end.
-
-Lemma Nth : (l:(list A))(n:nat)
- {a:A|(nth_spec l n a)}+{(n=O)\/(lt (length l) n)}.
-NewInduction l as [|a l IHl].
-Intro n; Case n; Simpl; Auto with arith.
-Intro n; NewDestruct n as [|[|n1]]; Simpl; Auto.
-Left; Exists a; Auto.
-NewDestruct (IHl (S n1)) as [[b]|o].
-Left; Exists b; Auto.
-Right; NewDestruct o.
-Absurd (S n1)=O; Auto.
-Auto with arith.
+Fixpoint Nth_func (l:list A) (n:nat) {struct l} : Exc A :=
+ match l, n with
+ | a :: _, S O => value a
+ | _ :: l', S (S p) => Nth_func l' (S p)
+ | _, _ => error
+ end.
+
+Lemma Nth :
+ forall (l:list A) (n:nat),
+ {a : A | nth_spec l n a} + {n = 0 \/ length l < n}.
+induction l as [| a l IHl].
+intro n; case n; simpl in |- *; auto with arith.
+intro n; destruct n as [| [| n1]]; simpl in |- *; auto.
+left; exists a; auto.
+destruct (IHl (S n1)) as [[b]| o].
+left; exists b; auto.
+right; destruct o.
+absurd (S n1 = 0); auto.
+auto with arith.
(*
Realizer Nth_func.
*)
Qed.
-Lemma Item : (l:(list A))(n:nat){a:A|(nth_spec l (S n) a)}+{(le (length l) n)}.
-Intros l n; Case (Nth l (S n)); Intro.
-Case s; Intro a; Left; Exists a; Auto.
-Right; Case o; Intro.
-Absurd (S n)=O; Auto.
-Auto with arith.
+Lemma Item :
+ forall (l:list A) (n:nat), {a : A | nth_spec l (S n) a} + {length l <= n}.
+intros l n; case (Nth l (S n)); intro.
+case s; intro a; left; exists a; auto.
+right; case o; intro.
+absurd (S n = 0); auto.
+auto with arith.
Qed.
-Require Minus.
-Require DecBool.
-
-Fixpoint index_p [a:A;l:(list A)] : nat -> (Exc nat) :=
- Cases l of nil => [p]Error
- | (cons b m) => [p](ifdec (eqA_dec a b) (Value p) (index_p a m (S p)))
- end.
-
-Lemma Index_p : (a:A)(l:(list A))(p:nat)
- {n:nat|(fst_nth_spec l (minus (S n) p) a)}+{(AllS [b:A]~a=b l)}.
-NewInduction l as [|b m irec].
-Auto.
-Intro p.
-NewDestruct (eqA_dec a b) as [e|e].
-Left; Exists p.
-NewDestruct e; Elim minus_Sn_m; Trivial; Elim minus_n_n; Auto with arith.
-NewDestruct (irec (S p)) as [[n H]|].
-Left; Exists n; Auto with arith.
-Elim minus_Sn_m; Auto with arith.
-Apply lt_le_weak; Apply lt_O_minus_lt; Apply nth_lt_O with m a; Auto with arith.
-Auto.
+Require Import Minus.
+Require Import DecBool.
+
+Fixpoint index_p (a:A) (l:list A) {struct l} : nat -> Exc nat :=
+ match l with
+ | nil => fun p => error
+ | b :: m => fun p => ifdec (eqA_dec a b) (value p) (index_p a m (S p))
+ end.
+
+Lemma Index_p :
+ forall (a:A) (l:list A) (p:nat),
+ {n : nat | fst_nth_spec l (S n - p) a} + {AllS (fun b:A => a <> b) l}.
+induction l as [| b m irec].
+auto.
+intro p.
+destruct (eqA_dec a b) as [e| e].
+left; exists p.
+destruct e; elim minus_Sn_m; trivial; elim minus_n_n; auto with arith.
+destruct (irec (S p)) as [[n H]| ].
+left; exists n; auto with arith.
+elim minus_Sn_m; auto with arith.
+apply lt_le_weak; apply lt_O_minus_lt; apply nth_lt_O with m a;
+ auto with arith.
+auto.
Qed.
-Lemma Index : (a:A)(l:(list A))
- {n:nat|(fst_nth_spec l n a)}+{(AllS [b:A]~a=b l)}.
+Lemma Index :
+ forall (a:A) (l:list A),
+ {n : nat | fst_nth_spec l n a} + {AllS (fun b:A => a <> b) l}.
-Intros a l; Case (Index_p a l (S O)); Auto.
-Intros (n,P); Left; Exists n; Auto.
-Rewrite (minus_n_O n); Trivial.
+intros a l; case (Index_p a l 1); auto.
+intros [n P]; left; exists n; auto.
+rewrite (minus_n_O n); trivial.
(*
Realizer (fun a l -> Index_p a l (S O)).
*)
Qed.
Section Find_sec.
-Variable R,P : A -> Prop.
+Variables R P : A -> Prop.
-Inductive InR : (list A) -> Prop
- := inR_hd : (a:A)(l:(list A))(R a)->(InR (cons a l))
- | inR_tl : (a:A)(l:(list A))(InR l)->(InR (cons a l)).
-Hints Resolve inR_hd inR_tl.
+Inductive InR : list A -> Prop :=
+ | inR_hd : forall (a:A) (l:list A), R a -> InR (a :: l)
+ | inR_tl : forall (a:A) (l:list A), InR l -> InR (a :: l).
+Hint Resolve inR_hd inR_tl.
-Definition InR_inv :=
- [l:(list A)]Cases l of
- nil => False
- | (cons b m) => (R b)\/(InR m)
- end.
+Definition InR_inv (l:list A) :=
+ match l with
+ | nil => False
+ | b :: m => R b \/ InR m
+ end.
-Lemma InR_INV : (l:(list A))(InR l)->(InR_inv l).
-NewInduction 1; Simpl; Auto.
+Lemma InR_INV : forall l:list A, InR l -> InR_inv l.
+induction 1; simpl in |- *; auto.
Qed.
-Lemma InR_cons_inv : (a:A)(l:(list A))(InR (cons a l))->((R a)\/(InR l)).
-Intros a l H; Exact (InR_INV H).
+Lemma InR_cons_inv : forall (a:A) (l:list A), InR (a :: l) -> R a \/ InR l.
+intros a l H; exact (InR_INV H).
Qed.
-Lemma InR_or_app : (l,m:(list A))((InR l)\/(InR m))->(InR (app l m)).
-Intros l m [|].
-NewInduction 1; Simpl; Auto.
-Intro. NewInduction l; Simpl; Auto.
+Lemma InR_or_app : forall l m:list A, InR l \/ InR m -> InR (l ++ m).
+intros l m [| ].
+induction 1; simpl in |- *; auto.
+intro. induction l; simpl in |- *; auto.
Qed.
-Lemma InR_app_or : (l,m:(list A))(InR (app l m))->((InR l)\/(InR m)).
-Intros l m; Elim l; Simpl; Auto.
-Intros b l' Hrec IAc; Elim (InR_cons_inv IAc);Auto.
-Intros; Elim Hrec; Auto.
+Lemma InR_app_or : forall l m:list A, InR (l ++ m) -> InR l \/ InR m.
+intros l m; elim l; simpl in |- *; auto.
+intros b l' Hrec IAc; elim (InR_cons_inv IAc); auto.
+intros; elim Hrec; auto.
Qed.
-Hypothesis RS_dec : (a:A){(R a)}+{(P a)}.
+Hypothesis RS_dec : forall a:A, {R a} + {P a}.
-Fixpoint find [l:(list A)] : (Exc A) :=
- Cases l of nil => Error
- | (cons a m) => (ifdec (RS_dec a) (Value a) (find m))
- end.
+Fixpoint find (l:list A) : Exc A :=
+ match l with
+ | nil => error
+ | a :: m => ifdec (RS_dec a) (value a) (find m)
+ end.
-Lemma Find : (l:(list A)){a:A | (In a l) & (R a)}+{(AllS P l)}.
-NewInduction l as [|a m [[b H1 H2]|H]]; Auto.
-Left; Exists b; Auto.
-NewDestruct (RS_dec a).
-Left; Exists a; Auto.
-Auto.
+Lemma Find : forall l:list A, {a : A | In a l & R a} + {AllS P l}.
+induction l as [| a m [[b H1 H2]| H]]; auto.
+left; exists b; auto.
+destruct (RS_dec a).
+left; exists a; auto.
+auto.
(*
Realizer find.
*)
@@ -315,26 +328,27 @@ Qed.
Variable B : Set.
Variable T : A -> B -> Prop.
-Variable TS_dec : (a:A){c:B| (T a c)}+{(P a)}.
-
-Fixpoint try_find [l:(list A)] : (Exc B) :=
- Cases l of
- nil => Error
- | (cons a l1) =>
- Cases (TS_dec a) of
- (inleft (exist c _)) => (Value c)
- | (inright _) => (try_find l1)
- end
- end.
-
-Lemma Try_find : (l:(list A)){c:B|(EX a:A |(In a l) & (T a c))}+{(AllS P l)}.
-NewInduction l as [|a m [[b H1]|H]].
-Auto.
-Left; Exists b; NewDestruct H1 as [a' H2 H3]; Exists a'; Auto.
-NewDestruct (TS_dec a) as [[c H1]|].
-Left; Exists c.
-Exists a; Auto.
-Auto.
+Variable TS_dec : forall a:A, {c : B | T a c} + {P a}.
+
+Fixpoint try_find (l:list A) : Exc B :=
+ match l with
+ | nil => error
+ | a :: l1 =>
+ match TS_dec a with
+ | inleft (exist c _) => value c
+ | inright _ => try_find l1
+ end
+ end.
+
+Lemma Try_find :
+ forall l:list A, {c : B | exists2 a : A | In a l & T a c} + {AllS P l}.
+induction l as [| a m [[b H1]| H]].
+auto.
+left; exists b; destruct H1 as [a' H2 H3]; exists a'; auto.
+destruct (TS_dec a) as [[c H1]| ].
+left; exists c.
+exists a; auto.
+auto.
(*
Realizer try_find.
*)
@@ -345,17 +359,20 @@ End Find_sec.
Section Assoc_sec.
Variable B : Set.
-Fixpoint assoc [a:A;l:(list A*B)] : (Exc B) :=
- Cases l of nil => Error
- | (cons (a',b) m) => (ifdec (eqA_dec a a') (Value b) (assoc a m))
- end.
+Fixpoint assoc (a:A) (l:list (A * B)) {struct l} :
+ Exc B :=
+ match l with
+ | nil => error
+ | (a', b) :: m => ifdec (eqA_dec a a') (value b) (assoc a m)
+ end.
-Inductive AllS_assoc [P:A -> Prop]: (list A*B) -> Prop :=
- allS_assoc_nil : (AllS_assoc P (nil A*B))
- | allS_assoc_cons : (a:A)(b:B)(l:(list A*B))
- (P a)->(AllS_assoc P l)->(AllS_assoc P (cons (a,b) l)).
+Inductive AllS_assoc (P:A -> Prop) : list (A * B) -> Prop :=
+ | allS_assoc_nil : AllS_assoc P nil
+ | allS_assoc_cons :
+ forall (a:A) (b:B) (l:list (A * B)),
+ P a -> AllS_assoc P l -> AllS_assoc P ((a, b) :: l).
-Hints Resolve allS_assoc_nil allS_assoc_cons.
+Hint Resolve allS_assoc_nil allS_assoc_cons.
(* The specification seems too weak: it is enough to return b if the
list has at least an element (a,b); probably the intention is to have
@@ -364,13 +381,14 @@ Hints Resolve allS_assoc_nil allS_assoc_cons.
(a:A)(l:(list A*B)){b:B|(In_spec (a,b) l)}+{(AllS_assoc [a':A]~(a=a') l)}.
*)
-Lemma Assoc : (a:A)(l:(list A*B))(B+{(AllS_assoc [a':A]~(a=a') l)}).
-NewInduction l as [|[a' b] m assrec]. Auto.
-NewDestruct (eqA_dec a a').
-Left; Exact b.
-NewDestruct assrec as [b'|].
-Left; Exact b'.
-Right; Auto.
+Lemma Assoc :
+ forall (a:A) (l:list (A * B)), B + {AllS_assoc (fun a':A => a <> a') l}.
+induction l as [| [a' b] m assrec]. auto.
+destruct (eqA_dec a a').
+left; exact b.
+destruct assrec as [b'| ].
+left; exact b'.
+right; auto.
(*
Realizer assoc.
*)
@@ -380,7 +398,6 @@ End Assoc_sec.
End Lists.
-Hints Resolve Isnil_nil not_Isnil_cons in_hd in_tl in_cons allS_nil allS_cons
- : datatypes.
-Hints Immediate fst_nth_nth : datatypes.
-
+Hint Resolve Isnil_nil not_Isnil_cons in_hd in_tl in_cons allS_nil allS_cons:
+ datatypes.
+Hint Immediate fst_nth_nth: datatypes.
diff --git a/theories/Logic/Berardi.v b/theories/Logic/Berardi.v
index 9f6217320..932db000f 100644
--- a/theories/Logic/Berardi.v
+++ b/theories/Logic/Berardi.v
@@ -31,62 +31,55 @@ Set Implicit Arguments.
Section Berardis_paradox.
(** Excluded middle *)
-Hypothesis EM : (P:Prop) P \/ ~P.
+Hypothesis EM : forall P:Prop, P \/ ~ P.
(** Conditional on any proposition. *)
-Definition IFProp := [P,B:Prop][e1,e2:P]
- Cases (EM B) of
- (or_introl _) => e1
- | (or_intror _) => e2
+Definition IFProp (P B:Prop) (e1 e2:P) :=
+ match EM B with
+ | or_introl _ => e1
+ | or_intror _ => e2
end.
(** Axiom of choice applied to disjunction.
Provable in Coq because of dependent elimination. *)
-Lemma AC_IF : (P,B:Prop)(e1,e2:P)(Q:P->Prop)
- ( B -> (Q e1))->
- (~B -> (Q e2))->
- (Q (IFProp B e1 e2)).
+Lemma AC_IF :
+ forall (P B:Prop) (e1 e2:P) (Q:P -> Prop),
+ (B -> Q e1) -> (~ B -> Q e2) -> Q (IFProp B e1 e2).
Proof.
-Intros P B e1 e2 Q p1 p2.
-Unfold IFProp.
-Case (EM B); Assumption.
+intros P B e1 e2 Q p1 p2.
+unfold IFProp in |- *.
+case (EM B); assumption.
Qed.
(** We assume a type with two elements. They play the role of booleans.
The main theorem under the current assumptions is that [T=F] *)
-Variable Bool: Prop.
-Variable T: Bool.
-Variable F: Bool.
+Variable Bool : Prop.
+Variable T : Bool.
+Variable F : Bool.
(** The powerset operator *)
-Definition pow [P:Prop] :=P->Bool.
+Definition pow (P:Prop) := P -> Bool.
(** A piece of theory about retracts *)
Section Retracts.
-Variable A,B: Prop.
+Variables A B : Prop.
-Record retract : Prop := {
- i: A->B;
- j: B->A;
- inv: (a:A)(j (i a))==a
- }.
+Record retract : Prop :=
+ {i : A -> B; j : B -> A; inv : forall a:A, j (i a) = a}.
-Record retract_cond : Prop := {
- i2: A->B;
- j2: B->A;
- inv2: retract -> (a:A)(j2 (i2 a))==a
- }.
+Record retract_cond : Prop :=
+ {i2 : A -> B; j2 : B -> A; inv2 : retract -> forall a:A, j2 (i2 a) = a}.
(** The dependent elimination above implies the axiom of choice: *)
-Lemma AC: (r:retract_cond) retract -> (a:A)((j2 r) ((i2 r) a))==a.
+Lemma AC : forall r:retract_cond, retract -> forall a:A, j2 r (i2 r a) = a.
Proof.
-Intros r.
-Case r; Simpl.
-Trivial.
+intros r.
+case r; simpl in |- *.
+trivial.
Qed.
End Retracts.
@@ -96,75 +89,71 @@ End Retracts.
which is provable in classical logic ( => is already provable in
intuitionnistic logic). *)
-Lemma L1 : (A,B:Prop)(retract_cond (pow A) (pow B)).
+Lemma L1 : forall A B:Prop, retract_cond (pow A) (pow B).
Proof.
-Intros A B.
-Elim (EM (retract (pow A) (pow B))).
-Intros (f0, g0, e).
-Exists f0 g0.
-Trivial.
-
-Intros hf.
-Exists ([x:(pow A); y:B]F) ([x:(pow B); y:A]F).
-Intros; Elim hf; Auto.
+intros A B.
+elim (EM (retract (pow A) (pow B))).
+intros [f0 g0 e].
+exists f0 g0.
+trivial.
+
+intros hf.
+exists (fun (x:pow A) (y:B) => F) (fun (x:pow B) (y:A) => F).
+intros; elim hf; auto.
Qed.
(** The paradoxical set *)
-Definition U := (P:Prop)(pow P).
+Definition U := forall P:Prop, pow P.
(** Bijection between [U] and [(pow U)] *)
-Definition f : U -> (pow U) :=
- [u](u U).
+Definition f (u:U) : pow U := u U.
-Definition g : (pow U) -> U :=
- [h,X]
- let lX = (j2 (L1 X U)) in
- let rU = (i2 (L1 U U)) in
- (lX (rU h)).
+Definition g (h:pow U) : U :=
+ fun X => let lX := j2 (L1 X U) in let rU := i2 (L1 U U) in lX (rU h).
(** We deduce that the powerset of [U] is a retract of [U].
This lemma is stated in Berardi's article, but is not used
afterwards. *)
-Lemma retract_pow_U_U : (retract (pow U) U).
+Lemma retract_pow_U_U : retract (pow U) U.
Proof.
-Exists g f.
-Intro a.
-Unfold f g; Simpl.
-Apply AC.
-Exists ([x:(pow U)]x) ([x:(pow U)]x).
-Trivial.
+exists g f.
+intro a.
+unfold f, g in |- *; simpl in |- *.
+apply AC.
+exists (fun x:pow U => x) (fun x:pow U => x).
+trivial.
Qed.
(** Encoding of Russel's paradox *)
(** The boolean negation. *)
-Definition Not_b := [b:Bool](IFProp b==T F T).
+Definition Not_b (b:Bool) := IFProp (b = T) F T.
(** the set of elements not belonging to itself *)
-Definition R : U := (g ([u:U](Not_b (u U u)))).
+Definition R : U := g (fun u:U => Not_b (u U u)).
-Lemma not_has_fixpoint : (R R)==(Not_b (R R)).
+Lemma not_has_fixpoint : R R = Not_b (R R).
Proof.
-Unfold 1 R.
-Unfold g.
-Rewrite AC with r:=(L1 U U) a:=[u:U](Not_b (u U u)).
-Trivial.
-Exists ([x:(pow U)]x) ([x:(pow U)]x); Trivial.
+unfold R at 1 in |- *.
+unfold g in |- *.
+rewrite AC with (r := L1 U U) (a := fun u:U => Not_b (u U u)).
+trivial.
+exists (fun x:pow U => x) (fun x:pow U => x); trivial.
Qed.
-Theorem classical_proof_irrelevence : T==F.
+Theorem classical_proof_irrelevence : T = F.
Proof.
-Generalize not_has_fixpoint.
-Unfold Not_b.
-Apply AC_IF.
-Intros is_true is_false.
-Elim is_true; Elim is_false; Trivial.
-
-Intros not_true is_true.
-Elim not_true; Trivial.
+generalize not_has_fixpoint.
+unfold Not_b in |- *.
+apply AC_IF.
+intros is_true is_false.
+elim is_true; elim is_false; trivial.
+
+intros not_true is_true.
+elim not_true; trivial.
Qed.
-End Berardis_paradox.
+End Berardis_paradox. \ No newline at end of file
diff --git a/theories/Logic/ChoiceFacts.v b/theories/Logic/ChoiceFacts.v
index 699051ec1..192603273 100644
--- a/theories/Logic/ChoiceFacts.v
+++ b/theories/Logic/ChoiceFacts.v
@@ -18,64 +18,66 @@
though definite description conflicts with classical logic *)
Definition RelationalChoice :=
- (A:Type;B:Type;R: A->B->Prop)
- ((x:A)(EX y:B|(R x y)))
- -> (EXT R':A->B->Prop |
- ((x:A)(EX y:B|(R x y)/\(R' x y)/\ ((y':B) (R' x y') -> y=y')))).
+ forall (A B:Type) (R:A -> B -> Prop),
+ (forall x:A, exists y : B | R x y) ->
+ exists R' : A -> B -> Prop
+ | (forall x:A,
+ exists y : B | R x y /\ R' x y /\ (forall y':B, R' x y' -> y = y')).
Definition FunctionalChoice :=
- (A:Type;B:Type;R: A->B->Prop)
- ((x:A)(EX y:B|(R x y))) -> (EX f:A->B | (x:A)(R x (f x))).
+ forall (A B:Type) (R:A -> B -> Prop),
+ (forall x:A, exists y : B | R x y) ->
+ exists f : A -> B | (forall x:A, R x (f x)).
Definition ParamDefiniteDescription :=
- (A:Type;B:Type;R: A->B->Prop)
- ((x:A)(EX y:B|(R x y)/\ ((y':B)(R x y') -> y=y')))
- -> (EX f:A->B | (x:A)(R x (f x))).
-
-Lemma description_rel_choice_imp_funct_choice :
- ParamDefiniteDescription->RelationalChoice->FunctionalChoice.
-Intros Descr RelCh.
-Red; Intros A B R H.
-NewDestruct (RelCh A B R H) as [R' H0].
-NewDestruct (Descr A B R') as [f H1].
-Intro x.
-Elim (H0 x); Intros y [H2 [H3 H4]]; Exists y; Split; [Exact H3 | Exact H4].
-Exists f; Intro x.
-Elim (H0 x); Intros y [H2 [H3 H4]].
-Rewrite <- (H4 (f x) (H1 x)).
-Exact H2.
+ forall (A B:Type) (R:A -> B -> Prop),
+ (forall x:A, exists y : B | R x y /\ (forall y':B, R x y' -> y = y')) ->
+ exists f : A -> B | (forall x:A, R x (f x)).
+
+Lemma description_rel_choice_imp_funct_choice :
+ ParamDefiniteDescription -> RelationalChoice -> FunctionalChoice.
+intros Descr RelCh.
+red in |- *; intros A B R H.
+destruct (RelCh A B R H) as [R' H0].
+destruct (Descr A B R') as [f H1].
+intro x.
+elim (H0 x); intros y [H2 [H3 H4]]; exists y; split; [ exact H3 | exact H4 ].
+exists f; intro x.
+elim (H0 x); intros y [H2 [H3 H4]].
+rewrite <- (H4 (f x) (H1 x)).
+exact H2.
Qed.
-Lemma funct_choice_imp_rel_choice :
- FunctionalChoice->RelationalChoice.
-Intros FunCh.
-Red; Intros A B R H.
-NewDestruct (FunCh A B R H) as [f H0].
-Exists [x,y]y=(f x).
-Intro x; Exists (f x);
-Split; [Apply H0| Split;[Reflexivity| Intros y H1; Symmetry; Exact H1]].
+Lemma funct_choice_imp_rel_choice : FunctionalChoice -> RelationalChoice.
+intros FunCh.
+red in |- *; intros A B R H.
+destruct (FunCh A B R H) as [f H0].
+exists (fun x y => y = f x).
+intro x; exists (f x); split;
+ [ apply H0
+ | split; [ reflexivity | intros y H1; symmetry in |- *; exact H1 ] ].
Qed.
-Lemma funct_choice_imp_description :
- FunctionalChoice->ParamDefiniteDescription.
-Intros FunCh.
-Red; Intros A B R H.
-NewDestruct (FunCh A B R) as [f H0].
+Lemma funct_choice_imp_description :
+ FunctionalChoice -> ParamDefiniteDescription.
+intros FunCh.
+red in |- *; intros A B R H.
+destruct (FunCh A B R) as [f H0].
(* 1 *)
-Intro x.
-Elim (H x); Intros y [H0 H1].
-Exists y; Exact H0.
+intro x.
+elim (H x); intros y [H0 H1].
+exists y; exact H0.
(* 2 *)
-Exists f; Exact H0.
+exists f; exact H0.
Qed.
Theorem FunChoice_Equiv_RelChoice_and_ParamDefinDescr :
- FunctionalChoice <-> RelationalChoice /\ ParamDefiniteDescription.
-Split.
-Intro H; Split; [
- Exact (funct_choice_imp_rel_choice H)
- | Exact (funct_choice_imp_description H)].
-Intros [H H0]; Exact (description_rel_choice_imp_funct_choice H0 H).
+ FunctionalChoice <-> RelationalChoice /\ ParamDefiniteDescription.
+split.
+intro H; split;
+ [ exact (funct_choice_imp_rel_choice H)
+ | exact (funct_choice_imp_description H) ].
+intros [H H0]; exact (description_rel_choice_imp_funct_choice H0 H).
Qed.
(* We show that the guarded relational formulation of the axiom of Choice
@@ -83,52 +85,55 @@ Qed.
independance of premises or proof-irrelevance *)
Definition GuardedRelationalChoice :=
- (A:Type;B:Type;P:A->Prop;R: A->B->Prop)
- ((x:A)(P x)->(EX y:B|(R x y)))
- -> (EXT R':A->B->Prop |
- ((x:A)(P x)->(EX y:B|(R x y)/\(R' x y)/\ ((y':B) (R' x y') -> y=y')))).
+ forall (A B:Type) (P:A -> Prop) (R:A -> B -> Prop),
+ (forall x:A, P x -> exists y : B | R x y) ->
+ exists R' : A -> B -> Prop
+ | (forall x:A,
+ P x ->
+ exists y : B | R x y /\ R' x y /\ (forall y':B, R' x y' -> y = y')).
-Definition ProofIrrelevance := (A:Prop)(a1,a2:A) a1==a2.
+Definition ProofIrrelevance := forall (A:Prop) (a1 a2:A), a1 = a2.
-Lemma rel_choice_and_proof_irrel_imp_guarded_rel_choice :
- RelationalChoice -> ProofIrrelevance -> GuardedRelationalChoice.
+Lemma rel_choice_and_proof_irrel_imp_guarded_rel_choice :
+ RelationalChoice -> ProofIrrelevance -> GuardedRelationalChoice.
Proof.
-Intros rel_choice proof_irrel.
-Red; Intros A B P R H.
-NewDestruct (rel_choice ? ? [x:(sigT ? P);y:B](R (projT1 ? ? x) y)) as [R' H0].
-Intros [x HPx].
-NewDestruct (H x HPx) as [y HRxy].
-Exists y; Exact HRxy.
-Pose R'':=[x:A;y:B](EXT H:(P x) | (R' (existT ? P x H) y)).
-Exists R''; Intros x HPx.
-NewDestruct (H0 (existT ? P x HPx)) as [y [HRxy [HR'xy Huniq]]].
-Exists y. Split.
- Exact HRxy.
- Split.
- Red; Exists HPx; Exact HR'xy.
- Intros y' HR''xy'.
- Apply Huniq.
- Unfold R'' in HR''xy'.
- NewDestruct HR''xy' as [H'Px HR'xy'].
- Rewrite proof_irrel with a1:=HPx a2:=H'Px.
- Exact HR'xy'.
+intros rel_choice proof_irrel.
+red in |- *; intros A B P R H.
+destruct (rel_choice _ _ (fun (x:sigT P) (y:B) => R (projT1 x) y)) as [R' H0].
+intros [x HPx].
+destruct (H x HPx) as [y HRxy].
+exists y; exact HRxy.
+pose (R'' := fun (x:A) (y:B) => exists H : P x | R' (existT P x H) y).
+exists R''; intros x HPx.
+destruct (H0 (existT P x HPx)) as [y [HRxy [HR'xy Huniq]]].
+exists y. split.
+ exact HRxy.
+ split.
+ red in |- *; exists HPx; exact HR'xy.
+ intros y' HR''xy'.
+ apply Huniq.
+ unfold R'' in HR''xy'.
+ destruct HR''xy' as [H'Px HR'xy'].
+ rewrite proof_irrel with (a1 := HPx) (a2 := H'Px).
+ exact HR'xy'.
Qed.
Definition IndependenceOfPremises :=
- (A:Type)(P:A->Prop)(Q:Prop)(Q->(EXT x|(P x)))->(EXT x|Q->(P x)).
+ forall (A:Type) (P:A -> Prop) (Q:Prop),
+ (Q -> exists x : _ | P x) -> exists x : _ | Q -> P x.
Lemma rel_choice_indep_of_premises_imp_guarded_rel_choice :
- RelationalChoice -> IndependenceOfPremises -> GuardedRelationalChoice.
+ RelationalChoice -> IndependenceOfPremises -> GuardedRelationalChoice.
Proof.
-Intros RelCh IndPrem.
-Red; Intros A B P R H.
-NewDestruct (RelCh A B [x,y](P x)->(R x y)) as [R' H0].
- Intro x. Apply IndPrem.
- Apply H.
- Exists R'.
- Intros x HPx.
- NewDestruct (H0 x) as [y [H1 H2]].
- Exists y. Split.
- Apply (H1 HPx).
- Exact H2.
-Qed.
+intros RelCh IndPrem.
+red in |- *; intros A B P R H.
+destruct (RelCh A B (fun x y => P x -> R x y)) as [R' H0].
+ intro x. apply IndPrem.
+ apply H.
+ exists R'.
+ intros x HPx.
+ destruct (H0 x) as [y [H1 H2]].
+ exists y. split.
+ apply (H1 HPx).
+ exact H2.
+Qed. \ No newline at end of file
diff --git a/theories/Logic/Classical.v b/theories/Logic/Classical.v
index 324005caf..1f3b531af 100755
--- a/theories/Logic/Classical.v
+++ b/theories/Logic/Classical.v
@@ -11,4 +11,4 @@
(** Classical Logic *)
Require Export Classical_Prop.
-Require Export Classical_Pred_Type.
+Require Export Classical_Pred_Type. \ No newline at end of file
diff --git a/theories/Logic/ClassicalChoice.v b/theories/Logic/ClassicalChoice.v
index 31f58a95e..80bbce461 100644
--- a/theories/Logic/ClassicalChoice.v
+++ b/theories/Logic/ClassicalChoice.v
@@ -19,13 +19,14 @@
Require Export ClassicalDescription.
Require Export RelationalChoice.
-Require ChoiceFacts.
+Require Import ChoiceFacts.
-Theorem choice :
- (A:Type;B:Type;R: A->B->Prop)
- ((x:A)(EX y:B|(R x y))) -> (EX f:A->B | (x:A)(R x (f x))).
+Theorem choice :
+ forall (A B:Type) (R:A -> B -> Prop),
+ (forall x:A, exists y : B | R x y) ->
+ exists f : A -> B | (forall x:A, R x (f x)).
Proof.
-Apply description_rel_choice_imp_funct_choice.
-Exact description.
-Exact relational_choice.
-Qed.
+apply description_rel_choice_imp_funct_choice.
+exact description.
+exact relational_choice.
+Qed. \ No newline at end of file
diff --git a/theories/Logic/ClassicalDescription.v b/theories/Logic/ClassicalDescription.v
index ea2f4f727..26e696a7c 100644
--- a/theories/Logic/ClassicalDescription.v
+++ b/theories/Logic/ClassicalDescription.v
@@ -22,55 +22,57 @@
Require Export Classical.
-Axiom dependent_description :
- (A:Type;B:A->Type;R: (x:A)(B x)->Prop)
- ((x:A)(EX y:(B x)|(R x y)/\ ((y':(B x))(R x y') -> y=y')))
- -> (EX f:(x:A)(B x) | (x:A)(R x (f x))).
+Axiom
+ dependent_description :
+ forall (A:Type) (B:A -> Type) (R:forall x:A, B x -> Prop),
+ (forall x:A,
+ exists y : B x | R x y /\ (forall y':B x, R x y' -> y = y')) ->
+ exists f : forall x:A, B x | (forall x:A, R x (f x)).
(** Principle of definite description (aka axiom of unique choice) *)
Theorem description :
- (A:Type;B:Type;R: A->B->Prop)
- ((x:A)(EX y:B|(R x y)/\ ((y':B)(R x y') -> y=y')))
- -> (EX f:A->B | (x:A)(R x (f x))).
+ forall (A B:Type) (R:A -> B -> Prop),
+ (forall x:A, exists y : B | R x y /\ (forall y':B, R x y' -> y = y')) ->
+ exists f : A -> B | (forall x:A, R x (f x)).
Proof.
-Intros A B.
-Apply (dependent_description A [_]B).
+intros A B.
+apply (dependent_description A (fun _ => B)).
Qed.
(** The followig proof comes from [1] *)
-Theorem classic_set : (((P:Prop){P}+{~P}) -> False) -> False.
+Theorem classic_set : ((forall P:Prop, {P} + {~ P}) -> False) -> False.
Proof.
-Intro HnotEM.
-Pose R:=[A,b]A/\true=b \/ ~A/\false=b.
-Assert H:(EX f:Prop->bool|(A:Prop)(R A (f A))).
-Apply description.
-Intro A.
-NewDestruct (classic A) as [Ha|Hnota].
- Exists true; Split.
- Left; Split; [Assumption|Reflexivity].
- Intros y [[_ Hy]|[Hna _]].
- Assumption.
- Contradiction.
- Exists false; Split.
- Right; Split; [Assumption|Reflexivity].
- Intros y [[Ha _]|[_ Hy]].
- Contradiction.
- Assumption.
-NewDestruct H as [f Hf].
-Apply HnotEM.
-Intro P.
-Assert HfP := (Hf P).
+intro HnotEM.
+pose (R := fun A b => A /\ true = b \/ ~ A /\ false = b).
+assert (H : exists f : Prop -> bool | (forall A:Prop, R A (f A))).
+apply description.
+intro A.
+destruct (classic A) as [Ha| Hnota].
+ exists true; split.
+ left; split; [ assumption | reflexivity ].
+ intros y [[_ Hy]| [Hna _]].
+ assumption.
+ contradiction.
+ exists false; split.
+ right; split; [ assumption | reflexivity ].
+ intros y [[Ha _]| [_ Hy]].
+ contradiction.
+ assumption.
+destruct H as [f Hf].
+apply HnotEM.
+intro P.
+assert (HfP := Hf P).
(* Elimination from Hf to Set is not allowed but from f to Set yes ! *)
-NewDestruct (f P).
- Left.
- NewDestruct HfP as [[Ha _]|[_ Hfalse]].
- Assumption.
- Discriminate.
- Right.
- NewDestruct HfP as [[_ Hfalse]|[Hna _]].
- Discriminate.
- Assumption.
+destruct (f P).
+ left.
+ destruct HfP as [[Ha _]| [_ Hfalse]].
+ assumption.
+ discriminate.
+ right.
+ destruct HfP as [[_ Hfalse]| [Hna _]].
+ discriminate.
+ assumption.
Qed.
-
+ \ No newline at end of file
diff --git a/theories/Logic/ClassicalFacts.v b/theories/Logic/ClassicalFacts.v
index 622e6959d..0ece7ac76 100644
--- a/theories/Logic/ClassicalFacts.v
+++ b/theories/Logic/ClassicalFacts.v
@@ -12,49 +12,50 @@
(** [prop_degeneracy] asserts (up to consistency) that there are only *)
(* two distinct formulas *)
-Definition prop_degeneracy := (A:Prop) A==True \/ A==False.
+Definition prop_degeneracy := forall A:Prop, A = True \/ A = False.
(** [prop_extensionality] asserts equivalent formulas are equal *)
-Definition prop_extensionality := (A,B:Prop) (A<->B) -> A==B.
+Definition prop_extensionality := forall A B:Prop, (A <-> B) -> A = B.
(** [excluded_middle] asserts we can reason by case on the truth *)
(* or falsity of any formula *)
-Definition excluded_middle := (A:Prop) A \/ ~A.
+Definition excluded_middle := forall A:Prop, A \/ ~ A.
(** [proof_irrelevance] asserts equality of all proofs of a given formula *)
-Definition proof_irrelevance := (A:Prop)(a1,a2:A) a1==a2.
+Definition proof_irrelevance := forall (A:Prop) (a1 a2:A), a1 = a2.
(** We show [prop_degeneracy <-> (prop_extensionality /\ excluded_middle)] *)
Lemma prop_degen_ext : prop_degeneracy -> prop_extensionality.
Proof.
-Intros H A B (Hab,Hba).
-NewDestruct (H A); NewDestruct (H B).
- Rewrite H1; Exact H0.
- Absurd B.
- Rewrite H1; Exact [H]H.
- Apply Hab; Rewrite H0; Exact I.
- Absurd A.
- Rewrite H0; Exact [H]H.
- Apply Hba; Rewrite H1; Exact I.
- Rewrite H1; Exact H0.
+intros H A B [Hab Hba].
+destruct (H A); destruct (H B).
+ rewrite H1; exact H0.
+ absurd B.
+ rewrite H1; exact (fun H => H).
+ apply Hab; rewrite H0; exact I.
+ absurd A.
+ rewrite H0; exact (fun H => H).
+ apply Hba; rewrite H1; exact I.
+ rewrite H1; exact H0.
Qed.
Lemma prop_degen_em : prop_degeneracy -> excluded_middle.
Proof.
-Intros H A.
-NewDestruct (H A).
- Left; Rewrite H0; Exact I.
- Right; Rewrite H0; Exact [x]x.
+intros H A.
+destruct (H A).
+ left; rewrite H0; exact I.
+ right; rewrite H0; exact (fun x => x).
Qed.
Lemma prop_ext_em_degen :
- prop_extensionality -> excluded_middle -> prop_degeneracy.
+ prop_extensionality -> excluded_middle -> prop_degeneracy.
Proof.
-Intros Ext EM A.
-NewDestruct (EM A).
- Left; Apply (Ext A True); Split; [Exact [_]I | Exact [_]H].
- Right; Apply (Ext A False); Split; [Exact H | Apply False_ind].
+intros Ext EM A.
+destruct (EM A).
+ left; apply (Ext A True); split;
+ [ exact (fun _ => I) | exact (fun _ => H) ].
+ right; apply (Ext A False); split; [ exact H | apply False_ind ].
Qed.
(** We successively show that:
@@ -67,45 +68,40 @@ Qed.
(e.g. take the Y combinator of lambda-calculus)
*)
-Definition inhabited [A:Prop] := A.
+Definition inhabited (A:Prop) := A.
Lemma prop_ext_A_eq_A_imp_A :
- prop_extensionality->(A:Prop)(inhabited A)->(A->A)==A.
+ prop_extensionality -> forall A:Prop, inhabited A -> (A -> A) = A.
Proof.
-Intros Ext A a.
-Apply (Ext A->A A); Split; [ Exact [_]a | Exact [_;_]a ].
+intros Ext A a.
+apply (Ext (A -> A) A); split; [ exact (fun _ => a) | exact (fun _ _ => a) ].
Qed.
-Record retract [A,B:Prop] : Prop := {
- f1: A->B;
- f2: B->A;
- f1_o_f2: (x:B)(f1 (f2 x))==x
-}.
+Record retract (A B:Prop) : Prop :=
+ {f1 : A -> B; f2 : B -> A; f1_o_f2 : forall x:B, f1 (f2 x) = x}.
Lemma prop_ext_retract_A_A_imp_A :
- prop_extensionality->(A:Prop)(inhabited A)->(retract A A->A).
+ prop_extensionality -> forall A:Prop, inhabited A -> retract A (A -> A).
Proof.
-Intros Ext A a.
-Rewrite -> (prop_ext_A_eq_A_imp_A Ext A a).
-Exists [x:A]x [x:A]x.
-Reflexivity.
+intros Ext A a.
+rewrite (prop_ext_A_eq_A_imp_A Ext A a).
+exists (fun x:A => x) (fun x:A => x).
+reflexivity.
Qed.
-Record has_fixpoint [A:Prop] : Prop := {
- F : (A->A)->A;
- fix : (f:A->A)(F f)==(f (F f))
-}.
+Record has_fixpoint (A:Prop) : Prop :=
+ {F : (A -> A) -> A; Fix : forall f:A -> A, F f = f (F f)}.
Lemma ext_prop_fixpoint :
- prop_extensionality->(A:Prop)(inhabited A)->(has_fixpoint A).
+ prop_extensionality -> forall A:Prop, inhabited A -> has_fixpoint A.
Proof.
-Intros Ext A a.
-Case (prop_ext_retract_A_A_imp_A Ext A a); Intros g1 g2 g1_o_g2.
-Exists [f]([x:A](f (g1 x x)) (g2 [x](f (g1 x x)))).
-Intro f.
-Pattern 1 (g1 (g2 [x:A](f (g1 x x)))).
-Rewrite (g1_o_g2 [x:A](f (g1 x x))).
-Reflexivity.
+intros Ext A a.
+case (prop_ext_retract_A_A_imp_A Ext A a); intros g1 g2 g1_o_g2.
+exists (fun f => (fun x:A => f (g1 x x)) (g2 (fun x => f (g1 x x)))).
+intro f.
+pattern (g1 (g2 (fun x:A => f (g1 x x)))) at 1 in |- *.
+rewrite (g1_o_g2 (fun x:A => f (g1 x x))).
+reflexivity.
Qed.
(** Assume we have booleans with the property that there is at most 2
@@ -122,36 +118,40 @@ Section Proof_irrelevance_gen.
Variable bool : Prop.
Variable true : bool.
Variable false : bool.
-Hypothesis bool_elim : (C:Prop)C->C->bool->C.
-Hypothesis bool_elim_redl : (C:Prop)(c1,c2:C)c1==(bool_elim C c1 c2 true).
-Hypothesis bool_elim_redr : (C:Prop)(c1,c2:C)c2==(bool_elim C c1 c2 false).
-Local bool_dep_induction := (P:bool->Prop)(P true)->(P false)->(b:bool)(P b).
-
-Lemma aux : prop_extensionality -> bool_dep_induction -> true==false.
+Hypothesis bool_elim : forall C:Prop, C -> C -> bool -> C.
+Hypothesis
+ bool_elim_redl : forall (C:Prop) (c1 c2:C), c1 = bool_elim C c1 c2 true.
+Hypothesis
+ bool_elim_redr : forall (C:Prop) (c1 c2:C), c2 = bool_elim C c1 c2 false.
+Let bool_dep_induction :=
+ forall P:bool -> Prop, P true -> P false -> forall b:bool, P b.
+
+Lemma aux : prop_extensionality -> bool_dep_induction -> true = false.
Proof.
-Intros Ext Ind.
-Case (ext_prop_fixpoint Ext bool true); Intros G Gfix.
-Pose neg := [b:bool](bool_elim bool false true b).
-Generalize (refl_eqT ? (G neg)).
-Pattern 1 (G neg).
-Apply Ind with b:=(G neg); Intro Heq.
-Rewrite (bool_elim_redl bool false true).
-Change true==(neg true); Rewrite -> Heq; Apply Gfix.
-Rewrite (bool_elim_redr bool false true).
-Change (neg false)==false; Rewrite -> Heq; Symmetry; Apply Gfix.
+intros Ext Ind.
+case (ext_prop_fixpoint Ext bool true); intros G Gfix.
+pose (neg := fun b:bool => bool_elim bool false true b).
+generalize (refl_equal (G neg)).
+pattern (G neg) at 1 in |- *.
+apply Ind with (b := G neg); intro Heq.
+rewrite (bool_elim_redl bool false true).
+change (true = neg true) in |- *; rewrite Heq; apply Gfix.
+rewrite (bool_elim_redr bool false true).
+change (neg false = false) in |- *; rewrite Heq; symmetry in |- *;
+ apply Gfix.
Qed.
Lemma ext_prop_dep_proof_irrel_gen :
- prop_extensionality -> bool_dep_induction -> proof_irrelevance.
+ prop_extensionality -> bool_dep_induction -> proof_irrelevance.
Proof.
-Intros Ext Ind A a1 a2.
-Pose f := [b:bool](bool_elim A a1 a2 b).
-Rewrite (bool_elim_redl A a1 a2).
-Change (f true)==a2.
-Rewrite (bool_elim_redr A a1 a2).
-Change (f true)==(f false).
-Rewrite (aux Ext Ind).
-Reflexivity.
+intros Ext Ind A a1 a2.
+pose (f := fun b:bool => bool_elim A a1 a2 b).
+rewrite (bool_elim_redl A a1 a2).
+change (f true = a2) in |- *.
+rewrite (bool_elim_redr A a1 a2).
+change (f true = f false) in |- *.
+rewrite (aux Ext Ind).
+reflexivity.
Qed.
End Proof_irrelevance_gen.
@@ -163,22 +163,23 @@ End Proof_irrelevance_gen.
Section Proof_irrelevance_CC.
-Definition BoolP := (C:Prop)C->C->C.
-Definition TrueP := [C][c1,c2]c1 : BoolP.
-Definition FalseP := [C][c1,c2]c2 : BoolP.
-Definition BoolP_elim := [C][c1,c2][b:BoolP](b C c1 c2).
-Definition BoolP_elim_redl : (C:Prop)(c1,c2:C)c1==(BoolP_elim C c1 c2 TrueP)
- := [C;c1,c2](refl_eqT C c1).
-Definition BoolP_elim_redr : (C:Prop)(c1,c2:C)c2==(BoolP_elim C c1 c2 FalseP)
- := [C;c1,c2](refl_eqT C c2).
+Definition BoolP := forall C:Prop, C -> C -> C.
+Definition TrueP : BoolP := fun C c1 c2 => c1.
+Definition FalseP : BoolP := fun C c1 c2 => c2.
+Definition BoolP_elim C c1 c2 (b:BoolP) := b C c1 c2.
+Definition BoolP_elim_redl (C:Prop) (c1 c2:C) :
+ c1 = BoolP_elim C c1 c2 TrueP := refl_equal c1.
+Definition BoolP_elim_redr (C:Prop) (c1 c2:C) :
+ c2 = BoolP_elim C c1 c2 FalseP := refl_equal c2.
-Definition BoolP_dep_induction :=
- (P:BoolP->Prop)(P TrueP)->(P FalseP)->(b:BoolP)(P b).
+Definition BoolP_dep_induction :=
+ forall P:BoolP -> Prop, P TrueP -> P FalseP -> forall b:BoolP, P b.
Lemma ext_prop_dep_proof_irrel_cc :
- prop_extensionality -> BoolP_dep_induction -> proof_irrelevance.
-Proof (ext_prop_dep_proof_irrel_gen BoolP TrueP FalseP BoolP_elim
- BoolP_elim_redl BoolP_elim_redr).
+ prop_extensionality -> BoolP_dep_induction -> proof_irrelevance.
+Proof
+ ext_prop_dep_proof_irrel_gen BoolP TrueP FalseP BoolP_elim BoolP_elim_redl
+ BoolP_elim_redr.
End Proof_irrelevance_CC.
@@ -189,16 +190,20 @@ End Proof_irrelevance_CC.
Section Proof_irrelevance_CIC.
-Inductive boolP : Prop := trueP : boolP | falseP : boolP.
-Definition boolP_elim_redl : (C:Prop)(c1,c2:C)c1==(boolP_ind C c1 c2 trueP)
- := [C;c1,c2](refl_eqT C c1).
-Definition boolP_elim_redr : (C:Prop)(c1,c2:C)c2==(boolP_ind C c1 c2 falseP)
- := [C;c1,c2](refl_eqT C c2).
+Inductive boolP : Prop :=
+ | trueP : boolP
+ | falseP : boolP.
+Definition boolP_elim_redl (C:Prop) (c1 c2:C) :
+ c1 = boolP_ind C c1 c2 trueP := refl_equal c1.
+Definition boolP_elim_redr (C:Prop) (c1 c2:C) :
+ c2 = boolP_ind C c1 c2 falseP := refl_equal c2.
Scheme boolP_indd := Induction for boolP Sort Prop.
Lemma ext_prop_dep_proof_irrel_cic : prop_extensionality -> proof_irrelevance.
-Proof [pe](ext_prop_dep_proof_irrel_gen boolP trueP falseP boolP_ind
- boolP_elim_redl boolP_elim_redr pe boolP_indd).
+Proof
+ fun pe =>
+ ext_prop_dep_proof_irrel_gen boolP trueP falseP boolP_ind boolP_elim_redl
+ boolP_elim_redr pe boolP_indd.
End Proof_irrelevance_CIC.
@@ -211,4 +216,4 @@ End Proof_irrelevance_CIC.
satisfy propositional degeneracy without satisfying proof-irrelevance
(nor dependent case analysis). This would imply that the previous
results cannot be refined.
-*)
+*) \ No newline at end of file
diff --git a/theories/Logic/Classical_Pred_Set.v b/theories/Logic/Classical_Pred_Set.v
index 7ca160517..e308eff14 100755
--- a/theories/Logic/Classical_Pred_Set.v
+++ b/theories/Logic/Classical_Pred_Set.v
@@ -10,55 +10,61 @@
(** Classical Predicate Logic on Set*)
-Require Classical_Prop.
+Require Import Classical_Prop.
Section Generic.
-Variable U: Set.
+Variable U : Set.
(** de Morgan laws for quantifiers *)
-Lemma not_all_ex_not : (P:U->Prop)(~(n:U)(P n)) -> (EX n:U | ~(P n)).
+Lemma not_all_ex_not :
+ forall P:U -> Prop, ~ (forall n:U, P n) -> exists n : U | ~ P n.
Proof.
-Unfold not; Intros P notall.
-Apply NNPP; Unfold not.
-Intro abs.
-Cut ((n:U)(P n)); Auto.
-Intro n; Apply NNPP.
-Unfold not; Intros.
-Apply abs; Exists n; Trivial.
+unfold not in |- *; intros P notall.
+apply NNPP; unfold not in |- *.
+intro abs.
+cut (forall n:U, P n); auto.
+intro n; apply NNPP.
+unfold not in |- *; intros.
+apply abs; exists n; trivial.
Qed.
-Lemma not_all_not_ex : (P:U->Prop)(~(n:U)~(P n)) -> (EX n:U |(P n)).
+Lemma not_all_not_ex :
+ forall P:U -> Prop, ~ (forall n:U, ~ P n) -> exists n : U | P n.
Proof.
-Intros P H.
-Elim (not_all_ex_not [n:U]~(P n) H); Intros n Pn; Exists n.
-Apply NNPP; Trivial.
+intros P H.
+elim (not_all_ex_not (fun n:U => ~ P n) H); intros n Pn; exists n.
+apply NNPP; trivial.
Qed.
-Lemma not_ex_all_not : (P:U->Prop) (~(EX n:U |(P n))) -> (n:U)~(P n).
+Lemma not_ex_all_not :
+ forall P:U -> Prop, ~ ( exists n : U | P n) -> forall n:U, ~ P n.
Proof.
-Unfold not; Intros P notex n abs.
-Apply notex.
-Exists n; Trivial.
+unfold not in |- *; intros P notex n abs.
+apply notex.
+exists n; trivial.
Qed.
-Lemma not_ex_not_all : (P:U->Prop)(~(EX n:U | ~(P n))) -> (n:U)(P n).
+Lemma not_ex_not_all :
+ forall P:U -> Prop, ~ ( exists n : U | ~ P n) -> forall n:U, P n.
Proof.
-Intros P H n.
-Apply NNPP.
-Red; Intro K; Apply H; Exists n; Trivial.
+intros P H n.
+apply NNPP.
+red in |- *; intro K; apply H; exists n; trivial.
Qed.
-Lemma ex_not_not_all : (P:U->Prop) (EX n:U | ~(P n)) -> ~(n:U)(P n).
+Lemma ex_not_not_all :
+ forall P:U -> Prop, ( exists n : U | ~ P n) -> ~ (forall n:U, P n).
Proof.
-Unfold not; Intros P exnot allP.
-Elim exnot; Auto.
+unfold not in |- *; intros P exnot allP.
+elim exnot; auto.
Qed.
-Lemma all_not_not_ex : (P:U->Prop) ((n:U)~(P n)) -> ~(EX n:U |(P n)).
+Lemma all_not_not_ex :
+ forall P:U -> Prop, (forall n:U, ~ P n) -> ~ ( exists n : U | P n).
Proof.
-Unfold not; Intros P allnot exP; Elim exP; Intros n p.
-Apply allnot with n; Auto.
+unfold not in |- *; intros P allnot exP; elim exP; intros n p.
+apply allnot with n; auto.
Qed.
-End Generic.
+End Generic. \ No newline at end of file
diff --git a/theories/Logic/Classical_Pred_Type.v b/theories/Logic/Classical_Pred_Type.v
index 6745d05fd..6bfd08e43 100755
--- a/theories/Logic/Classical_Pred_Type.v
+++ b/theories/Logic/Classical_Pred_Type.v
@@ -10,55 +10,61 @@
(** Classical Predicate Logic on Type *)
-Require Classical_Prop.
+Require Import Classical_Prop.
Section Generic.
-Variable U: Type.
+Variable U : Type.
(** de Morgan laws for quantifiers *)
-Lemma not_all_ex_not : (P:U->Prop)(~(n:U)(P n)) -> (EXT n:U | ~(P n)).
+Lemma not_all_ex_not :
+ forall P:U -> Prop, ~ (forall n:U, P n) -> exists n : U | ~ P n.
Proof.
-Unfold not; Intros P notall.
-Apply NNPP; Unfold not.
-Intro abs.
-Cut ((n:U)(P n)); Auto.
-Intro n; Apply NNPP.
-Unfold not; Intros.
-Apply abs; Exists n; Trivial.
+unfold not in |- *; intros P notall.
+apply NNPP; unfold not in |- *.
+intro abs.
+cut (forall n:U, P n); auto.
+intro n; apply NNPP.
+unfold not in |- *; intros.
+apply abs; exists n; trivial.
Qed.
-Lemma not_all_not_ex : (P:U->Prop)(~(n:U)~(P n)) -> (EXT n:U | (P n)).
+Lemma not_all_not_ex :
+ forall P:U -> Prop, ~ (forall n:U, ~ P n) -> exists n : U | P n.
Proof.
-Intros P H.
-Elim (not_all_ex_not [n:U]~(P n) H); Intros n Pn; Exists n.
-Apply NNPP; Trivial.
+intros P H.
+elim (not_all_ex_not (fun n:U => ~ P n) H); intros n Pn; exists n.
+apply NNPP; trivial.
Qed.
-Lemma not_ex_all_not : (P:U->Prop)(~(EXT n:U | (P n))) -> (n:U)~(P n).
+Lemma not_ex_all_not :
+ forall P:U -> Prop, ~ ( exists n : U | P n) -> forall n:U, ~ P n.
Proof.
-Unfold not; Intros P notex n abs.
-Apply notex.
-Exists n; Trivial.
+unfold not in |- *; intros P notex n abs.
+apply notex.
+exists n; trivial.
Qed.
-Lemma not_ex_not_all : (P:U->Prop)(~(EXT n:U | ~(P n))) -> (n:U)(P n).
+Lemma not_ex_not_all :
+ forall P:U -> Prop, ~ ( exists n : U | ~ P n) -> forall n:U, P n.
Proof.
-Intros P H n.
-Apply NNPP.
-Red; Intro K; Apply H; Exists n; Trivial.
+intros P H n.
+apply NNPP.
+red in |- *; intro K; apply H; exists n; trivial.
Qed.
-Lemma ex_not_not_all : (P:U->Prop) (EXT n:U | ~(P n)) -> ~(n:U)(P n).
+Lemma ex_not_not_all :
+ forall P:U -> Prop, ( exists n : U | ~ P n) -> ~ (forall n:U, P n).
Proof.
-Unfold not; Intros P exnot allP.
-Elim exnot; Auto.
+unfold not in |- *; intros P exnot allP.
+elim exnot; auto.
Qed.
-Lemma all_not_not_ex : (P:U->Prop) ((n:U)~(P n)) -> ~(EXT n:U | (P n)).
+Lemma all_not_not_ex :
+ forall P:U -> Prop, (forall n:U, ~ P n) -> ~ ( exists n : U | P n).
Proof.
-Unfold not; Intros P allnot exP; Elim exP; Intros n p.
-Apply allnot with n; Auto.
+unfold not in |- *; intros P allnot exP; elim exP; intros n p.
+apply allnot with n; auto.
Qed.
-End Generic.
+End Generic. \ No newline at end of file
diff --git a/theories/Logic/Classical_Prop.v b/theories/Logic/Classical_Prop.v
index 0a5987d01..908ad40a2 100755
--- a/theories/Logic/Classical_Prop.v
+++ b/theories/Logic/Classical_Prop.v
@@ -10,76 +10,76 @@
(** Classical Propositional Logic *)
-Require ProofIrrelevance.
+Require Import ProofIrrelevance.
-Hints Unfold not : core.
+Hint Unfold not: core.
-Axiom classic: (P:Prop)(P \/ ~(P)).
+Axiom classic : forall P:Prop, P \/ ~ P.
-Lemma NNPP : (p:Prop)~(~(p))->p.
+Lemma NNPP : forall p:Prop, ~ ~ p -> p.
Proof.
-Unfold not; Intros; Elim (classic p); Auto.
-Intro NP; Elim (H NP).
+unfold not in |- *; intros; elim (classic p); auto.
+intro NP; elim (H NP).
Qed.
-Lemma not_imply_elim : (P,Q:Prop)~(P->Q)->P.
+Lemma not_imply_elim : forall P Q:Prop, ~ (P -> Q) -> P.
Proof.
-Intros; Apply NNPP; Red.
-Intro; Apply H; Intro; Absurd P; Trivial.
+intros; apply NNPP; red in |- *.
+intro; apply H; intro; absurd P; trivial.
Qed.
-Lemma not_imply_elim2 : (P,Q:Prop)~(P->Q) -> ~Q.
+Lemma not_imply_elim2 : forall P Q:Prop, ~ (P -> Q) -> ~ Q.
Proof.
-Intros; Elim (classic Q); Auto.
+intros; elim (classic Q); auto.
Qed.
-Lemma imply_to_or : (P,Q:Prop)(P->Q) -> ~P \/ Q.
+Lemma imply_to_or : forall P Q:Prop, (P -> Q) -> ~ P \/ Q.
Proof.
-Intros; Elim (classic P); Auto.
+intros; elim (classic P); auto.
Qed.
-Lemma imply_to_and : (P,Q:Prop)~(P->Q) -> P /\ ~Q.
+Lemma imply_to_and : forall P Q:Prop, ~ (P -> Q) -> P /\ ~ Q.
Proof.
-Intros; Split.
-Apply not_imply_elim with Q; Trivial.
-Apply not_imply_elim2 with P; Trivial.
+intros; split.
+apply not_imply_elim with Q; trivial.
+apply not_imply_elim2 with P; trivial.
Qed.
-Lemma or_to_imply : (P,Q:Prop)(~P \/ Q) -> P->Q.
+Lemma or_to_imply : forall P Q:Prop, ~ P \/ Q -> P -> Q.
Proof.
-Induction 1; Auto.
-Intros H1 H2; Elim (H1 H2).
+simple induction 1; auto.
+intros H1 H2; elim (H1 H2).
Qed.
-Lemma not_and_or : (P,Q:Prop)~(P/\Q)-> ~P \/ ~Q.
+Lemma not_and_or : forall P Q:Prop, ~ (P /\ Q) -> ~ P \/ ~ Q.
Proof.
-Intros; Elim (classic P); Auto.
+intros; elim (classic P); auto.
Qed.
-Lemma or_not_and : (P,Q:Prop)(~P \/ ~Q) -> ~(P/\Q).
+Lemma or_not_and : forall P Q:Prop, ~ P \/ ~ Q -> ~ (P /\ Q).
Proof.
-Induction 1; Red; Induction 2; Auto.
+simple induction 1; red in |- *; simple induction 2; auto.
Qed.
-Lemma not_or_and : (P,Q:Prop)~(P\/Q)-> ~P /\ ~Q.
+Lemma not_or_and : forall P Q:Prop, ~ (P \/ Q) -> ~ P /\ ~ Q.
Proof.
-Intros; Elim (classic P); Auto.
+intros; elim (classic P); auto.
Qed.
-Lemma and_not_or : (P,Q:Prop)(~P /\ ~Q) -> ~(P\/Q).
+Lemma and_not_or : forall P Q:Prop, ~ P /\ ~ Q -> ~ (P \/ Q).
Proof.
-Induction 1; Red; Induction 3; Trivial.
+simple induction 1; red in |- *; simple induction 3; trivial.
Qed.
-Lemma imply_and_or: (P,Q:Prop)(P->Q) -> P \/ Q -> Q.
+Lemma imply_and_or : forall P Q:Prop, (P -> Q) -> P \/ Q -> Q.
Proof.
-Induction 2; Trivial.
+simple induction 2; trivial.
Qed.
-Lemma imply_and_or2: (P,Q,R:Prop)(P->Q) -> P \/ R -> Q \/ R.
+Lemma imply_and_or2 : forall P Q R:Prop, (P -> Q) -> P \/ R -> Q \/ R.
Proof.
-Induction 2; Auto.
+simple induction 2; auto.
Qed.
-Lemma proof_irrelevance: (P:Prop)(p1,p2:P)p1==p2.
-Proof (proof_irrelevance_cci classic).
+Lemma proof_irrelevance : forall (P:Prop) (p1 p2:P), p1 = p2.
+Proof proof_irrelevance_cci classic. \ No newline at end of file
diff --git a/theories/Logic/Classical_Type.v b/theories/Logic/Classical_Type.v
index 243daa9c4..acb7beac0 100755
--- a/theories/Logic/Classical_Type.v
+++ b/theories/Logic/Classical_Type.v
@@ -11,4 +11,4 @@
(** Classical Logic for Type *)
Require Export Classical_Prop.
-Require Export Classical_Pred_Type.
+Require Export Classical_Pred_Type. \ No newline at end of file
diff --git a/theories/Logic/Decidable.v b/theories/Logic/Decidable.v
index 82464b3af..ebc21f755 100644
--- a/theories/Logic/Decidable.v
+++ b/theories/Logic/Decidable.v
@@ -9,50 +9,52 @@
(** Properties of decidable propositions *)
-Definition decidable := [P:Prop] P \/ ~P.
+Definition decidable (P:Prop) := P \/ ~ P.
-Theorem dec_not_not : (P:Prop)(decidable P) -> (~P -> False) -> P.
-Unfold decidable; Tauto.
+Theorem dec_not_not : forall P:Prop, decidable P -> (~ P -> False) -> P.
+unfold decidable in |- *; tauto.
Qed.
-Theorem dec_True: (decidable True).
-Unfold decidable; Auto.
+Theorem dec_True : decidable True.
+unfold decidable in |- *; auto.
Qed.
-Theorem dec_False: (decidable False).
-Unfold decidable not; Auto.
+Theorem dec_False : decidable False.
+unfold decidable, not in |- *; auto.
Qed.
-Theorem dec_or: (A,B:Prop)(decidable A) -> (decidable B) -> (decidable (A\/B)).
-Unfold decidable; Tauto.
+Theorem dec_or :
+ forall A B:Prop, decidable A -> decidable B -> decidable (A \/ B).
+unfold decidable in |- *; tauto.
Qed.
-Theorem dec_and: (A,B:Prop)(decidable A) -> (decidable B) ->(decidable (A/\B)).
-Unfold decidable; Tauto.
+Theorem dec_and :
+ forall A B:Prop, decidable A -> decidable B -> decidable (A /\ B).
+unfold decidable in |- *; tauto.
Qed.
-Theorem dec_not: (A:Prop)(decidable A) -> (decidable ~A).
-Unfold decidable; Tauto.
+Theorem dec_not : forall A:Prop, decidable A -> decidable (~ A).
+unfold decidable in |- *; tauto.
Qed.
-Theorem dec_imp: (A,B:Prop)(decidable A) -> (decidable B) ->(decidable (A->B)).
-Unfold decidable; Tauto.
+Theorem dec_imp :
+ forall A B:Prop, decidable A -> decidable B -> decidable (A -> B).
+unfold decidable in |- *; tauto.
Qed.
-Theorem not_not : (P:Prop)(decidable P) -> (~(~P)) -> P.
-Unfold decidable; Tauto. Qed.
+Theorem not_not : forall P:Prop, decidable P -> ~ ~ P -> P.
+unfold decidable in |- *; tauto. Qed.
-Theorem not_or : (A,B:Prop) ~(A\/B) -> ~A /\ ~B.
-Tauto. Qed.
+Theorem not_or : forall A B:Prop, ~ (A \/ B) -> ~ A /\ ~ B.
+tauto. Qed.
-Theorem not_and : (A,B:Prop) (decidable A) -> ~(A/\B) -> ~A \/ ~B.
-Unfold decidable; Tauto. Qed.
+Theorem not_and : forall A B:Prop, decidable A -> ~ (A /\ B) -> ~ A \/ ~ B.
+unfold decidable in |- *; tauto. Qed.
-Theorem not_imp : (A,B:Prop) (decidable A) -> ~(A -> B) -> A /\ ~B.
-Unfold decidable;Tauto.
+Theorem not_imp : forall A B:Prop, decidable A -> ~ (A -> B) -> A /\ ~ B.
+unfold decidable in |- *; tauto.
Qed.
-Theorem imp_simp : (A,B:Prop) (decidable A) -> (A -> B) -> ~A \/ B.
-Unfold decidable; Tauto.
+Theorem imp_simp : forall A B:Prop, decidable A -> (A -> B) -> ~ A \/ B.
+unfold decidable in |- *; tauto.
Qed.
-
diff --git a/theories/Logic/Diaconescu.v b/theories/Logic/Diaconescu.v
index ff94d8e3b..b03ec80e8 100644
--- a/theories/Logic/Diaconescu.v
+++ b/theories/Logic/Diaconescu.v
@@ -30,104 +30,109 @@ Section PredExt_GuardRelChoice_imp_EM.
(* The axiom of extensionality for predicates *)
Definition PredicateExtensionality :=
- (P,Q:bool->Prop)((b:bool)(P b)<->(Q b))->P==Q.
+ forall P Q:bool -> Prop, (forall b:bool, P b <-> Q b) -> P = Q.
(* From predicate extensionality we get propositional extensionality
hence proof-irrelevance *)
-Require ClassicalFacts.
+Require Import ClassicalFacts.
Variable pred_extensionality : PredicateExtensionality.
-Lemma prop_ext : (A,B:Prop) (A<->B) -> A==B.
+Lemma prop_ext : forall A B:Prop, (A <-> B) -> A = B.
Proof.
- Intros A B H.
- Change ([_]A true)==([_]B true).
- Rewrite pred_extensionality with P:=[_:bool]A Q:=[_:bool]B.
- Reflexivity.
- Intros _; Exact H.
+ intros A B H.
+ change ((fun _ => A) true = (fun _ => B) true) in |- *.
+ rewrite
+ pred_extensionality with (P := fun _:bool => A) (Q := fun _:bool => B).
+ reflexivity.
+ intros _; exact H.
Qed.
-Lemma proof_irrel : (A:Prop)(a1,a2:A) a1==a2.
+Lemma proof_irrel : forall (A:Prop) (a1 a2:A), a1 = a2.
Proof.
- Apply (ext_prop_dep_proof_irrel_cic prop_ext).
+ apply (ext_prop_dep_proof_irrel_cic prop_ext).
Qed.
(* From proof-irrelevance and relational choice, we get guarded
relational choice *)
-Require ChoiceFacts.
+Require Import ChoiceFacts.
Variable rel_choice : RelationalChoice.
Lemma guarded_rel_choice :
- (A:Type)(B:Type)(P:A->Prop)(R:A->B->Prop)
- ((x:A)(P x)->(EX y:B|(R x y)))->
- (EXT R':A->B->Prop |
- ((x:A)(P x)->(EX y:B|(R x y)/\(R' x y)/\ ((y':B)(R' x y') -> y=y')))).
+ forall (A B:Type) (P:A -> Prop) (R:A -> B -> Prop),
+ (forall x:A, P x -> exists y : B | R x y) ->
+ exists R' : A -> B -> Prop
+ | (forall x:A,
+ P x ->
+ exists y : B | R x y /\ R' x y /\ (forall y':B, R' x y' -> y = y')).
Proof.
- Exact
- (rel_choice_and_proof_irrel_imp_guarded_rel_choice rel_choice proof_irrel).
+ exact
+ (rel_choice_and_proof_irrel_imp_guarded_rel_choice rel_choice proof_irrel).
Qed.
(* The form of choice we need: there is a functional relation which chooses
an element in any non empty subset of bool *)
-Require Bool.
+Require Import Bool.
Lemma AC :
- (EXT R:(bool->Prop)->bool->Prop |
- (P:bool->Prop)(EX b : bool | (P b))->
- (EX b : bool | (P b) /\ (R P b) /\ ((b':bool)(R P b')->b=b'))).
+ exists R : (bool -> Prop) -> bool -> Prop
+ | (forall P:bool -> Prop,
+ ( exists b : bool | P b) ->
+ exists b : bool | P b /\ R P b /\ (forall b':bool, R P b' -> b = b')).
Proof.
- Apply guarded_rel_choice with
- P:= [Q:bool->Prop](EX y | (Q y)) R:=[Q:bool->Prop;y:bool](Q y).
- Exact [_;H]H.
+ apply guarded_rel_choice with
+ (P := fun Q:bool -> Prop => exists y : _ | Q y)
+ (R := fun (Q:bool -> Prop) (y:bool) => Q y).
+ exact (fun _ H => H).
Qed.
(* The proof of the excluded middle *)
(* Remark: P could have been in Set or Type *)
-Theorem pred_ext_and_rel_choice_imp_EM : (P:Prop)P\/~P.
+Theorem pred_ext_and_rel_choice_imp_EM : forall P:Prop, P \/ ~ P.
Proof.
-Intro P.
+intro P.
(* first we exhibit the choice functional relation R *)
-NewDestruct AC as [R H].
+destruct AC as [R H].
-Pose class_of_true := [b]b=true\/P.
-Pose class_of_false := [b]b=false\/P.
+pose (class_of_true := fun b => b = true \/ P).
+pose (class_of_false := fun b => b = false \/ P).
(* the actual "decision": is (R class_of_true) = true or false? *)
-NewDestruct (H class_of_true) as [b0 [H0 [H0' H0'']]].
-Exists true; Left; Reflexivity.
-NewDestruct H0.
+destruct (H class_of_true) as [b0 [H0 [H0' H0'']]].
+exists true; left; reflexivity.
+destruct H0.
(* the actual "decision": is (R class_of_false) = true or false? *)
-NewDestruct (H class_of_false) as [b1 [H1 [H1' H1'']]].
-Exists false; Left; Reflexivity.
-NewDestruct H1.
+destruct (H class_of_false) as [b1 [H1 [H1' H1'']]].
+exists false; left; reflexivity.
+destruct H1.
(* case where P is false: (R class_of_true)=true /\ (R class_of_false)=false *)
-Right.
-Intro HP.
-Assert Hequiv:(b:bool)(class_of_true b)<->(class_of_false b).
-Intro b; Split.
-Unfold class_of_false; Right; Assumption.
-Unfold class_of_true; Right; Assumption.
-Assert Heq:class_of_true==class_of_false.
-Apply pred_extensionality with 1:=Hequiv.
-Apply diff_true_false.
-Rewrite <- H0.
-Rewrite <- H1.
-Rewrite <- H0''. Reflexivity.
-Rewrite Heq.
-Assumption.
+right.
+intro HP.
+assert (Hequiv : forall b:bool, class_of_true b <-> class_of_false b).
+intro b; split.
+unfold class_of_false in |- *; right; assumption.
+unfold class_of_true in |- *; right; assumption.
+assert (Heq : class_of_true = class_of_false).
+apply pred_extensionality with (1 := Hequiv).
+apply diff_true_false.
+rewrite <- H0.
+rewrite <- H1.
+rewrite <- H0''. reflexivity.
+rewrite Heq.
+assumption.
(* cases where P is true *)
-Left; Assumption.
-Left; Assumption.
+left; assumption.
+left; assumption.
Qed.
-End PredExt_GuardRelChoice_imp_EM.
+End PredExt_GuardRelChoice_imp_EM. \ No newline at end of file
diff --git a/theories/Logic/Eqdep.v b/theories/Logic/Eqdep.v
index 40a50837d..c5afa683a 100755
--- a/theories/Logic/Eqdep.v
+++ b/theories/Logic/Eqdep.v
@@ -32,67 +32,68 @@
Section Dependent_Equality.
Variable U : Type.
-Variable P : U->Type.
+Variable P : U -> Type.
(** Dependent equality *)
-Inductive eq_dep [p:U;x:(P p)] : (q:U)(P q)->Prop :=
- eq_dep_intro : (eq_dep p x p x).
-Hint constr_eq_dep : core v62 := Constructors eq_dep.
+Inductive eq_dep (p:U) (x:P p) : forall q:U, P q -> Prop :=
+ eq_dep_intro : eq_dep p x p x.
+Hint Constructors eq_dep: core v62.
-Lemma eq_dep_sym : (p,q:U)(x:(P p))(y:(P q))(eq_dep p x q y)->(eq_dep q y p x).
+Lemma eq_dep_sym :
+ forall (p q:U) (x:P p) (y:P q), eq_dep p x q y -> eq_dep q y p x.
Proof.
-Induction 1; Auto.
+simple induction 1; auto.
Qed.
-Hints Immediate eq_dep_sym : core v62.
+Hint Immediate eq_dep_sym: core v62.
-Lemma eq_dep_trans : (p,q,r:U)(x:(P p))(y:(P q))(z:(P r))
- (eq_dep p x q y)->(eq_dep q y r z)->(eq_dep p x r z).
+Lemma eq_dep_trans :
+ forall (p q r:U) (x:P p) (y:P q) (z:P r),
+ eq_dep p x q y -> eq_dep q y r z -> eq_dep p x r z.
Proof.
-Induction 1; Auto.
+simple induction 1; auto.
Qed.
-Inductive eq_dep1 [p:U;x:(P p);q:U;y:(P q)] : Prop :=
- eq_dep1_intro : (h:q=p)
- (x=(eq_rect U q P y p h))->(eq_dep1 p x q y).
+Inductive eq_dep1 (p:U) (x:P p) (q:U) (y:P q) : Prop :=
+ eq_dep1_intro : forall h:q = p, x = eq_rect q P y p h -> eq_dep1 p x q y.
(** Invariance by Substitution of Reflexive Equality Proofs *)
-Axiom eq_rect_eq : (p:U)(Q:U->Type)(x:(Q p))(h:p=p)
- x=(eq_rect U p Q x p h).
+Axiom
+ eq_rect_eq :
+ forall (p:U) (Q:U -> Type) (x:Q p) (h:p = p), x = eq_rect p Q x p h.
Lemma eq_dep1_dep :
- (p:U)(x:(P p))(q:U)(y:(P q))(eq_dep1 p x q y)->(eq_dep p x q y).
+ forall (p:U) (x:P p) (q:U) (y:P q), eq_dep1 p x q y -> eq_dep p x q y.
Proof.
-Induction 1; Intros eq_qp.
-Cut (h:q=p)(y0:(P q))
- (x=(eq_rect U q P y0 p h))->(eq_dep p x q y0).
-Intros; Apply H0 with eq_qp; Auto.
-Rewrite eq_qp; Intros h y0.
-Elim eq_rect_eq.
-Induction 1; Auto.
+simple induction 1; intros eq_qp.
+cut (forall (h:q = p) (y0:P q), x = eq_rect q P y0 p h -> eq_dep p x q y0).
+intros; apply H0 with eq_qp; auto.
+rewrite eq_qp; intros h y0.
+elim eq_rect_eq.
+simple induction 1; auto.
Qed.
-Lemma eq_dep_dep1 :
- (p,q:U)(x:(P p))(y:(P q))(eq_dep p x q y)->(eq_dep1 p x q y).
+Lemma eq_dep_dep1 :
+ forall (p q:U) (x:P p) (y:P q), eq_dep p x q y -> eq_dep1 p x q y.
Proof.
-Induction 1; Intros.
-Apply eq_dep1_intro with (refl_equal U p).
-Simpl; Trivial.
+simple induction 1; intros.
+apply eq_dep1_intro with (refl_equal p).
+simpl in |- *; trivial.
Qed.
-Lemma eq_dep1_eq : (p:U)(x,y:(P p))(eq_dep1 p x p y)->x=y.
+Lemma eq_dep1_eq : forall (p:U) (x y:P p), eq_dep1 p x p y -> x = y.
Proof.
-Induction 1; Intro.
-Elim eq_rect_eq; Auto.
+simple induction 1; intro.
+elim eq_rect_eq; auto.
Qed.
(** Injectivity of Dependent Equality is a consequence of *)
(** Invariance by Substitution of Reflexive Equality Proof *)
-Lemma eq_dep_eq : (p:U)(x,y:(P p))(eq_dep p x p y)->x=y.
+Lemma eq_dep_eq : forall (p:U) (x y:P p), eq_dep p x p y -> x = y.
Proof.
-Intros; Apply eq_dep1_eq; Apply eq_dep_dep1; Trivial.
+intros; apply eq_dep1_eq; apply eq_dep_dep1; trivial.
Qed.
End Dependent_Equality.
@@ -102,84 +103,88 @@ End Dependent_Equality.
Scheme eq_indd := Induction for eq Sort Prop.
-Lemma UIP : (U:Type)(x,y:U)(p1,p2:x=y)p1=p2.
+Lemma UIP : forall (U:Type) (x y:U) (p1 p2:x = y), p1 = p2.
Proof.
-Intros; Apply eq_dep_eq with P:=[y]x=y.
-Elim p2 using eq_indd.
-Elim p1 using eq_indd.
-Apply eq_dep_intro.
+intros; apply eq_dep_eq with (P := fun y => x = y).
+elim p2 using eq_indd.
+elim p1 using eq_indd.
+apply eq_dep_intro.
Qed.
(** Uniqueness of Reflexive Identity Proofs is a direct instance of UIP *)
-Lemma UIP_refl : (U:Type)(x:U)(p:x=x)p=(refl_equal U x).
+Lemma UIP_refl : forall (U:Type) (x:U) (p:x = x), p = refl_equal x.
Proof.
-Intros; Apply UIP.
+intros; apply UIP.
Qed.
(** Streicher axiom K is a direct consequence of Uniqueness of
Reflexive Identity Proofs *)
-Lemma Streicher_K : (U:Type)(x:U)(P:x=x->Prop)
- (P (refl_equal ? x))->(p:x=x)(P p).
+Lemma Streicher_K :
+ forall (U:Type) (x:U) (P:x = x -> Prop),
+ P (refl_equal x) -> forall p:x = x, P p.
Proof.
-Intros; Rewrite UIP_refl; Assumption.
+intros; rewrite UIP_refl; assumption.
Qed.
(** We finally recover eq_rec_eq (alternatively eq_rect_eq) from K *)
-Lemma eq_rec_eq : (U:Type)(P:U->Set)(p:U)(x:(P p))(h:p=p)
- x=(eq_rec U p P x p h).
+Lemma eq_rec_eq :
+ forall (U:Type) (P:U -> Set) (p:U) (x:P p) (h:p = p), x = eq_rec p P x p h.
Proof.
-Intros.
-Apply Streicher_K with p:=h.
-Reflexivity.
+intros.
+apply Streicher_K with (p := h).
+reflexivity.
Qed.
(** Dependent equality is equivalent to equality on dependent pairs *)
-Lemma equiv_eqex_eqdep : (U:Set)(P:U->Set)(p,q:U)(x:(P p))(y:(P q))
- (existS U P p x)=(existS U P q y) <-> (eq_dep U P p x q y).
+Lemma equiv_eqex_eqdep :
+ forall (U:Set) (P:U -> Set) (p q:U) (x:P p) (y:P q),
+ existS P p x = existS P q y <-> eq_dep U P p x q y.
Proof.
-Split.
+split.
(* -> *)
-Intro H.
-Change p with (projS1 U P (existS U P p x)).
-Change 2 x with (projS2 U P (existS U P p x)).
-Rewrite H.
-Apply eq_dep_intro.
+intro H.
+change p with (projS1 (existS P p x)) in |- *.
+change x at 2 with (projS2 (existS P p x)) in |- *.
+rewrite H.
+apply eq_dep_intro.
(* <- *)
-NewDestruct 1; Reflexivity.
+destruct 1; reflexivity.
Qed.
(** UIP implies the injectivity of equality on dependent pairs *)
-Lemma inj_pair2: (U:Set)(P:U->Set)(p:U)(x,y:(P p))
- (existS U P p x)=(existS U P p y)-> x=y.
+Lemma inj_pair2 :
+ forall (U:Set) (P:U -> Set) (p:U) (x y:P p),
+ existS P p x = existS P p y -> x = y.
Proof.
-Intros.
-Apply (eq_dep_eq U P).
-Generalize (equiv_eqex_eqdep U P p p x y) .
-Induction 1.
-Intros.
-Auto.
+intros.
+apply (eq_dep_eq U P).
+generalize (equiv_eqex_eqdep U P p p x y).
+simple induction 1.
+intros.
+auto.
Qed.
(** UIP implies the injectivity of equality on dependent pairs *)
-Lemma inj_pairT2: (U:Type)(P:U->Type)(p:U)(x,y:(P p))
- (existT U P p x)=(existT U P p y)-> x=y.
+Lemma inj_pairT2 :
+ forall (U:Type) (P:U -> Type) (p:U) (x y:P p),
+ existT P p x = existT P p y -> x = y.
Proof.
-Intros.
-Apply (eq_dep_eq U P).
-Change 1 p with (projT1 U P (existT U P p x)).
-Change 2 x with (projT2 U P (existT U P p x)).
-Rewrite H.
-Apply eq_dep_intro.
+intros.
+apply (eq_dep_eq U P).
+change p at 1 with (projT1 (existT P p x)) in |- *.
+change x at 2 with (projT2 (existT P p x)) in |- *.
+rewrite H.
+apply eq_dep_intro.
Qed.
(** The main results to be exported *)
-Hints Resolve eq_dep_intro eq_dep_eq : core v62.
-Hints Immediate eq_dep_sym : core v62.
-Hints Resolve inj_pair2 inj_pairT2 : core.
+Hint Resolve eq_dep_intro eq_dep_eq: core v62.
+Hint Immediate eq_dep_sym: core v62.
+Hint Resolve inj_pair2 inj_pairT2: core. \ No newline at end of file
diff --git a/theories/Logic/Eqdep_dec.v b/theories/Logic/Eqdep_dec.v
index 8f7e76d51..22476505f 100644
--- a/theories/Logic/Eqdep_dec.v
+++ b/theories/Logic/Eqdep_dec.v
@@ -25,125 +25,134 @@
Set Implicit Arguments.
(** Bijection between [eq] and [eqT] *)
- Definition eq2eqT: (A:Set)(x,y:A)x=y->x==y :=
- [A,x,_,eqxy]<[y:A]x==y>Cases eqxy of refl_equal => (refl_eqT ? x) end.
-
- Definition eqT2eq: (A:Set)(x,y:A)x==y->x=y :=
- [A,x,_,eqTxy]<[y:A]x=y>Cases eqTxy of refl_eqT => (refl_equal ? x) end.
-
- Lemma eq_eqT_bij: (A:Set)(x,y:A)(p:x=y)p==(eqT2eq (eq2eqT p)).
-Intros.
-Case p; Reflexivity.
+ Definition eq2eqT (A:Set) (x y:A) (eqxy:x = y) :
+ x = y :=
+ match eqxy in (_ = y) return x = y with
+ | refl_equal => refl_equal x
+ end.
+
+ Definition eqT2eq (A:Set) (x y:A) (eqTxy:x = y) :
+ x = y :=
+ match eqTxy in (_ = y) return x = y with
+ | refl_equal => refl_equal x
+ end.
+
+ Lemma eq_eqT_bij : forall (A:Set) (x y:A) (p:x = y), p = eqT2eq (eq2eqT p).
+intros.
+case p; reflexivity.
Qed.
- Lemma eqT_eq_bij: (A:Set)(x,y:A)(p:x==y)p==(eq2eqT (eqT2eq p)).
-Intros.
-Case p; Reflexivity.
+ Lemma eqT_eq_bij : forall (A:Set) (x y:A) (p:x = y), p = eq2eqT (eqT2eq p).
+intros.
+case p; reflexivity.
Qed.
Section DecidableEqDep.
- Variable A: Type.
+ Variable A : Type.
- Local comp [x,y,y':A]: x==y->x==y'->y==y' :=
- [eq1,eq2](eqT_ind ? ? [a]a==y' eq2 ? eq1).
+ Let comp (x y y':A) (eq1:x = y) (eq2:x = y') : y = y' :=
+ eq_ind _ (fun a => a = y') eq2 _ eq1.
- Remark trans_sym_eqT: (x,y:A)(u:x==y)(comp u u)==(refl_eqT ? y).
-Intros.
-Case u; Trivial.
+ Remark trans_sym_eqT : forall (x y:A) (u:x = y), comp u u = refl_equal y.
+intros.
+case u; trivial.
Qed.
- Variable eq_dec: (x,y:A) x==y \/ ~x==y.
+ Variable eq_dec : forall x y:A, x = y \/ x <> y.
- Variable x: A.
+ Variable x : A.
- Local nu [y:A]: x==y->x==y :=
- [u]Cases (eq_dec x y) of
- (or_introl eqxy) => eqxy
- | (or_intror neqxy) => (False_ind ? (neqxy u))
- end.
+ Let nu (y:A) (u:x = y) : x = y :=
+ match eq_dec x y with
+ | or_introl eqxy => eqxy
+ | or_intror neqxy => False_ind _ (neqxy u)
+ end.
- Local nu_constant : (y:A)(u,v:x==y) (nu u)==(nu v).
-Intros.
-Unfold nu.
-Case (eq_dec x y); Intros.
-Reflexivity.
+ Let nu_constant : forall (y:A) (u v:x = y), nu u = nu v.
+intros.
+unfold nu in |- *.
+case (eq_dec x y); intros.
+reflexivity.
-Case n; Trivial.
+case n; trivial.
Qed.
- Local nu_inv [y:A]: x==y->x==y := [v](comp (nu (refl_eqT ? x)) v).
+ Let nu_inv (y:A) (v:x = y) : x = y := comp (nu (refl_equal x)) v.
- Remark nu_left_inv : (y:A)(u:x==y) (nu_inv (nu u))==u.
-Intros.
-Case u; Unfold nu_inv.
-Apply trans_sym_eqT.
+ Remark nu_left_inv : forall (y:A) (u:x = y), nu_inv (nu u) = u.
+intros.
+case u; unfold nu_inv in |- *.
+apply trans_sym_eqT.
Qed.
- Theorem eq_proofs_unicity: (y:A)(p1,p2:x==y) p1==p2.
-Intros.
-Elim nu_left_inv with u:=p1.
-Elim nu_left_inv with u:=p2.
-Elim nu_constant with y p1 p2.
-Reflexivity.
+ Theorem eq_proofs_unicity : forall (y:A) (p1 p2:x = y), p1 = p2.
+intros.
+elim nu_left_inv with (u := p1).
+elim nu_left_inv with (u := p2).
+elim nu_constant with y p1 p2.
+reflexivity.
Qed.
- Theorem K_dec: (P:x==x->Prop)(P (refl_eqT ? x)) -> (p:x==x)(P p).
-Intros.
-Elim eq_proofs_unicity with x (refl_eqT ? x) p.
-Trivial.
+ Theorem K_dec :
+ forall P:x = x -> Prop, P (refl_equal x) -> forall p:x = x, P p.
+intros.
+elim eq_proofs_unicity with x (refl_equal x) p.
+trivial.
Qed.
(** The corollary *)
- Local proj: (P:A->Prop)(ExT P)->(P x)->(P x) :=
- [P,exP,def]Cases exP of
- (exT_intro x' prf) =>
- Cases (eq_dec x' x) of
- (or_introl eqprf) => (eqT_ind ? x' P prf x eqprf)
+ Let proj (P:A -> Prop) (exP:ex P) (def:P x) : P x :=
+ match exP with
+ | ex_intro x' prf =>
+ match eq_dec x' x with
+ | or_introl eqprf => eq_ind x' P prf x eqprf
| _ => def
end
- end.
+ end.
- Theorem inj_right_pair: (P:A->Prop)(y,y':(P x))
- (exT_intro ? P x y)==(exT_intro ? P x y') -> y==y'.
-Intros.
-Cut (proj (exT_intro A P x y) y)==(proj (exT_intro A P x y') y).
-Simpl.
-Case (eq_dec x x).
-Intro e.
-Elim e using K_dec; Trivial.
+ Theorem inj_right_pair :
+ forall (P:A -> Prop) (y y':P x),
+ ex_intro P x y = ex_intro P x y' -> y = y'.
+intros.
+cut (proj (ex_intro P x y) y = proj (ex_intro P x y') y).
+simpl in |- *.
+case (eq_dec x x).
+intro e.
+elim e using K_dec; trivial.
-Intros.
-Case n; Trivial.
+intros.
+case n; trivial.
-Case H.
-Reflexivity.
+case H.
+reflexivity.
Qed.
End DecidableEqDep.
(** We deduce the [K] axiom for (decidable) Set *)
- Theorem K_dec_set: (A:Set)((x,y:A){x=y}+{~x=y})
- ->(x:A)(P: x=x->Prop)(P (refl_equal ? x))
- ->(p:x=x)(P p).
-Intros.
-Rewrite eq_eqT_bij.
-Elim (eq2eqT p) using K_dec.
-Intros.
-Case (H x0 y); Intros.
-Elim e; Left ; Reflexivity.
-
-Right ; Red; Intro neq; Apply n; Elim neq; Reflexivity.
-
-Trivial.
-Qed.
+ Theorem K_dec_set :
+ forall A:Set,
+ (forall x y:A, {x = y} + {x <> y}) ->
+ forall (x:A) (P:x = x -> Prop), P (refl_equal x) -> forall p:x = x, P p.
+intros.
+rewrite eq_eqT_bij.
+elim (eq2eqT p) using K_dec.
+intros.
+case (H x0 y); intros.
+elim e; left; reflexivity.
+
+right; red in |- *; intro neq; apply n; elim neq; reflexivity.
+
+trivial.
+Qed. \ No newline at end of file
diff --git a/theories/Logic/Hurkens.v b/theories/Logic/Hurkens.v
index 44d259431..8ae8a545f 100644
--- a/theories/Logic/Hurkens.v
+++ b/theories/Logic/Hurkens.v
@@ -31,53 +31,55 @@ Section Paradox.
Variable bool : Prop.
Variable p2b : Prop -> bool.
Variable b2p : bool -> Prop.
-Hypothesis p2p1 : (A:Prop)(b2p (p2b A))->A.
-Hypothesis p2p2 : (A:Prop)A->(b2p (p2b A)).
-Variable B:Prop.
+Hypothesis p2p1 : forall A:Prop, b2p (p2b A) -> A.
+Hypothesis p2p2 : forall A:Prop, A -> b2p (p2b A).
+Variable B : Prop.
-Definition V := (A:Prop)((A->bool)->(A->bool))->(A->bool).
-Definition U := V->bool.
-Definition sb : V -> V := [z][A;r;a](r (z A r) a).
-Definition le : (U->bool)->(U->bool) := [i][x](x [A;r;a](i [v](sb v A r a))).
-Definition induct : (U->bool)->Prop := [i](x:U)(b2p (le i x))->(b2p (i x)).
-Definition WF : U := [z](p2b (induct (z U le))).
-Definition I : U->Prop :=
- [x]((i:U->bool)(b2p (le i x))->(b2p (i [v](sb v U le x))))->B.
+Definition V := forall A:Prop, ((A -> bool) -> A -> bool) -> A -> bool.
+Definition U := V -> bool.
+Definition sb (z:V) : V := fun A r a => r (z A r) a.
+Definition le (i:U -> bool) (x:U) : bool :=
+ x (fun A r a => i (fun v => sb v A r a)).
+Definition induct (i:U -> bool) : Prop :=
+ forall x:U, b2p (le i x) -> b2p (i x).
+Definition WF : U := fun z => p2b (induct (z U le)).
+Definition I (x:U) : Prop :=
+ (forall i:U -> bool, b2p (le i x) -> b2p (i (fun v => sb v U le x))) -> B.
-Lemma Omega : (i:U->bool)(induct i)->(b2p (i WF)).
+Lemma Omega : forall i:U -> bool, induct i -> b2p (i WF).
Proof.
-Intros i y.
-Apply y.
-Unfold le WF induct.
-Apply p2p2.
-Intros x H0.
-Apply y.
-Exact H0.
+intros i y.
+apply y.
+unfold le, WF, induct in |- *.
+apply p2p2.
+intros x H0.
+apply y.
+exact H0.
Qed.
-Lemma lemma1 : (induct [u](p2b (I u))).
+Lemma lemma1 : induct (fun u => p2b (I u)).
Proof.
-Unfold induct.
-Intros x p.
-Apply (p2p2 (I x)).
-Intro q.
-Apply (p2p1 (I [v:V](sb v U le x)) (q [u](p2b (I u)) p)).
-Intro i.
-Apply q with i:=[y:?](i [v:V](sb v U le y)).
+unfold induct in |- *.
+intros x p.
+apply (p2p2 (I x)).
+intro q.
+apply (p2p1 (I (fun v:V => sb v U le x)) (q (fun u => p2b (I u)) p)).
+intro i.
+apply q with (i := fun y => i (fun v:V => sb v U le y)).
Qed.
-Lemma lemma2 : ((i:U->bool)(induct i)->(b2p (i WF)))->B.
+Lemma lemma2 : (forall i:U -> bool, induct i -> b2p (i WF)) -> B.
Proof.
-Intro x.
-Apply (p2p1 (I WF) (x [u](p2b (I u)) lemma1)).
-Intros i H0.
-Apply (x [y](i [v](sb v U le y))).
-Apply (p2p1 ? H0).
+intro x.
+apply (p2p1 (I WF) (x (fun u => p2b (I u)) lemma1)).
+intros i H0.
+apply (x (fun y => i (fun v => sb v U le y))).
+apply (p2p1 _ H0).
Qed.
Theorem paradox : B.
Proof.
-Exact (lemma2 Omega).
+exact (lemma2 Omega).
Qed.
-End Paradox.
+End Paradox. \ No newline at end of file
diff --git a/theories/Logic/JMeq.v b/theories/Logic/JMeq.v
index 04c62b3a1..10c9083f0 100644
--- a/theories/Logic/JMeq.v
+++ b/theories/Logic/JMeq.v
@@ -12,53 +12,57 @@
Set Implicit Arguments.
-Inductive JMeq [A:Set;x:A] : (B:Set)B->Prop :=
- JMeq_refl : (JMeq x x).
+Inductive JMeq (A:Set) (x:A) : forall B:Set, B -> Prop :=
+ JMeq_refl : JMeq x x.
Reset JMeq_ind.
-Hints Resolve JMeq_refl.
+Hint Resolve JMeq_refl.
-Lemma sym_JMeq : (A,B:Set)(x:A)(y:B)(JMeq x y)->(JMeq y x).
-NewDestruct 1; Trivial.
+Lemma sym_JMeq : forall (A B:Set) (x:A) (y:B), JMeq x y -> JMeq y x.
+destruct 1; trivial.
Qed.
-Hints Immediate sym_JMeq.
+Hint Immediate sym_JMeq.
-Lemma trans_JMeq : (A,B,C:Set)(x:A)(y:B)(z:C)
- (JMeq x y)->(JMeq y z)->(JMeq x z).
-NewDestruct 1; Trivial.
+Lemma trans_JMeq :
+ forall (A B C:Set) (x:A) (y:B) (z:C), JMeq x y -> JMeq y z -> JMeq x z.
+destruct 1; trivial.
Qed.
-Axiom JMeq_eq : (A:Set)(x,y:A)(JMeq x y)->(x=y).
+Axiom JMeq_eq : forall (A:Set) (x y:A), JMeq x y -> x = y.
-Lemma JMeq_ind : (A:Set)(x,y:A)(P:A->Prop)(P x)->(JMeq x y)->(P y).
-Intros A x y P H H'; Case JMeq_eq with 1:=H'; Trivial.
+Lemma JMeq_ind : forall (A:Set) (x y:A) (P:A -> Prop), P x -> JMeq x y -> P y.
+intros A x y P H H'; case JMeq_eq with (1 := H'); trivial.
Qed.
-Lemma JMeq_rec : (A:Set)(x,y:A)(P:A->Set)(P x)->(JMeq x y)->(P y).
-Intros A x y P H H'; Case JMeq_eq with 1:=H'; Trivial.
+Lemma JMeq_rec : forall (A:Set) (x y:A) (P:A -> Set), P x -> JMeq x y -> P y.
+intros A x y P H H'; case JMeq_eq with (1 := H'); trivial.
Qed.
-Lemma JMeq_ind_r : (A:Set)(x,y:A)(P:A->Prop)(P y)->(JMeq x y)->(P x).
-Intros A x y P H H'; Case JMeq_eq with 1:=(sym_JMeq H'); Trivial.
+Lemma JMeq_ind_r :
+ forall (A:Set) (x y:A) (P:A -> Prop), P y -> JMeq x y -> P x.
+intros A x y P H H'; case JMeq_eq with (1 := sym_JMeq H'); trivial.
Qed.
-Lemma JMeq_rec_r : (A:Set)(x,y:A)(P:A->Set)(P y)->(JMeq x y)->(P x).
-Intros A x y P H H'; Case JMeq_eq with 1:=(sym_JMeq H'); Trivial.
+Lemma JMeq_rec_r :
+ forall (A:Set) (x y:A) (P:A -> Set), P y -> JMeq x y -> P x.
+intros A x y P H H'; case JMeq_eq with (1 := sym_JMeq H'); trivial.
Qed.
(** [JMeq] is equivalent to [(eq_dep Set [X]X)] *)
-Require Eqdep.
+Require Import Eqdep.
-Lemma JMeq_eq_dep : (A,B:Set)(x:A)(y:B)(JMeq x y)->(eq_dep Set [X]X A x B y).
+Lemma JMeq_eq_dep :
+ forall (A B:Set) (x:A) (y:B), JMeq x y -> eq_dep Set (fun X => X) A x B y.
Proof.
-NewDestruct 1.
-Apply eq_dep_intro.
+destruct 1.
+apply eq_dep_intro.
Qed.
-Lemma eq_dep_JMeq : (A,B:Set)(x:A)(y:B)(eq_dep Set [X]X A x B y)->(JMeq x y).
+Lemma eq_dep_JMeq :
+ forall (A B:Set) (x:A) (y:B), eq_dep Set (fun X => X) A x B y -> JMeq x y.
Proof.
-NewDestruct 1.
-Apply JMeq_refl.
-Qed.
+destruct 1.
+apply JMeq_refl.
+Qed. \ No newline at end of file
diff --git a/theories/Logic/ProofIrrelevance.v b/theories/Logic/ProofIrrelevance.v
index ab2ca17c2..8636e5ddc 100644
--- a/theories/Logic/ProofIrrelevance.v
+++ b/theories/Logic/ProofIrrelevance.v
@@ -30,57 +30,62 @@
paradox of system U- (e.g. Hurkens' paradox).
*)
-Require Hurkens.
+Require Import Hurkens.
Section Proof_irrelevance_CC.
Variable or : Prop -> Prop -> Prop.
-Variable or_introl : (A,B:Prop)A->(or A B).
-Variable or_intror : (A,B:Prop)B->(or A B).
-Hypothesis or_elim : (A,B:Prop)(C:Prop)(A->C)->(B->C)->(or A B)->C.
-Hypothesis or_elim_redl :
- (A,B:Prop)(C:Prop)(f:A->C)(g:B->C)(a:A)
- (f a)==(or_elim A B C f g (or_introl A B a)).
-Hypothesis or_elim_redr :
- (A,B:Prop)(C:Prop)(f:A->C)(g:B->C)(b:B)
- (g b)==(or_elim A B C f g (or_intror A B b)).
-Hypothesis or_dep_elim :
- (A,B:Prop)(P:(or A B)->Prop)
- ((a:A)(P (or_introl A B a))) ->
- ((b:B)(P (or_intror A B b))) -> (b:(or A B))(P b).
-
-Hypothesis em : (A:Prop)(or A ~A).
+Variable or_introl : forall A B:Prop, A -> or A B.
+Variable or_intror : forall A B:Prop, B -> or A B.
+Hypothesis or_elim : forall A B C:Prop, (A -> C) -> (B -> C) -> or A B -> C.
+Hypothesis
+ or_elim_redl :
+ forall (A B C:Prop) (f:A -> C) (g:B -> C) (a:A),
+ f a = or_elim A B C f g (or_introl A B a).
+Hypothesis
+ or_elim_redr :
+ forall (A B C:Prop) (f:A -> C) (g:B -> C) (b:B),
+ g b = or_elim A B C f g (or_intror A B b).
+Hypothesis
+ or_dep_elim :
+ forall (A B:Prop) (P:or A B -> Prop),
+ (forall a:A, P (or_introl A B a)) ->
+ (forall b:B, P (or_intror A B b)) -> forall b:or A B, P b.
+
+Hypothesis em : forall A:Prop, or A (~ A).
Variable B : Prop.
-Variable b1,b2 : B.
+Variables b1 b2 : B.
(** [p2b] and [b2p] form a retract if [~b1==b2] *)
-Definition p2b [A] := (or_elim A ~A B [_]b1 [_]b2 (em A)).
-Definition b2p [b] := b1==b.
+Definition p2b A := or_elim A (~ A) B (fun _ => b1) (fun _ => b2) (em A).
+Definition b2p b := b1 = b.
-Lemma p2p1 : (A:Prop) A -> (b2p (p2b A)).
+Lemma p2p1 : forall A:Prop, A -> b2p (p2b A).
Proof.
- Unfold p2b; Intro A; Apply or_dep_elim with b:=(em A); Unfold b2p; Intros.
- Apply (or_elim_redl A ~A B [_]b1 [_]b2).
- NewDestruct (b H).
+ unfold p2b in |- *; intro A; apply or_dep_elim with (b := em A);
+ unfold b2p in |- *; intros.
+ apply (or_elim_redl A (~ A) B (fun _ => b1) (fun _ => b2)).
+ destruct (b H).
Qed.
-Lemma p2p2 : ~b1==b2->(A:Prop) (b2p (p2b A)) -> A.
+Lemma p2p2 : b1 <> b2 -> forall A:Prop, b2p (p2b A) -> A.
Proof.
- Intro not_eq_b1_b2.
- Unfold p2b; Intro A; Apply or_dep_elim with b:=(em A); Unfold b2p; Intros.
- Assumption.
- NewDestruct not_eq_b1_b2.
- Rewrite <- (or_elim_redr A ~A B [_]b1 [_]b2) in H.
- Assumption.
+ intro not_eq_b1_b2.
+ unfold p2b in |- *; intro A; apply or_dep_elim with (b := em A);
+ unfold b2p in |- *; intros.
+ assumption.
+ destruct not_eq_b1_b2.
+ rewrite <- (or_elim_redr A (~ A) B (fun _ => b1) (fun _ => b2)) in H.
+ assumption.
Qed.
(** Using excluded-middle a second time, we get proof-irrelevance *)
-Theorem proof_irrelevance_cc : b1==b2.
+Theorem proof_irrelevance_cc : b1 = b2.
Proof.
- Refine (or_elim ? ? ? ? ? (em b1==b2));Intro H.
- Trivial.
- Apply (paradox B p2b b2p (p2p2 H) p2p1).
+ refine (or_elim _ _ _ _ _ (em (b1 = b2))); intro H.
+ trivial.
+ apply (paradox B p2b b2p (p2p2 H) p2p1).
Qed.
End Proof_irrelevance_CC.
@@ -92,26 +97,22 @@ End Proof_irrelevance_CC.
Section Proof_irrelevance_CCI.
-Hypothesis em : (A:Prop) A \/ ~A.
+Hypothesis em : forall A:Prop, A \/ ~ A.
-Definition or_elim_redl :
- (A,B:Prop)(C:Prop)(f:A->C)(g:B->C)(a:A)
- (f a)==(or_ind A B C f g (or_introl A B a))
- := [A,B,C;f;g;a](refl_eqT C (f a)).
-Definition or_elim_redr :
- (A,B:Prop)(C:Prop)(f:A->C)(g:B->C)(b:B)
- (g b)==(or_ind A B C f g (or_intror A B b))
- := [A,B,C;f;g;b](refl_eqT C (g b)).
+Definition or_elim_redl (A B C:Prop) (f:A -> C) (g:B -> C)
+ (a:A) : f a = or_ind f g (or_introl B a) := refl_equal (f a).
+Definition or_elim_redr (A B C:Prop) (f:A -> C) (g:B -> C)
+ (b:B) : g b = or_ind f g (or_intror A b) := refl_equal (g b).
Scheme or_indd := Induction for or Sort Prop.
-Theorem proof_irrelevance_cci : (B:Prop)(b1,b2:B)b1==b2.
+Theorem proof_irrelevance_cci : forall (B:Prop) (b1 b2:B), b1 = b2.
Proof
- (proof_irrelevance_cc or or_introl or_intror or_ind
- or_elim_redl or_elim_redr or_indd em).
+ proof_irrelevance_cc or or_introl or_intror or_ind or_elim_redl
+ or_elim_redr or_indd em.
End Proof_irrelevance_CCI.
(** Remark: in CCI, [bool] can be taken in [Set] as well in the
paradox and since [~true=false] for [true] and [false] in
[bool], we get the inconsistency of [em : (A:Prop){A}+{~A}] in CCI
-*)
+*) \ No newline at end of file
diff --git a/theories/Logic/RelationalChoice.v b/theories/Logic/RelationalChoice.v
index 5addb4d24..c55095e47 100644
--- a/theories/Logic/RelationalChoice.v
+++ b/theories/Logic/RelationalChoice.v
@@ -10,8 +10,11 @@
(* This file axiomatizes the relational form of the axiom of choice *)
-Axiom relational_choice :
- (A:Type;B:Type;R: A->B->Prop)
- ((x:A)(EX y:B|(R x y)))
- -> (EXT R':A->B->Prop |
- ((x:A)(EX y:B|(R x y)/\(R' x y)/\ ((y':B) (R' x y') -> y=y')))).
+Axiom
+ relational_choice :
+ forall (A B:Type) (R:A -> B -> Prop),
+ (forall x:A, exists y : B | R x y) ->
+ exists R' : A -> B -> Prop
+ | (forall x:A,
+ exists y : B
+ | R x y /\ R' x y /\ (forall y':B, R' x y' -> y = y')). \ No newline at end of file
diff --git a/theories/NArith/BinNat.v b/theories/NArith/BinNat.v
index e11194a5d..edaa3130f 100644
--- a/theories/NArith/BinNat.v
+++ b/theories/NArith/BinNat.v
@@ -8,198 +8,205 @@
(*i $Id$ i*)
-Require BinPos.
+Require Import BinPos.
(**********************************************************************)
(** Binary natural numbers *)
-Inductive entier: Set := Nul : entier | Pos : positive -> entier.
+Inductive N : Set :=
+ | N0 : N
+ | Npos : positive -> N.
(** Declare binding key for scope positive_scope *)
-Delimits Scope N_scope with N.
+Delimit Scope N_scope with N.
(** Automatically open scope N_scope for the constructors of N *)
-Bind Scope N_scope with entier.
-Arguments Scope Pos [ N_scope ].
+Bind Scope N_scope with N.
+Arguments Scope Npos [N_scope].
Open Local Scope N_scope.
(** Operation x -> 2*x+1 *)
-Definition Un_suivi_de := [x]
- Cases x of Nul => (Pos xH) | (Pos p) => (Pos (xI p)) end.
+Definition Ndouble_plus_one x :=
+ match x with
+ | N0 => Npos 1%positive
+ | Npos p => Npos (xI p)
+ end.
(** Operation x -> 2*x *)
-Definition Zero_suivi_de :=
- [n] Cases n of Nul => Nul | (Pos p) => (Pos (xO p)) end.
+Definition Ndouble n := match n with
+ | N0 => N0
+ | Npos p => Npos (xO p)
+ end.
(** Successor *)
-Definition Nsucc :=
- [n] Cases n of Nul => (Pos xH) | (Pos p) => (Pos (add_un p)) end.
+Definition Nsucc n :=
+ match n with
+ | N0 => Npos 1%positive
+ | Npos p => Npos (Psucc p)
+ end.
(** Addition *)
-Definition Nplus := [n,m]
- Cases n m of
- | Nul _ => m
- | _ Nul => n
- | (Pos p) (Pos q) => (Pos (add p q))
+Definition Nplus n m :=
+ match n, m with
+ | N0, _ => m
+ | _, N0 => n
+ | Npos p, Npos q => Npos (p + q)%positive
end.
-V8Infix "+" Nplus : N_scope.
+Infix "+" := Nplus : N_scope.
(** Multiplication *)
-Definition Nmult := [n,m]
- Cases n m of
- | Nul _ => Nul
- | _ Nul => Nul
- | (Pos p) (Pos q) => (Pos (times p q))
+Definition Nmult n m :=
+ match n, m with
+ | N0, _ => N0
+ | _, N0 => N0
+ | Npos p, Npos q => Npos (p * q)%positive
end.
-V8Infix "*" Nmult : N_scope.
+Infix "*" := Nmult : N_scope.
(** Order *)
-Definition Ncompare := [n,m]
- Cases n m of
- | Nul Nul => EGAL
- | Nul (Pos m') => INFERIEUR
- | (Pos n') Nul => SUPERIEUR
- | (Pos n') (Pos m') => (compare n' m' EGAL)
+Definition Ncompare n m :=
+ match n, m with
+ | N0, N0 => Eq
+ | N0, Npos m' => Lt
+ | Npos n', N0 => Gt
+ | Npos n', Npos m' => (n' ?= m')%positive Eq
end.
-V8Infix "?=" Ncompare (at level 70, no associativity) : N_scope.
+Infix "?=" := Ncompare (at level 70, no associativity) : N_scope.
(** Peano induction on binary natural numbers *)
-Theorem Nind : (P:(entier ->Prop))
- (P Nul) ->((n:entier)(P n) ->(P (Nsucc n))) ->(n:entier)(P n).
+Theorem Nind :
+ forall P:N -> Prop,
+ P N0 -> (forall n:N, P n -> P (Nsucc n)) -> forall n:N, P n.
Proof.
-NewDestruct n.
- Assumption.
- Apply Pind with P := [p](P (Pos p)).
-Exact (H0 Nul H).
-Intro p'; Exact (H0 (Pos p')).
+destruct n.
+ assumption.
+ apply Pind with (P := fun p => P (Npos p)).
+exact (H0 N0 H).
+intro p'; exact (H0 (Npos p')).
Qed.
(** Properties of addition *)
-Theorem Nplus_0_l : (n:entier)(Nplus Nul n)=n.
+Theorem Nplus_0_l : forall n:N, N0 + n = n.
Proof.
-Reflexivity.
+reflexivity.
Qed.
-Theorem Nplus_0_r : (n:entier)(Nplus n Nul)=n.
+Theorem Nplus_0_r : forall n:N, n + N0 = n.
Proof.
-NewDestruct n; Reflexivity.
+destruct n; reflexivity.
Qed.
-Theorem Nplus_comm : (n,m:entier)(Nplus n m)=(Nplus m n).
+Theorem Nplus_comm : forall n m:N, n + m = m + n.
Proof.
-Intros.
-NewDestruct n; NewDestruct m; Simpl; Try Reflexivity.
-Rewrite add_sym; Reflexivity.
+intros.
+destruct n; destruct m; simpl in |- *; try reflexivity.
+rewrite Pplus_comm; reflexivity.
Qed.
-Theorem Nplus_assoc :
- (n,m,p:entier)(Nplus n (Nplus m p))=(Nplus (Nplus n m) p).
+Theorem Nplus_assoc : forall n m p:N, n + (m + p) = n + m + p.
Proof.
-Intros.
-NewDestruct n; Try Reflexivity.
-NewDestruct m; Try Reflexivity.
-NewDestruct p; Try Reflexivity.
-Simpl; Rewrite add_assoc; Reflexivity.
+intros.
+destruct n; try reflexivity.
+destruct m; try reflexivity.
+destruct p; try reflexivity.
+simpl in |- *; rewrite Pplus_assoc; reflexivity.
Qed.
-Theorem Nplus_succ : (n,m:entier)(Nplus (Nsucc n) m)=(Nsucc (Nplus n m)).
+Theorem Nplus_succ : forall n m:N, Nsucc n + m = Nsucc (n + m).
Proof.
-NewDestruct n; NewDestruct m.
- Simpl; Reflexivity.
- Unfold Nsucc Nplus; Rewrite <- ZL12bis; Reflexivity.
- Simpl; Reflexivity.
- Simpl; Rewrite ZL14bis; Reflexivity.
+destruct n; destruct m.
+ simpl in |- *; reflexivity.
+ unfold Nsucc, Nplus in |- *; rewrite <- Pplus_one_succ_l; reflexivity.
+ simpl in |- *; reflexivity.
+ simpl in |- *; rewrite Pplus_succ_permute_l; reflexivity.
Qed.
-Theorem Nsucc_inj : (n,m:entier)(Nsucc n)=(Nsucc m)->n=m.
+Theorem Nsucc_inj : forall n m:N, Nsucc n = Nsucc m -> n = m.
Proof.
-NewDestruct n; NewDestruct m; Simpl; Intro H;
- Reflexivity Orelse Injection H; Clear H; Intro H.
- Symmetry in H; Contradiction add_un_not_un with p.
- Contradiction add_un_not_un with p.
- Rewrite add_un_inj with 1:=H; Reflexivity.
+destruct n; destruct m; simpl in |- *; intro H; reflexivity || injection H;
+ clear H; intro H.
+ symmetry in H; contradiction Psucc_not_one with p.
+ contradiction Psucc_not_one with p.
+ rewrite Psucc_inj with (1 := H); reflexivity.
Qed.
-Theorem Nplus_reg_l : (n,m,p:entier)(Nplus n m)=(Nplus n p)->m=p.
+Theorem Nplus_reg_l : forall n m p:N, n + m = n + p -> m = p.
Proof.
-Intro n; Pattern n; Apply Nind; Clear n; Simpl.
- Trivial.
- Intros n IHn m p H0; Do 2 Rewrite Nplus_succ in H0.
- Apply IHn; Apply Nsucc_inj; Assumption.
+intro n; pattern n in |- *; apply Nind; clear n; simpl in |- *.
+ trivial.
+ intros n IHn m p H0; do 2 rewrite Nplus_succ in H0.
+ apply IHn; apply Nsucc_inj; assumption.
Qed.
(** Properties of multiplication *)
-Theorem Nmult_1_l : (n:entier)(Nmult (Pos xH) n)=n.
+Theorem Nmult_1_l : forall n:N, Npos 1%positive * n = n.
Proof.
-NewDestruct n; Reflexivity.
+destruct n; reflexivity.
Qed.
-Theorem Nmult_1_r : (n:entier)(Nmult n (Pos xH))=n.
+Theorem Nmult_1_r : forall n:N, n * Npos 1%positive = n.
Proof.
-NewDestruct n; Simpl; Try Reflexivity.
-Rewrite times_x_1; Reflexivity.
+destruct n; simpl in |- *; try reflexivity.
+rewrite Pmult_1_r; reflexivity.
Qed.
-Theorem Nmult_comm : (n,m:entier)(Nmult n m)=(Nmult m n).
+Theorem Nmult_comm : forall n m:N, n * m = m * n.
Proof.
-Intros.
-NewDestruct n; NewDestruct m; Simpl; Try Reflexivity.
-Rewrite times_sym; Reflexivity.
+intros.
+destruct n; destruct m; simpl in |- *; try reflexivity.
+rewrite Pmult_comm; reflexivity.
Qed.
-Theorem Nmult_assoc :
- (n,m,p:entier)(Nmult n (Nmult m p))=(Nmult (Nmult n m) p).
+Theorem Nmult_assoc : forall n m p:N, n * (m * p) = n * m * p.
Proof.
-Intros.
-NewDestruct n; Try Reflexivity.
-NewDestruct m; Try Reflexivity.
-NewDestruct p; Try Reflexivity.
-Simpl; Rewrite times_assoc; Reflexivity.
+intros.
+destruct n; try reflexivity.
+destruct m; try reflexivity.
+destruct p; try reflexivity.
+simpl in |- *; rewrite Pmult_assoc; reflexivity.
Qed.
-Theorem Nmult_plus_distr_r :
- (n,m,p:entier)(Nmult (Nplus n m) p)=(Nplus (Nmult n p) (Nmult m p)).
+Theorem Nmult_plus_distr_r : forall n m p:N, (n + m) * p = n * p + m * p.
Proof.
-Intros.
-NewDestruct n; Try Reflexivity.
-NewDestruct m; NewDestruct p; Try Reflexivity.
-Simpl; Rewrite times_add_distr_l; Reflexivity.
+intros.
+destruct n; try reflexivity.
+destruct m; destruct p; try reflexivity.
+simpl in |- *; rewrite Pmult_plus_distr_r; reflexivity.
Qed.
-Theorem Nmult_reg_r : (n,m,p:entier) ~p=Nul->(Nmult n p)=(Nmult m p) -> n=m.
+Theorem Nmult_reg_r : forall n m p:N, p <> N0 -> n * p = m * p -> n = m.
Proof.
-NewDestruct p; Intros Hp H.
-Contradiction Hp; Reflexivity.
-NewDestruct n; NewDestruct m; Reflexivity Orelse Try Discriminate H.
-Injection H; Clear H; Intro H; Rewrite simpl_times_r with 1:=H; Reflexivity.
+destruct p; intros Hp H.
+contradiction Hp; reflexivity.
+destruct n; destruct m; reflexivity || (try discriminate H).
+injection H; clear H; intro H; rewrite Pmult_reg_r with (1 := H); reflexivity.
Qed.
-Theorem Nmult_0_l : (n:entier) (Nmult Nul n) = Nul.
+Theorem Nmult_0_l : forall n:N, N0 * n = N0.
Proof.
-Reflexivity.
+reflexivity.
Qed.
(** Properties of comparison *)
-Theorem Ncompare_Eq_eq : (n,m:entier) (Ncompare n m) = EGAL -> n = m.
+Theorem Ncompare_Eq_eq : forall n m:N, (n ?= m) = Eq -> n = m.
Proof.
-NewDestruct n as [|n]; NewDestruct m as [|m]; Simpl; Intro H;
- Reflexivity Orelse Try Discriminate H.
- Rewrite (compare_convert_EGAL n m H); Reflexivity.
+destruct n as [| n]; destruct m as [| m]; simpl in |- *; intro H;
+ reflexivity || (try discriminate H).
+ rewrite (Pcompare_Eq_eq n m H); reflexivity.
Qed.
-
diff --git a/theories/NArith/BinPos.v b/theories/NArith/BinPos.v
index b5fa6694b..6ef509d06 100644
--- a/theories/NArith/BinPos.v
+++ b/theories/NArith/BinPos.v
@@ -14,202 +14,212 @@
(** Original development by Pierre Crégut, CNET, Lannion, France *)
Inductive positive : Set :=
- xI : positive -> positive
-| xO : positive -> positive
-| xH : positive.
+ | xI : positive -> positive
+ | xO : positive -> positive
+ | xH : positive.
(** Declare binding key for scope positive_scope *)
-Delimits Scope positive_scope with positive.
+Delimit Scope positive_scope with positive.
(** Automatically open scope positive_scope for type positive, xO and xI *)
Bind Scope positive_scope with positive.
-Arguments Scope xO [ positive_scope ].
-Arguments Scope xI [ positive_scope ].
+Arguments Scope xO [positive_scope].
+Arguments Scope xI [positive_scope].
(** Successor *)
-Fixpoint add_un [x:positive]:positive :=
- Cases x of
- (xI x') => (xO (add_un x'))
- | (xO x') => (xI x')
- | xH => (xO xH)
+Fixpoint Psucc (x:positive) : positive :=
+ match x with
+ | xI x' => xO (Psucc x')
+ | xO x' => xI x'
+ | xH => xO xH
end.
(** Addition *)
-Fixpoint add [x:positive]:positive -> positive := [y:positive]
- Cases x y of
- | (xI x') (xI y') => (xO (add_carry x' y'))
- | (xI x') (xO y') => (xI (add x' y'))
- | (xI x') xH => (xO (add_un x'))
- | (xO x') (xI y') => (xI (add x' y'))
- | (xO x') (xO y') => (xO (add x' y'))
- | (xO x') xH => (xI x')
- | xH (xI y') => (xO (add_un y'))
- | xH (xO y') => (xI y')
- | xH xH => (xO xH)
+Fixpoint Pplus (x y:positive) {struct x} : positive :=
+ match x, y with
+ | xI x', xI y' => xO (Pplus_carry x' y')
+ | xI x', xO y' => xI (Pplus x' y')
+ | xI x', xH => xO (Psucc x')
+ | xO x', xI y' => xI (Pplus x' y')
+ | xO x', xO y' => xO (Pplus x' y')
+ | xO x', xH => xI x'
+ | xH, xI y' => xO (Psucc y')
+ | xH, xO y' => xI y'
+ | xH, xH => xO xH
end
-with add_carry [x:positive]:positive -> positive := [y:positive]
- Cases x y of
- | (xI x') (xI y') => (xI (add_carry x' y'))
- | (xI x') (xO y') => (xO (add_carry x' y'))
- | (xI x') xH => (xI (add_un x'))
- | (xO x') (xI y') => (xO (add_carry x' y'))
- | (xO x') (xO y') => (xI (add x' y'))
- | (xO x') xH => (xO (add_un x'))
- | xH (xI y') => (xI (add_un y'))
- | xH (xO y') => (xO (add_un y'))
- | xH xH => (xI xH)
+
+ with Pplus_carry (x y:positive) {struct x} : positive :=
+ match x, y with
+ | xI x', xI y' => xI (Pplus_carry x' y')
+ | xI x', xO y' => xO (Pplus_carry x' y')
+ | xI x', xH => xI (Psucc x')
+ | xO x', xI y' => xO (Pplus_carry x' y')
+ | xO x', xO y' => xI (Pplus x' y')
+ | xO x', xH => xO (Psucc x')
+ | xH, xI y' => xI (Psucc y')
+ | xH, xO y' => xO (Psucc y')
+ | xH, xH => xI xH
end.
-V7only [Notation "x + y" := (add x y) : positive_scope.].
-V8Infix "+" add : positive_scope.
+Infix "+" := Pplus : positive_scope.
Open Local Scope positive_scope.
(** From binary positive numbers to Peano natural numbers *)
-Fixpoint positive_to_nat [x:positive]:nat -> nat :=
- [pow2:nat]
- Cases x of
- (xI x') => (plus pow2 (positive_to_nat x' (plus pow2 pow2)))
- | (xO x') => (positive_to_nat x' (plus pow2 pow2))
- | xH => pow2
- end.
+Fixpoint Pmult_nat (x:positive) (pow2:nat) {struct x} : nat :=
+ match x with
+ | xI x' => (pow2 + Pmult_nat x' (pow2 + pow2))%nat
+ | xO x' => Pmult_nat x' (pow2 + pow2)%nat
+ | xH => pow2
+ end.
-Definition convert := [x:positive] (positive_to_nat x (S O)).
+Definition nat_of_P (x:positive) := Pmult_nat x 1.
(** From Peano natural numbers to binary positive numbers *)
-Fixpoint anti_convert [n:nat]: positive :=
- Cases n of
- O => xH
- | (S x') => (add_un (anti_convert x'))
- end.
+Fixpoint P_of_succ_nat (n:nat) : positive :=
+ match n with
+ | O => xH
+ | S x' => Psucc (P_of_succ_nat x')
+ end.
(** Operation x -> 2*x-1 *)
-Fixpoint double_moins_un [x:positive]:positive :=
- Cases x of
- (xI x') => (xI (xO x'))
- | (xO x') => (xI (double_moins_un x'))
- | xH => xH
- end.
+Fixpoint Pdouble_minus_one (x:positive) : positive :=
+ match x with
+ | xI x' => xI (xO x')
+ | xO x' => xI (Pdouble_minus_one x')
+ | xH => xH
+ end.
(** Predecessor *)
-Definition sub_un := [x:positive]
- Cases x of
- (xI x') => (xO x')
- | (xO x') => (double_moins_un x')
- | xH => xH
- end.
+Definition Ppred (x:positive) :=
+ match x with
+ | xI x' => xO x'
+ | xO x' => Pdouble_minus_one x'
+ | xH => xH
+ end.
(** An auxiliary type for subtraction *)
-Inductive positive_mask: Set :=
- IsNul : positive_mask
- | IsPos : positive -> positive_mask
- | IsNeg : positive_mask.
+Inductive positive_mask : Set :=
+ | IsNul : positive_mask
+ | IsPos : positive -> positive_mask
+ | IsNeg : positive_mask.
(** Operation x -> 2*x+1 *)
-Definition Un_suivi_de_mask := [x:positive_mask]
- Cases x of IsNul => (IsPos xH) | IsNeg => IsNeg | (IsPos p) => (IsPos (xI p)) end.
+Definition Pdouble_plus_one_mask (x:positive_mask) :=
+ match x with
+ | IsNul => IsPos xH
+ | IsNeg => IsNeg
+ | IsPos p => IsPos (xI p)
+ end.
(** Operation x -> 2*x *)
-Definition Zero_suivi_de_mask := [x:positive_mask]
- Cases x of IsNul => IsNul | IsNeg => IsNeg | (IsPos p) => (IsPos (xO p)) end.
+Definition Pdouble_mask (x:positive_mask) :=
+ match x with
+ | IsNul => IsNul
+ | IsNeg => IsNeg
+ | IsPos p => IsPos (xO p)
+ end.
(** Operation x -> 2*x-2 *)
-Definition double_moins_deux :=
- [x:positive] Cases x of
- (xI x') => (IsPos (xO (xO x')))
- | (xO x') => (IsPos (xO (double_moins_un x')))
- | xH => IsNul
- end.
+Definition Pdouble_minus_two (x:positive) :=
+ match x with
+ | xI x' => IsPos (xO (xO x'))
+ | xO x' => IsPos (xO (Pdouble_minus_one x'))
+ | xH => IsNul
+ end.
(** Subtraction of binary positive numbers into a positive numbers mask *)
-Fixpoint sub_pos[x,y:positive]:positive_mask :=
- Cases x y of
- | (xI x') (xI y') => (Zero_suivi_de_mask (sub_pos x' y'))
- | (xI x') (xO y') => (Un_suivi_de_mask (sub_pos x' y'))
- | (xI x') xH => (IsPos (xO x'))
- | (xO x') (xI y') => (Un_suivi_de_mask (sub_neg x' y'))
- | (xO x') (xO y') => (Zero_suivi_de_mask (sub_pos x' y'))
- | (xO x') xH => (IsPos (double_moins_un x'))
- | xH xH => IsNul
- | xH _ => IsNeg
+Fixpoint Pminus_mask (x y:positive) {struct y} : positive_mask :=
+ match x, y with
+ | xI x', xI y' => Pdouble_mask (Pminus_mask x' y')
+ | xI x', xO y' => Pdouble_plus_one_mask (Pminus_mask x' y')
+ | xI x', xH => IsPos (xO x')
+ | xO x', xI y' => Pdouble_plus_one_mask (Pminus_mask_carry x' y')
+ | xO x', xO y' => Pdouble_mask (Pminus_mask x' y')
+ | xO x', xH => IsPos (Pdouble_minus_one x')
+ | xH, xH => IsNul
+ | xH, _ => IsNeg
end
-with sub_neg [x,y:positive]:positive_mask :=
- Cases x y of
- (xI x') (xI y') => (Un_suivi_de_mask (sub_neg x' y'))
- | (xI x') (xO y') => (Zero_suivi_de_mask (sub_pos x' y'))
- | (xI x') xH => (IsPos (double_moins_un x'))
- | (xO x') (xI y') => (Zero_suivi_de_mask (sub_neg x' y'))
- | (xO x') (xO y') => (Un_suivi_de_mask (sub_neg x' y'))
- | (xO x') xH => (double_moins_deux x')
- | xH _ => IsNeg
+
+ with Pminus_mask_carry (x y:positive) {struct y} : positive_mask :=
+ match x, y with
+ | xI x', xI y' => Pdouble_plus_one_mask (Pminus_mask_carry x' y')
+ | xI x', xO y' => Pdouble_mask (Pminus_mask x' y')
+ | xI x', xH => IsPos (Pdouble_minus_one x')
+ | xO x', xI y' => Pdouble_mask (Pminus_mask_carry x' y')
+ | xO x', xO y' => Pdouble_plus_one_mask (Pminus_mask_carry x' y')
+ | xO x', xH => Pdouble_minus_two x'
+ | xH, _ => IsNeg
end.
(** Subtraction of binary positive numbers x and y, returns 1 if x<=y *)
-Definition true_sub := [x,y:positive]
- Cases (sub_pos x y) of (IsPos z) => z | _ => xH end.
+Definition Pminus (x y:positive) :=
+ match Pminus_mask x y with
+ | IsPos z => z
+ | _ => xH
+ end.
-V8Infix "-" true_sub : positive_scope.
+Infix "-" := Pminus : positive_scope.
(** Multiplication on binary positive numbers *)
-Fixpoint times [x:positive] : positive -> positive:=
- [y:positive]
- Cases x of
- (xI x') => (add y (xO (times x' y)))
- | (xO x') => (xO (times x' y))
+Fixpoint Pmult (x y:positive) {struct x} : positive :=
+ match x with
+ | xI x' => y + xO (Pmult x' y)
+ | xO x' => xO (Pmult x' y)
| xH => y
end.
-V8Infix "*" times : positive_scope.
+Infix "*" := Pmult : positive_scope.
(** Division by 2 rounded below but for 1 *)
-Definition Zdiv2_pos :=
- [z:positive]Cases z of xH => xH
- | (xO p) => p
- | (xI p) => p
- end.
+Definition Pdiv2 (z:positive) :=
+ match z with
+ | xH => xH
+ | xO p => p
+ | xI p => p
+ end.
-V8Infix "/" Zdiv2_pos : positive_scope.
+Infix "/" := Pdiv2 : positive_scope.
(** Comparison on binary positive numbers *)
-Fixpoint compare [x,y:positive]: relation -> relation :=
- [r:relation]
- Cases x y of
- | (xI x') (xI y') => (compare x' y' r)
- | (xI x') (xO y') => (compare x' y' SUPERIEUR)
- | (xI x') xH => SUPERIEUR
- | (xO x') (xI y') => (compare x' y' INFERIEUR)
- | (xO x') (xO y') => (compare x' y' r)
- | (xO x') xH => SUPERIEUR
- | xH (xI y') => INFERIEUR
- | xH (xO y') => INFERIEUR
- | xH xH => r
+Fixpoint Pcompare (x y:positive) (r:comparison) {struct y} : comparison :=
+ match x, y with
+ | xI x', xI y' => Pcompare x' y' r
+ | xI x', xO y' => Pcompare x' y' Gt
+ | xI x', xH => Gt
+ | xO x', xI y' => Pcompare x' y' Lt
+ | xO x', xO y' => Pcompare x' y' r
+ | xO x', xH => Gt
+ | xH, xI y' => Lt
+ | xH, xO y' => Lt
+ | xH, xH => r
end.
-V8Infix "?=" compare (at level 70, no associativity) : positive_scope.
+Infix "?=" := Pcompare (at level 70, no associativity) : positive_scope.
(**********************************************************************)
(** Miscellaneous properties of binary positive numbers *)
-Lemma ZL11: (x:positive) (x=xH) \/ ~(x=xH).
+Lemma ZL11 : forall p:positive, p = xH \/ p <> xH.
Proof.
-Intros x;Case x;Intros; (Left;Reflexivity) Orelse (Right;Discriminate).
+intros x; case x; intros; (left; reflexivity) || (right; discriminate).
Qed.
(**********************************************************************)
@@ -217,72 +227,78 @@ Qed.
(** Specification of [xI] in term of [Psucc] and [xO] *)
-Lemma xI_add_un_xO : (x:positive)(xI x) = (add_un (xO x)).
+Lemma xI_succ_xO : forall p:positive, xI p = Psucc (xO p).
Proof.
-Reflexivity.
+reflexivity.
Qed.
-Lemma add_un_discr : (x:positive)x<>(add_un x).
+Lemma Psucc_discr : forall p:positive, p <> Psucc p.
Proof.
-Intro x; NewDestruct x; Discriminate.
+intro x; destruct x as [p| p| ]; discriminate.
Qed.
(** Successor and double *)
-Lemma is_double_moins_un : (x:positive) (add_un (double_moins_un x)) = (xO x).
+Lemma Psucc_o_double_minus_one_eq_xO :
+ forall p:positive, Psucc (Pdouble_minus_one p) = xO p.
Proof.
-Intro x; NewInduction x as [x IHx|x|]; Simpl; Try Rewrite IHx; Reflexivity.
+intro x; induction x as [x IHx| x| ]; simpl in |- *; try rewrite IHx;
+ reflexivity.
Qed.
-Lemma double_moins_un_add_un_xI :
- (x:positive)(double_moins_un (add_un x))=(xI x).
+Lemma Pdouble_minus_one_o_succ_eq_xI :
+ forall p:positive, Pdouble_minus_one (Psucc p) = xI p.
Proof.
-Intro x;NewInduction x as [x IHx|x|]; Simpl; Try Rewrite IHx; Reflexivity.
+intro x; induction x as [x IHx| x| ]; simpl in |- *; try rewrite IHx;
+ reflexivity.
Qed.
-Lemma ZL1: (y:positive)(xO (add_un y)) = (add_un (add_un (xO y))).
+Lemma xO_succ_permute :
+ forall p:positive, xO (Psucc p) = Psucc (Psucc (xO p)).
Proof.
-Intro y; Induction y; Simpl; Auto.
+intro y; induction y as [y Hrecy| y Hrecy| ]; simpl in |- *; auto.
Qed.
-Lemma double_moins_un_xO_discr : (x:positive)(double_moins_un x)<>(xO x).
+Lemma double_moins_un_xO_discr :
+ forall p:positive, Pdouble_minus_one p <> xO p.
Proof.
-Intro x; NewDestruct x; Discriminate.
+intro x; destruct x as [p| p| ]; discriminate.
Qed.
(** Successor and predecessor *)
-Lemma add_un_not_un : (x:positive) (add_un x) <> xH.
+Lemma Psucc_not_one : forall p:positive, Psucc p <> xH.
Proof.
-Intro x; NewDestruct x as [x|x|]; Discriminate.
+intro x; destruct x as [x| x| ]; discriminate.
Qed.
-Lemma sub_add_one : (x:positive) (sub_un (add_un x)) = x.
+Lemma Ppred_succ : forall p:positive, Ppred (Psucc p) = p.
Proof.
-(Intro x; NewDestruct x as [p|p|]; [Idtac | Idtac | Simpl;Auto]);
-(NewInduction p as [p IHp||]; [Idtac | Reflexivity | Reflexivity ]);
-Simpl; Simpl in IHp; Try Rewrite <- IHp; Reflexivity.
+intro x; destruct x as [p| p| ]; [ idtac | idtac | simpl in |- *; auto ];
+ (induction p as [p IHp| | ]; [ idtac | reflexivity | reflexivity ]);
+ simpl in |- *; simpl in IHp; try rewrite <- IHp; reflexivity.
Qed.
-Lemma add_sub_one : (x:positive) (x=xH) \/ (add_un (sub_un x)) = x.
+Lemma Psucc_pred : forall p:positive, p = xH \/ Psucc (Ppred p) = p.
Proof.
-Intro x; Induction x; [
- Simpl; Auto
-| Simpl; Intros;Right;Apply is_double_moins_un
-| Auto ].
+intro x; induction x as [x Hrecx| x Hrecx| ];
+ [ simpl in |- *; auto
+ | simpl in |- *; intros; right; apply Psucc_o_double_minus_one_eq_xO
+ | auto ].
Qed.
(** Injectivity of successor *)
-Lemma add_un_inj : (x,y:positive) (add_un x)=(add_un y) -> x=y.
+Lemma Psucc_inj : forall p q:positive, Psucc p = Psucc q -> p = q.
Proof.
-Intro x;NewInduction x; Intro y; NewDestruct y as [y|y|]; Simpl;
- Intro H; Discriminate H Orelse Try (Injection H; Clear H; Intro H).
-Rewrite (IHx y H); Reflexivity.
-Absurd (add_un x)=xH; [ Apply add_un_not_un | Assumption ].
-Apply f_equal with 1:=H; Assumption.
-Absurd (add_un y)=xH; [ Apply add_un_not_un | Symmetry; Assumption ].
-Reflexivity.
+intro x; induction x; intro y; destruct y as [y| y| ]; simpl in |- *; intro H;
+ discriminate H || (try (injection H; clear H; intro H)).
+rewrite (IHx y H); reflexivity.
+absurd (Psucc x = xH); [ apply Psucc_not_one | assumption ].
+apply f_equal with (1 := H); assumption.
+absurd (Psucc y = xH);
+ [ apply Psucc_not_one | symmetry in |- *; assumption ].
+reflexivity.
Qed.
(**********************************************************************)
@@ -290,605 +306,656 @@ Qed.
(** Specification of [Psucc] in term of [Pplus] *)
-Lemma ZL12: (q:positive) (add_un q) = (add q xH).
+Lemma Pplus_one_succ_r : forall p:positive, Psucc p = p + xH.
Proof.
-Intro q; NewDestruct q; Reflexivity.
+intro q; destruct q as [p| p| ]; reflexivity.
Qed.
-Lemma ZL12bis: (q:positive) (add_un q) = (add xH q).
+Lemma Pplus_one_succ_l : forall p:positive, Psucc p = xH + p.
Proof.
-Intro q; NewDestruct q; Reflexivity.
+intro q; destruct q as [p| p| ]; reflexivity.
Qed.
(** Specification of [Pplus_carry] *)
-Theorem ZL13: (x,y:positive)(add_carry x y) = (add_un (add x y)).
+Theorem Pplus_carry_spec :
+ forall p q:positive, Pplus_carry p q = Psucc (p + q).
Proof.
-(Intro x; NewInduction x as [p IHp|p IHp|];Intro y; NewDestruct y;Simpl;Auto);
- Rewrite IHp; Auto.
+intro x; induction x as [p IHp| p IHp| ]; intro y;
+ [ destruct y as [p0| p0| ]
+ | destruct y as [p0| p0| ]
+ | destruct y as [p| p| ] ]; simpl in |- *; auto; rewrite IHp;
+ auto.
Qed.
(** Commutativity *)
-Theorem add_sym : (x,y:positive) (add x y) = (add y x).
+Theorem Pplus_comm : forall p q:positive, p + q = q + p.
Proof.
-Intro x; NewInduction x as [p IHp|p IHp|];Intro y; NewDestruct y;Simpl;Auto;
- Try Do 2 Rewrite ZL13; Rewrite IHp;Auto.
+intro x; induction x as [p IHp| p IHp| ]; intro y;
+ [ destruct y as [p0| p0| ]
+ | destruct y as [p0| p0| ]
+ | destruct y as [p| p| ] ]; simpl in |- *; auto;
+ try do 2 rewrite Pplus_carry_spec; rewrite IHp; auto.
Qed.
(** Permutation of [Pplus] and [Psucc] *)
-Theorem ZL14: (x,y:positive)(add x (add_un y)) = (add_un (add x y)).
+Theorem Pplus_succ_permute_r :
+ forall p q:positive, p + Psucc q = Psucc (p + q).
Proof.
-Intro x; NewInduction x as [p IHp|p IHp|];Intro y; NewDestruct y;Simpl;Auto; [
- Rewrite ZL13; Rewrite IHp; Auto
-| Rewrite ZL13; Auto
-| NewDestruct p;Simpl;Auto
-| Rewrite IHp;Auto
-| NewDestruct p;Simpl;Auto ].
+intro x; induction x as [p IHp| p IHp| ]; intro y;
+ [ destruct y as [p0| p0| ]
+ | destruct y as [p0| p0| ]
+ | destruct y as [p| p| ] ]; simpl in |- *; auto;
+ [ rewrite Pplus_carry_spec; rewrite IHp; auto
+ | rewrite Pplus_carry_spec; auto
+ | destruct p; simpl in |- *; auto
+ | rewrite IHp; auto
+ | destruct p; simpl in |- *; auto ].
Qed.
-Theorem ZL14bis: (x,y:positive)(add (add_un x) y) = (add_un (add x y)).
+Theorem Pplus_succ_permute_l :
+ forall p q:positive, Psucc p + q = Psucc (p + q).
Proof.
-Intros x y; Rewrite add_sym; Rewrite add_sym with x:=x; Apply ZL14.
+intros x y; rewrite Pplus_comm; rewrite Pplus_comm with (p := x);
+ apply Pplus_succ_permute_r.
Qed.
-Theorem ZL15: (q,z:positive) ~z=xH -> (add_carry q (sub_un z)) = (add q z).
+Theorem Pplus_carry_pred_eq_plus :
+ forall p q:positive, q <> xH -> Pplus_carry p (Ppred q) = p + q.
Proof.
-Intros q z H; Elim (add_sub_one z); [
- Intro;Absurd z=xH;Auto
-| Intros E;Pattern 2 z ;Rewrite <- E; Rewrite ZL14; Rewrite ZL13; Trivial ].
+intros q z H; elim (Psucc_pred z);
+ [ intro; absurd (z = xH); auto
+ | intros E; pattern z at 2 in |- *; rewrite <- E;
+ rewrite Pplus_succ_permute_r; rewrite Pplus_carry_spec;
+ trivial ].
Qed.
(** No neutral for addition on strictly positive numbers *)
-Lemma add_no_neutral : (x,y:positive) ~(add y x)=x.
+Lemma Pplus_no_neutral : forall p q:positive, q + p <> p.
Proof.
-Intro x;NewInduction x; Intro y; NewDestruct y as [y|y|]; Simpl; Intro H;
- Discriminate H Orelse Injection H; Clear H; Intro H; Apply (IHx y H).
+intro x; induction x; intro y; destruct y as [y| y| ]; simpl in |- *; intro H;
+ discriminate H || injection H; clear H; intro H; apply (IHx y H).
Qed.
-Lemma add_carry_not_add_un : (x,y:positive) ~(add_carry y x)=(add_un x).
+Lemma Pplus_carry_no_neutral :
+ forall p q:positive, Pplus_carry q p <> Psucc p.
Proof.
-Intros x y H; Absurd (add y x)=x;
- [ Apply add_no_neutral
- | Apply add_un_inj; Rewrite <- ZL13; Assumption ].
+intros x y H; absurd (y + x = x);
+ [ apply Pplus_no_neutral
+ | apply Psucc_inj; rewrite <- Pplus_carry_spec; assumption ].
Qed.
(** Simplification *)
-Lemma add_carry_add :
- (x,y,z,t:positive) (add_carry x z)=(add_carry y t) -> (add x z)=(add y t).
+Lemma Pplus_carry_plus :
+ forall p q r s:positive, Pplus_carry p r = Pplus_carry q s -> p + r = q + s.
Proof.
-Intros x y z t H; Apply add_un_inj; Do 2 Rewrite <- ZL13; Assumption.
+intros x y z t H; apply Psucc_inj; do 2 rewrite <- Pplus_carry_spec;
+ assumption.
Qed.
-Lemma simpl_add_r : (x,y,z:positive) (add x z)=(add y z) -> x=y.
+Lemma Pplus_reg_r : forall p q r:positive, p + r = q + r -> p = q.
Proof.
-Intros x y z; Generalize x y; Clear x y.
-NewInduction z as [z|z|].
- NewDestruct x as [x|x|]; Intro y; NewDestruct y as [y|y|]; Simpl; Intro H;
- Discriminate H Orelse Try (Injection H; Clear H; Intro H).
- Rewrite IHz with 1:=(add_carry_add ? ? ? ? H); Reflexivity.
- Absurd (add_carry x z)=(add_un z);
- [ Apply add_carry_not_add_un | Assumption ].
- Rewrite IHz with 1:=H; Reflexivity.
- Symmetry in H; Absurd (add_carry y z)=(add_un z);
- [ Apply add_carry_not_add_un | Assumption ].
- Reflexivity.
- NewDestruct x as [x|x|]; Intro y; NewDestruct y as [y|y|]; Simpl; Intro H;
- Discriminate H Orelse Try (Injection H; Clear H; Intro H).
- Rewrite IHz with 1:=H; Reflexivity.
- Absurd (add x z)=z; [ Apply add_no_neutral | Assumption ].
- Rewrite IHz with 1:=H; Reflexivity.
- Symmetry in H; Absurd y+z=z; [ Apply add_no_neutral | Assumption ].
- Reflexivity.
- Intros H x y; Apply add_un_inj; Do 2 Rewrite ZL12; Assumption.
+intros x y z; generalize x y; clear x y.
+induction z as [z| z| ].
+ destruct x as [x| x| ]; intro y; destruct y as [y| y| ]; simpl in |- *;
+ intro H; discriminate H || (try (injection H; clear H; intro H)).
+ rewrite IHz with (1 := Pplus_carry_plus _ _ _ _ H); reflexivity.
+ absurd (Pplus_carry x z = Psucc z);
+ [ apply Pplus_carry_no_neutral | assumption ].
+ rewrite IHz with (1 := H); reflexivity.
+ symmetry in H; absurd (Pplus_carry y z = Psucc z);
+ [ apply Pplus_carry_no_neutral | assumption ].
+ reflexivity.
+ destruct x as [x| x| ]; intro y; destruct y as [y| y| ]; simpl in |- *;
+ intro H; discriminate H || (try (injection H; clear H; intro H)).
+ rewrite IHz with (1 := H); reflexivity.
+ absurd (x + z = z); [ apply Pplus_no_neutral | assumption ].
+ rewrite IHz with (1 := H); reflexivity.
+ symmetry in H; absurd (y + z = z);
+ [ apply Pplus_no_neutral | assumption ].
+ reflexivity.
+ intros H x y; apply Psucc_inj; do 2 rewrite Pplus_one_succ_r; assumption.
Qed.
-Lemma simpl_add_l : (x,y,z:positive) (add x y)=(add x z) -> y=z.
+Lemma Pplus_reg_l : forall p q r:positive, p + q = p + r -> q = r.
Proof.
-Intros x y z H;Apply simpl_add_r with z:=x;
- Rewrite add_sym with x:=z; Rewrite add_sym with x:=y; Assumption.
+intros x y z H; apply Pplus_reg_r with (r := x);
+ rewrite Pplus_comm with (p := z); rewrite Pplus_comm with (p := y);
+ assumption.
Qed.
-Lemma simpl_add_carry_r :
- (x,y,z:positive) (add_carry x z)=(add_carry y z) -> x=y.
+Lemma Pplus_carry_reg_r :
+ forall p q r:positive, Pplus_carry p r = Pplus_carry q r -> p = q.
Proof.
-Intros x y z H; Apply simpl_add_r with z:=z; Apply add_carry_add; Assumption.
+intros x y z H; apply Pplus_reg_r with (r := z); apply Pplus_carry_plus;
+ assumption.
Qed.
-Lemma simpl_add_carry_l :
- (x,y,z:positive) (add_carry x y)=(add_carry x z) -> y=z.
+Lemma Pplus_carry_reg_l :
+ forall p q r:positive, Pplus_carry p q = Pplus_carry p r -> q = r.
Proof.
-Intros x y z H;Apply simpl_add_r with z:=x;
-Rewrite add_sym with x:=z; Rewrite add_sym with x:=y; Apply add_carry_add;
-Assumption.
+intros x y z H; apply Pplus_reg_r with (r := x);
+ rewrite Pplus_comm with (p := z); rewrite Pplus_comm with (p := y);
+ apply Pplus_carry_plus; assumption.
Qed.
(** Addition on positive is associative *)
-Theorem add_assoc: (x,y,z:positive)(add x (add y z)) = (add (add x y) z).
-Proof.
-Intros x y; Generalize x; Clear x.
-NewInduction y as [y|y|]; Intro x.
- NewDestruct x as [x|x|];
- Intro z; NewDestruct z as [z|z|]; Simpl; Repeat Rewrite ZL13;
- Repeat Rewrite ZL14; Repeat Rewrite ZL14bis; Reflexivity Orelse
- Repeat Apply f_equal with A:=positive; Apply IHy.
- NewDestruct x as [x|x|];
- Intro z; NewDestruct z as [z|z|]; Simpl; Repeat Rewrite ZL13;
- Repeat Rewrite ZL14; Repeat Rewrite ZL14bis; Reflexivity Orelse
- Repeat Apply f_equal with A:=positive; Apply IHy.
- Intro z; Rewrite add_sym with x:=xH; Do 2 Rewrite <- ZL12; Rewrite ZL14bis; Rewrite ZL14; Reflexivity.
+Theorem Pplus_assoc : forall p q r:positive, p + (q + r) = p + q + r.
+Proof.
+intros x y; generalize x; clear x.
+induction y as [y| y| ]; intro x.
+ destruct x as [x| x| ]; intro z; destruct z as [z| z| ]; simpl in |- *;
+ repeat rewrite Pplus_carry_spec; repeat rewrite Pplus_succ_permute_r;
+ repeat rewrite Pplus_succ_permute_l;
+ reflexivity || (repeat apply f_equal with (A := positive));
+ apply IHy.
+ destruct x as [x| x| ]; intro z; destruct z as [z| z| ]; simpl in |- *;
+ repeat rewrite Pplus_carry_spec; repeat rewrite Pplus_succ_permute_r;
+ repeat rewrite Pplus_succ_permute_l;
+ reflexivity || (repeat apply f_equal with (A := positive));
+ apply IHy.
+ intro z; rewrite Pplus_comm with (p := xH);
+ do 2 rewrite <- Pplus_one_succ_r; rewrite Pplus_succ_permute_l;
+ rewrite Pplus_succ_permute_r; reflexivity.
Qed.
(** Commutation of addition with the double of a positive number *)
-Lemma add_xI_double_moins_un :
- (p,q:positive)(xO (add p q)) = (add (xI p) (double_moins_un q)).
+Lemma Pplus_xI_double_minus_one :
+ forall p q:positive, xO (p + q) = xI p + Pdouble_minus_one q.
Proof.
-Intros; Change (xI p) with (add (xO p) xH).
-Rewrite <- add_assoc; Rewrite <- ZL12bis; Rewrite is_double_moins_un.
-Reflexivity.
+intros; change (xI p) with (xO p + xH) in |- *.
+rewrite <- Pplus_assoc; rewrite <- Pplus_one_succ_l;
+ rewrite Psucc_o_double_minus_one_eq_xO.
+reflexivity.
Qed.
-Lemma add_xO_double_moins_un :
- (p,q:positive) (double_moins_un (add p q)) = (add (xO p) (double_moins_un q)).
+Lemma Pplus_xO_double_minus_one :
+ forall p q:positive, Pdouble_minus_one (p + q) = xO p + Pdouble_minus_one q.
Proof.
-NewInduction p as [p IHp|p IHp|]; NewDestruct q as [q|q|];
- Simpl; Try Rewrite ZL13; Try Rewrite double_moins_un_add_un_xI;
- Try Rewrite IHp; Try Rewrite add_xI_double_moins_un; Try Reflexivity.
- Rewrite <- is_double_moins_un; Rewrite ZL12bis; Reflexivity.
+induction p as [p IHp| p IHp| ]; destruct q as [q| q| ]; simpl in |- *;
+ try rewrite Pplus_carry_spec; try rewrite Pdouble_minus_one_o_succ_eq_xI;
+ try rewrite IHp; try rewrite Pplus_xI_double_minus_one;
+ try reflexivity.
+ rewrite <- Psucc_o_double_minus_one_eq_xO; rewrite Pplus_one_succ_l;
+ reflexivity.
Qed.
(** Misc *)
-Lemma add_x_x : (x:positive) (add x x) = (xO x).
+Lemma Pplus_diag : forall p:positive, p + p = xO p.
Proof.
-Intro x;NewInduction x; Simpl; Try Rewrite ZL13; Try Rewrite IHx; Reflexivity.
+intro x; induction x; simpl in |- *; try rewrite Pplus_carry_spec;
+ try rewrite IHx; reflexivity.
Qed.
(**********************************************************************)
(** Peano induction on binary positive positive numbers *)
-Fixpoint plus_iter [x:positive] : positive -> positive :=
- [y]Cases x of
- | xH => (add_un y)
- | (xO x) => (plus_iter x (plus_iter x y))
- | (xI x) => (plus_iter x (plus_iter x (add_un y)))
+Fixpoint plus_iter (x y:positive) {struct x} : positive :=
+ match x with
+ | xH => Psucc y
+ | xO x => plus_iter x (plus_iter x y)
+ | xI x => plus_iter x (plus_iter x (Psucc y))
end.
-Lemma plus_iter_add : (x,y:positive)(plus_iter x y)=(add x y).
+Lemma plus_iter_eq_plus : forall p q:positive, plus_iter p q = p + q.
Proof.
-Intro x;NewInduction x as [p IHp|p IHp|]; Intro y; NewDestruct y; Simpl;
- Reflexivity Orelse Do 2 Rewrite IHp; Rewrite add_assoc; Rewrite add_x_x;
- Try Reflexivity.
-Rewrite ZL13; Rewrite <- ZL14; Reflexivity.
-Rewrite ZL12; Reflexivity.
+intro x; induction x as [p IHp| p IHp| ]; intro y;
+ [ destruct y as [p0| p0| ]
+ | destruct y as [p0| p0| ]
+ | destruct y as [p| p| ] ]; simpl in |- *; reflexivity || (do 2 rewrite IHp);
+ rewrite Pplus_assoc; rewrite Pplus_diag; try reflexivity.
+rewrite Pplus_carry_spec; rewrite <- Pplus_succ_permute_r; reflexivity.
+rewrite Pplus_one_succ_r; reflexivity.
Qed.
-Lemma plus_iter_xO : (x:positive)(plus_iter x x)=(xO x).
+Lemma plus_iter_xO : forall p:positive, plus_iter p p = xO p.
Proof.
-Intro; Rewrite <- add_x_x; Apply plus_iter_add.
+intro; rewrite <- Pplus_diag; apply plus_iter_eq_plus.
Qed.
-Lemma plus_iter_xI : (x:positive)(add_un (plus_iter x x))=(xI x).
+Lemma plus_iter_xI : forall p:positive, Psucc (plus_iter p p) = xI p.
Proof.
-Intro; Rewrite xI_add_un_xO; Rewrite <- add_x_x;
- Apply (f_equal positive); Apply plus_iter_add.
+intro; rewrite xI_succ_xO; rewrite <- Pplus_diag;
+ apply (f_equal (A:=positive)); apply plus_iter_eq_plus.
Qed.
-Lemma iterate_add : (P:(positive->Type))
- ((n:positive)(P n) ->(P (add_un n)))->(p,n:positive)(P n) ->
- (P (plus_iter p n)).
+Lemma iterate_add :
+ forall P:positive -> Type,
+ (forall n:positive, P n -> P (Psucc n)) ->
+ forall p q:positive, P q -> P (plus_iter p q).
Proof.
-Intros P H; NewInduction p; Simpl; Intros.
-Apply IHp; Apply IHp; Apply H; Assumption.
-Apply IHp; Apply IHp; Assumption.
-Apply H; Assumption.
+intros P H; induction p; simpl in |- *; intros.
+apply IHp; apply IHp; apply H; assumption.
+apply IHp; apply IHp; assumption.
+apply H; assumption.
Defined.
(** Peano induction *)
-Theorem Pind : (P:(positive->Prop))
- (P xH) ->((n:positive)(P n) ->(P (add_un n))) ->(n:positive)(P n).
+Theorem Pind :
+ forall P:positive -> Prop,
+ P xH -> (forall n:positive, P n -> P (Psucc n)) -> forall p:positive, P p.
Proof.
-Intros P H1 Hsucc n; NewInduction n.
-Rewrite <- plus_iter_xI; Apply Hsucc; Apply iterate_add; Assumption.
-Rewrite <- plus_iter_xO; Apply iterate_add; Assumption.
-Assumption.
+intros P H1 Hsucc n; induction n.
+rewrite <- plus_iter_xI; apply Hsucc; apply iterate_add; assumption.
+rewrite <- plus_iter_xO; apply iterate_add; assumption.
+assumption.
Qed.
(** Peano recursion *)
-Definition Prec : (A:Set)A->(positive->A->A)->positive->A :=
- [A;a;f]Fix Prec { Prec [p:positive] : A :=
- Cases p of
- | xH => a
- | (xO p) => (iterate_add [_]A f p p (Prec p))
- | (xI p) => (f (plus_iter p p) (iterate_add [_]A f p p (Prec p)))
- end}.
+Definition Prec (A:Set) (a:A) (f:positive -> A -> A) :
+ positive -> A :=
+ (fix Prec (p:positive) : A :=
+ match p with
+ | xH => a
+ | xO p => iterate_add (fun _ => A) f p p (Prec p)
+ | xI p => f (plus_iter p p) (iterate_add (fun _ => A) f p p (Prec p))
+ end).
(** Peano case analysis *)
-Theorem Pcase : (P:(positive->Prop))
- (P xH) ->((n:positive)(P (add_un n))) ->(n:positive)(P n).
+Theorem Pcase :
+ forall P:positive -> Prop,
+ P xH -> (forall n:positive, P (Psucc n)) -> forall p:positive, P p.
Proof.
-Intros; Apply Pind; Auto.
+intros; apply Pind; auto.
Qed.
+(*
Check
- let fact = (Prec positive xH [p;r](times (add_un p) r)) in
- let seven = (xI (xI xH)) in
- let five_thousand_forty= (xO(xO(xO(xO(xI(xI(xO(xI(xI(xI(xO(xO xH))))))))))))
- in ((refl_equal ? ?) :: (fact seven) = five_thousand_forty).
+ (let fact := Prec positive xH (fun p r => Psucc p * r) in
+ let seven := xI (xI xH) in
+ let five_thousand_forty :=
+ xO (xO (xO (xO (xI (xI (xO (xI (xI (xI (xO (xO xH))))))))))) in
+ refl_equal _:fact seven = five_thousand_forty).
+*)
(**********************************************************************)
(** Properties of multiplication on binary positive numbers *)
(** One is right neutral for multiplication *)
-Lemma times_x_1 : (x:positive) (times x xH) = x.
+Lemma Pmult_1_r : forall p:positive, p * xH = p.
Proof.
-Intro x;NewInduction x; Simpl.
- Rewrite IHx; Reflexivity.
- Rewrite IHx; Reflexivity.
- Reflexivity.
+intro x; induction x; simpl in |- *.
+ rewrite IHx; reflexivity.
+ rewrite IHx; reflexivity.
+ reflexivity.
Qed.
(** Right reduction properties for multiplication *)
-Lemma times_x_double : (x,y:positive) (times x (xO y)) = (xO (times x y)).
+Lemma Pmult_xO_permute_r : forall p q:positive, p * xO q = xO (p * q).
Proof.
-Intros x y; NewInduction x; Simpl.
- Rewrite IHx; Reflexivity.
- Rewrite IHx; Reflexivity.
- Reflexivity.
+intros x y; induction x; simpl in |- *.
+ rewrite IHx; reflexivity.
+ rewrite IHx; reflexivity.
+ reflexivity.
Qed.
-Lemma times_x_double_plus_one :
- (x,y:positive) (times x (xI y)) = (add x (xO (times x y))).
+Lemma Pmult_xI_permute_r : forall p q:positive, p * xI q = p + xO (p * q).
Proof.
-Intros x y; NewInduction x; Simpl.
- Rewrite IHx; Do 2 Rewrite add_assoc; Rewrite add_sym with x:=y; Reflexivity.
- Rewrite IHx; Reflexivity.
- Reflexivity.
+intros x y; induction x; simpl in |- *.
+ rewrite IHx; do 2 rewrite Pplus_assoc; rewrite Pplus_comm with (p := y);
+ reflexivity.
+ rewrite IHx; reflexivity.
+ reflexivity.
Qed.
(** Commutativity of multiplication *)
-Theorem times_sym : (x,y:positive) (times x y) = (times y x).
+Theorem Pmult_comm : forall p q:positive, p * q = q * p.
Proof.
-Intros x y; NewInduction y; Simpl.
- Rewrite <- IHy; Apply times_x_double_plus_one.
- Rewrite <- IHy; Apply times_x_double.
- Apply times_x_1.
+intros x y; induction y; simpl in |- *.
+ rewrite <- IHy; apply Pmult_xI_permute_r.
+ rewrite <- IHy; apply Pmult_xO_permute_r.
+ apply Pmult_1_r.
Qed.
(** Distributivity of multiplication over addition *)
-Theorem times_add_distr:
- (x,y,z:positive) (times x (add y z)) = (add (times x y) (times x z)).
+Theorem Pmult_plus_distr_l :
+ forall p q r:positive, p * (q + r) = p * q + p * r.
Proof.
-Intros x y z; NewInduction x; Simpl.
- Rewrite IHx; Rewrite <- add_assoc with y := (xO (times x y));
- Rewrite -> add_assoc with x := (xO (times x y));
- Rewrite -> add_sym with x := (xO (times x y));
- Rewrite <- add_assoc with y := (xO (times x y));
- Rewrite -> add_assoc with y := z; Reflexivity.
- Rewrite IHx; Reflexivity.
- Reflexivity.
+intros x y z; induction x; simpl in |- *.
+ rewrite IHx; rewrite <- Pplus_assoc with (q := xO (x * y));
+ rewrite Pplus_assoc with (p := xO (x * y));
+ rewrite Pplus_comm with (p := xO (x * y));
+ rewrite <- Pplus_assoc with (q := xO (x * y));
+ rewrite Pplus_assoc with (q := z); reflexivity.
+ rewrite IHx; reflexivity.
+ reflexivity.
Qed.
-Theorem times_add_distr_l:
- (x,y,z:positive) (times (add x y) z) = (add (times x z) (times y z)).
+Theorem Pmult_plus_distr_r :
+ forall p q r:positive, (p + q) * r = p * r + q * r.
Proof.
-Intros x y z; Do 3 Rewrite times_sym with y:=z; Apply times_add_distr.
+intros x y z; do 3 rewrite Pmult_comm with (q := z); apply Pmult_plus_distr_l.
Qed.
(** Associativity of multiplication *)
-Theorem times_assoc :
- ((x,y,z:positive) (times x (times y z))= (times (times x y) z)).
+Theorem Pmult_assoc : forall p q r:positive, p * (q * r) = p * q * r.
Proof.
-Intro x;NewInduction x as [x|x|]; Simpl; Intros y z.
- Rewrite IHx; Rewrite times_add_distr_l; Reflexivity.
- Rewrite IHx; Reflexivity.
- Reflexivity.
+intro x; induction x as [x| x| ]; simpl in |- *; intros y z.
+ rewrite IHx; rewrite Pmult_plus_distr_r; reflexivity.
+ rewrite IHx; reflexivity.
+ reflexivity.
Qed.
(** Parity properties of multiplication *)
-Lemma times_discr_xO_xI :
- (x,y,z:positive)(times (xI x) z)<>(times (xO y) z).
+Lemma Pmult_xI_mult_xO_discr : forall p q r:positive, xI p * r <> xO q * r.
Proof.
-Intros x y z; NewInduction z as [|z IHz|]; Try Discriminate.
-Intro H; Apply IHz; Clear IHz.
-Do 2 Rewrite times_x_double in H.
-Injection H; Clear H; Intro H; Exact H.
+intros x y z; induction z as [| z IHz| ]; try discriminate.
+intro H; apply IHz; clear IHz.
+do 2 rewrite Pmult_xO_permute_r in H.
+injection H; clear H; intro H; exact H.
Qed.
-Lemma times_discr_xO : (x,y:positive)(times (xO x) y)<>y.
+Lemma Pmult_xO_discr : forall p q:positive, xO p * q <> q.
Proof.
-Intros x y; NewInduction y; Try Discriminate.
-Rewrite times_x_double; Injection; Assumption.
+intros x y; induction y; try discriminate.
+rewrite Pmult_xO_permute_r; injection; assumption.
Qed.
(** Simplification properties of multiplication *)
-Theorem simpl_times_r : (x,y,z:positive) (times x z)=(times y z) -> x=y.
+Theorem Pmult_reg_r : forall p q r:positive, p * r = q * r -> p = q.
Proof.
-Intro x;NewInduction x as [p IHp|p IHp|]; Intro y; NewDestruct y as [q|q|]; Intros z H;
- Reflexivity Orelse Apply (f_equal positive) Orelse Apply False_ind.
- Simpl in H; Apply IHp with (xO z); Simpl; Do 2 Rewrite times_x_double;
- Apply simpl_add_l with 1 := H.
- Apply times_discr_xO_xI with 1 := H.
- Simpl in H; Rewrite add_sym in H; Apply add_no_neutral with 1 := H.
- Symmetry in H; Apply times_discr_xO_xI with 1 := H.
- Apply IHp with (xO z); Simpl; Do 2 Rewrite times_x_double; Assumption.
- Apply times_discr_xO with 1:=H.
- Simpl in H; Symmetry in H; Rewrite add_sym in H;
- Apply add_no_neutral with 1 := H.
- Symmetry in H; Apply times_discr_xO with 1:=H.
+intro x; induction x as [p IHp| p IHp| ]; intro y; destruct y as [q| q| ];
+ intros z H; reflexivity || apply (f_equal (A:=positive)) || apply False_ind.
+ simpl in H; apply IHp with (xO z); simpl in |- *;
+ do 2 rewrite Pmult_xO_permute_r; apply Pplus_reg_l with (1 := H).
+ apply Pmult_xI_mult_xO_discr with (1 := H).
+ simpl in H; rewrite Pplus_comm in H; apply Pplus_no_neutral with (1 := H).
+ symmetry in H; apply Pmult_xI_mult_xO_discr with (1 := H).
+ apply IHp with (xO z); simpl in |- *; do 2 rewrite Pmult_xO_permute_r;
+ assumption.
+ apply Pmult_xO_discr with (1 := H).
+ simpl in H; symmetry in H; rewrite Pplus_comm in H;
+ apply Pplus_no_neutral with (1 := H).
+ symmetry in H; apply Pmult_xO_discr with (1 := H).
Qed.
-Theorem simpl_times_l : (x,y,z:positive) (times z x)=(times z y) -> x=y.
+Theorem Pmult_reg_l : forall p q r:positive, r * p = r * q -> p = q.
Proof.
-Intros x y z H; Apply simpl_times_r with z:=z.
-Rewrite times_sym with x:=x; Rewrite times_sym with x:=y; Assumption.
+intros x y z H; apply Pmult_reg_r with (r := z).
+rewrite Pmult_comm with (p := x); rewrite Pmult_comm with (p := y);
+ assumption.
Qed.
(** Inversion of multiplication *)
-Lemma times_one_inversion_l : (x,y:positive) (times x y)=xH -> x=xH.
+Lemma Pmult_1_inversion_l : forall p q:positive, p * q = xH -> p = xH.
Proof.
-Intros x y; NewDestruct x; Simpl.
- NewDestruct y; Intro; Discriminate.
- Intro; Discriminate.
- Reflexivity.
+intros x y; destruct x as [p| p| ]; simpl in |- *.
+ destruct y as [p0| p0| ]; intro; discriminate.
+ intro; discriminate.
+ reflexivity.
Qed.
(**********************************************************************)
(** Properties of comparison on binary positive numbers *)
-Theorem compare_convert1 :
- (x,y:positive)
- ~(compare x y SUPERIEUR) = EGAL /\ ~(compare x y INFERIEUR) = EGAL.
+Theorem Pcompare_not_Eq :
+ forall p q:positive, (p ?= q) Gt <> Eq /\ (p ?= q) Lt <> Eq.
Proof.
-Intro x; NewInduction x as [p IHp|p IHp|]; Intro y; NewDestruct y as [q|q|];
- Split;Simpl;Auto;
- Discriminate Orelse (Elim (IHp q); Auto).
+intro x; induction x as [p IHp| p IHp| ]; intro y; destruct y as [q| q| ];
+ split; simpl in |- *; auto; discriminate || (elim (IHp q); auto).
Qed.
-Theorem compare_convert_EGAL : (x,y:positive) (compare x y EGAL) = EGAL -> x=y.
+Theorem Pcompare_Eq_eq : forall p q:positive, (p ?= q) Eq = Eq -> p = q.
Proof.
-Intro x; NewInduction x as [p IHp|p IHp|];
- Intro y; NewDestruct y as [q|q|];Simpl;Auto; Intro H; [
- Rewrite (IHp q); Trivial
-| Absurd (compare p q SUPERIEUR)=EGAL ;
- [ Elim (compare_convert1 p q);Auto | Assumption ]
-| Discriminate H
-| Absurd (compare p q INFERIEUR) = EGAL;
- [ Elim (compare_convert1 p q);Auto | Assumption ]
-| Rewrite (IHp q);Auto
-| Discriminate H
-| Discriminate H
-| Discriminate H ].
+intro x; induction x as [p IHp| p IHp| ]; intro y; destruct y as [q| q| ];
+ simpl in |- *; auto; intro H;
+ [ rewrite (IHp q); trivial
+ | absurd ((p ?= q) Gt = Eq);
+ [ elim (Pcompare_not_Eq p q); auto | assumption ]
+ | discriminate H
+ | absurd ((p ?= q) Lt = Eq);
+ [ elim (Pcompare_not_Eq p q); auto | assumption ]
+ | rewrite (IHp q); auto
+ | discriminate H
+ | discriminate H
+ | discriminate H ].
Qed.
-Lemma ZLSI:
- (x,y:positive) (compare x y SUPERIEUR) = INFERIEUR ->
- (compare x y EGAL) = INFERIEUR.
+Lemma Pcompare_Gt_Lt :
+ forall p q:positive, (p ?= q) Gt = Lt -> (p ?= q) Eq = Lt.
Proof.
-Intro x; Induction x;Intro y; Induction y;Simpl;Auto;
- Discriminate Orelse Intros H;Discriminate H.
+intro x; induction x as [x Hrecx| x Hrecx| ]; intro y;
+ [ induction y as [y Hrecy| y Hrecy| ]
+ | induction y as [y Hrecy| y Hrecy| ]
+ | induction y as [y Hrecy| y Hrecy| ] ]; simpl in |- *;
+ auto; discriminate || intros H; discriminate H.
Qed.
-Lemma ZLIS:
- (x,y:positive) (compare x y INFERIEUR) = SUPERIEUR ->
- (compare x y EGAL) = SUPERIEUR.
+Lemma Pcompare_Lt_Gt :
+ forall p q:positive, (p ?= q) Lt = Gt -> (p ?= q) Eq = Gt.
Proof.
-Intro x; Induction x;Intro y; Induction y;Simpl;Auto;
- Discriminate Orelse Intros H;Discriminate H.
+intro x; induction x as [x Hrecx| x Hrecx| ]; intro y;
+ [ induction y as [y Hrecy| y Hrecy| ]
+ | induction y as [y Hrecy| y Hrecy| ]
+ | induction y as [y Hrecy| y Hrecy| ] ]; simpl in |- *;
+ auto; discriminate || intros H; discriminate H.
Qed.
-Lemma ZLII:
- (x,y:positive) (compare x y INFERIEUR) = INFERIEUR ->
- (compare x y EGAL) = INFERIEUR \/ x = y.
+Lemma Pcompare_Lt_Lt :
+ forall p q:positive, (p ?= q) Lt = Lt -> (p ?= q) Eq = Lt \/ p = q.
Proof.
-(Intro x; NewInduction x as [p IHp|p IHp|];
- Intro y; NewDestruct y as [q|q|];Simpl;Auto;Try Discriminate);
- Intro H2; Elim (IHp q H2);Auto; Intros E;Rewrite E;
- Auto.
+intro x; induction x as [p IHp| p IHp| ]; intro y; destruct y as [q| q| ];
+ simpl in |- *; auto; try discriminate; intro H2; elim (IHp q H2);
+ auto; intros E; rewrite E; auto.
Qed.
-Lemma ZLSS:
- (x,y:positive) (compare x y SUPERIEUR) = SUPERIEUR ->
- (compare x y EGAL) = SUPERIEUR \/ x = y.
+Lemma Pcompare_Gt_Gt :
+ forall p q:positive, (p ?= q) Gt = Gt -> (p ?= q) Eq = Gt \/ p = q.
Proof.
-(Intro x; NewInduction x as [p IHp|p IHp|];
- Intro y; NewDestruct y as [q|q|];Simpl;Auto;Try Discriminate);
- Intro H2; Elim (IHp q H2);Auto; Intros E;Rewrite E;
- Auto.
+intro x; induction x as [p IHp| p IHp| ]; intro y; destruct y as [q| q| ];
+ simpl in |- *; auto; try discriminate; intro H2; elim (IHp q H2);
+ auto; intros E; rewrite E; auto.
Qed.
-Lemma Dcompare : (r:relation) r=EGAL \/ r = INFERIEUR \/ r = SUPERIEUR.
+Lemma Dcompare : forall r:comparison, r = Eq \/ r = Lt \/ r = Gt.
Proof.
-Induction r; Auto.
+simple induction r; auto.
Qed.
-Tactic Definition ElimPcompare c1 c2:=
- Elim (Dcompare (compare c1 c2 EGAL)); [ Idtac |
- Let x = FreshId "H" In Intro x; Case x; Clear x ].
+Ltac ElimPcompare c1 c2 :=
+ elim (Dcompare ((c1 ?= c2) Eq));
+ [ idtac | let x := fresh "H" in
+ (intro x; case x; clear x) ].
-Theorem convert_compare_EGAL: (x:positive)(compare x x EGAL)=EGAL.
-Intro x; Induction x; Auto.
+Theorem Pcompare_refl : forall p:positive, (p ?= p) Eq = Eq.
+intro x; induction x as [x Hrecx| x Hrecx| ]; auto.
Qed.
Lemma Pcompare_antisym :
- (x,y:positive)(r:relation) (Op (compare x y r)) = (compare y x (Op r)).
+ forall (p q:positive) (r:comparison),
+ CompOpp ((p ?= q) r) = (q ?= p) (CompOpp r).
Proof.
-Intro x; NewInduction x as [p IHp|p IHp|]; Intro y; NewDestruct y;
-Intro r; Reflexivity Orelse (Symmetry; Assumption) Orelse Discriminate H
-Orelse Simpl; Apply IHp Orelse Try Rewrite IHp; Try Reflexivity.
+intro x; induction x as [p IHp| p IHp| ]; intro y;
+ [ destruct y as [p0| p0| ]
+ | destruct y as [p0| p0| ]
+ | destruct y as [p| p| ] ]; intro r;
+ reflexivity ||
+ (symmetry in |- *; assumption) || discriminate H || simpl in |- *;
+ apply IHp || (try rewrite IHp); try reflexivity.
Qed.
-Lemma ZC1:
- (x,y:positive)(compare x y EGAL)=SUPERIEUR -> (compare y x EGAL)=INFERIEUR.
+Lemma ZC1 : forall p q:positive, (p ?= q) Eq = Gt -> (q ?= p) Eq = Lt.
Proof.
-Intros; Change EGAL with (Op EGAL).
-Rewrite <- Pcompare_antisym; Rewrite H; Reflexivity.
+intros; change Eq with (CompOpp Eq) in |- *.
+rewrite <- Pcompare_antisym; rewrite H; reflexivity.
Qed.
-Lemma ZC2:
- (x,y:positive)(compare x y EGAL)=INFERIEUR -> (compare y x EGAL)=SUPERIEUR.
+Lemma ZC2 : forall p q:positive, (p ?= q) Eq = Lt -> (q ?= p) Eq = Gt.
Proof.
-Intros; Change EGAL with (Op EGAL).
-Rewrite <- Pcompare_antisym; Rewrite H; Reflexivity.
+intros; change Eq with (CompOpp Eq) in |- *.
+rewrite <- Pcompare_antisym; rewrite H; reflexivity.
Qed.
-Lemma ZC3: (x,y:positive)(compare x y EGAL)=EGAL -> (compare y x EGAL)=EGAL.
+Lemma ZC3 : forall p q:positive, (p ?= q) Eq = Eq -> (q ?= p) Eq = Eq.
Proof.
-Intros; Change EGAL with (Op EGAL).
-Rewrite <- Pcompare_antisym; Rewrite H; Reflexivity.
+intros; change Eq with (CompOpp Eq) in |- *.
+rewrite <- Pcompare_antisym; rewrite H; reflexivity.
Qed.
-Lemma ZC4: (x,y:positive) (compare x y EGAL) = (Op (compare y x EGAL)).
+Lemma ZC4 : forall p q:positive, (p ?= q) Eq = CompOpp ((q ?= p) Eq).
Proof.
-Intros; Change 1 EGAL with (Op EGAL).
-Symmetry; Apply Pcompare_antisym.
+intros; change Eq at 1 with (CompOpp Eq) in |- *.
+symmetry in |- *; apply Pcompare_antisym.
Qed.
(**********************************************************************)
(** Properties of subtraction on binary positive numbers *)
-Lemma ZS: (p:positive_mask) (Zero_suivi_de_mask p) = IsNul -> p = IsNul.
+Lemma double_eq_zero_inversion :
+ forall p:positive_mask, Pdouble_mask p = IsNul -> p = IsNul.
Proof.
-NewDestruct p; Simpl; [ Trivial | Discriminate 1 | Discriminate 1 ].
+destruct p; simpl in |- *; [ trivial | discriminate 1 | discriminate 1 ].
Qed.
-Lemma US: (p:positive_mask) ~(Un_suivi_de_mask p)=IsNul.
+Lemma double_plus_one_zero_discr :
+ forall p:positive_mask, Pdouble_plus_one_mask p <> IsNul.
Proof.
-Induction p; Intros; Discriminate.
+simple induction p; intros; discriminate.
Qed.
-Lemma USH: (p:positive_mask) (Un_suivi_de_mask p) = (IsPos xH) -> p = IsNul.
+Lemma double_plus_one_eq_one_inversion :
+ forall p:positive_mask, Pdouble_plus_one_mask p = IsPos xH -> p = IsNul.
Proof.
-NewDestruct p; Simpl; [ Trivial | Discriminate 1 | Discriminate 1 ].
+destruct p; simpl in |- *; [ trivial | discriminate 1 | discriminate 1 ].
Qed.
-Lemma ZSH: (p:positive_mask) ~(Zero_suivi_de_mask p)= (IsPos xH).
+Lemma double_eq_one_discr :
+ forall p:positive_mask, Pdouble_mask p <> IsPos xH.
Proof.
-Induction p; Intros; Discriminate.
+simple induction p; intros; discriminate.
Qed.
-Theorem sub_pos_x_x : (x:positive) (sub_pos x x) = IsNul.
+Theorem Pminus_mask_diag : forall p:positive, Pminus_mask p p = IsNul.
Proof.
-Intro x; NewInduction x as [p IHp|p IHp|]; [
- Simpl; Rewrite IHp;Simpl; Trivial
-| Simpl; Rewrite IHp;Auto
-| Auto ].
+intro x; induction x as [p IHp| p IHp| ];
+ [ simpl in |- *; rewrite IHp; simpl in |- *; trivial
+ | simpl in |- *; rewrite IHp; auto
+ | auto ].
Qed.
-Lemma ZL10: (x,y:positive)
- (sub_pos x y) = (IsPos xH) -> (sub_neg x y) = IsNul.
+Lemma ZL10 :
+ forall p q:positive,
+ Pminus_mask p q = IsPos xH -> Pminus_mask_carry p q = IsNul.
Proof.
-Intro x; NewInduction x as [p|p|]; Intro y; NewDestruct y as [q|q|]; Simpl;
- Intro H; Try Discriminate H; [
- Absurd (Zero_suivi_de_mask (sub_pos p q))=(IsPos xH);
- [ Apply ZSH | Assumption ]
-| Assert Heq : (sub_pos p q)=IsNul;
- [ Apply USH;Assumption | Rewrite Heq; Reflexivity ]
-| Assert Heq : (sub_neg p q)=IsNul;
- [ Apply USH;Assumption | Rewrite Heq; Reflexivity ]
-| Absurd (Zero_suivi_de_mask (sub_pos p q))=(IsPos xH);
- [ Apply ZSH | Assumption ]
-| NewDestruct p; Simpl; [ Discriminate H | Discriminate H | Reflexivity ] ].
+intro x; induction x as [p| p| ]; intro y; destruct y as [q| q| ];
+ simpl in |- *; intro H; try discriminate H;
+ [ absurd (Pdouble_mask (Pminus_mask p q) = IsPos xH);
+ [ apply double_eq_one_discr | assumption ]
+ | assert (Heq : Pminus_mask p q = IsNul);
+ [ apply double_plus_one_eq_one_inversion; assumption
+ | rewrite Heq; reflexivity ]
+ | assert (Heq : Pminus_mask_carry p q = IsNul);
+ [ apply double_plus_one_eq_one_inversion; assumption
+ | rewrite Heq; reflexivity ]
+ | absurd (Pdouble_mask (Pminus_mask p q) = IsPos xH);
+ [ apply double_eq_one_discr | assumption ]
+ | destruct p; simpl in |- *;
+ [ discriminate H | discriminate H | reflexivity ] ].
Qed.
(** Properties of subtraction valid only for x>y *)
-Lemma sub_pos_SUPERIEUR:
- (x,y:positive)(compare x y EGAL)=SUPERIEUR ->
- (EX h:positive | (sub_pos x y) = (IsPos h) /\ (add y h) = x /\
- (h = xH \/ (sub_neg x y) = (IsPos (sub_un h)))).
-Proof.
-Intro x;NewInduction x as [p|p|];Intro y; NewDestruct y as [q|q|]; Simpl; Intro H;
- Try Discriminate H.
- NewDestruct (IHp q H) as [z [H4 [H6 H7]]]; Exists (xO z); Split.
- Rewrite H4; Reflexivity.
- Split.
- Simpl; Rewrite H6; Reflexivity.
- Right; Clear H6; NewDestruct (ZL11 z) as [H8|H8]; [
- Rewrite H8; Rewrite H8 in H4;
- Rewrite ZL10; [ Reflexivity | Assumption ]
- | Clear H4; NewDestruct H7 as [H9|H9]; [
- Absurd z=xH; Assumption
- | Rewrite H9; Clear H9; NewDestruct z;
- [ Reflexivity | Reflexivity | Absurd xH=xH; Trivial ]]].
- Case ZLSS with 1:=H; [
- Intros H3;Elim (IHp q H3); Intros z H4; Exists (xI z);
- Elim H4;Intros H5 H6;Elim H6;Intros H7 H8; Split; [
- Simpl;Rewrite H5;Auto
- | Split; [
- Simpl; Rewrite H7; Trivial
- | Right;
- Change (Zero_suivi_de_mask (sub_pos p q))=(IsPos (sub_un (xI z)));
- Rewrite H5; Auto ]]
- | Intros H3; Exists xH; Rewrite H3; Split; [
- Simpl; Rewrite sub_pos_x_x; Auto
- | Split; Auto ]].
- Exists (xO p); Auto.
- NewDestruct (IHp q) as [z [H4 [H6 H7]]].
- Apply ZLIS; Assumption.
- NewDestruct (ZL11 z) as [vZ|]; [
- Exists xH; Split; [
- Rewrite ZL10; [ Reflexivity | Rewrite vZ in H4;Assumption ]
- | Split; [
- Simpl; Rewrite ZL12; Rewrite <- vZ; Rewrite H6; Trivial
- | Auto ]]
- | Exists (xI (sub_un z)); NewDestruct H7 as [|H8];[
- Absurd z=xH;Assumption
- | Split; [
- Rewrite H8; Trivial
- | Split; [ Simpl; Rewrite ZL15; [
- Rewrite H6;Trivial
- | Assumption ]
- | Right; Rewrite H8; Reflexivity]]]].
- NewDestruct (IHp q H) as [z [H4 [H6 H7]]].
- Exists (xO z); Split; [
- Rewrite H4;Auto
- | Split; [
- Simpl;Rewrite H6;Reflexivity
- | Right;
- Change (Un_suivi_de_mask (sub_neg p q))=(IsPos (double_moins_un z));
- NewDestruct (ZL11 z) as [H8|H8]; [
- Rewrite H8; Simpl;
- Assert H9:(sub_neg p q)=IsNul;[
- Apply ZL10;Rewrite <- H8;Assumption
- | Rewrite H9;Reflexivity ]
- | NewDestruct H7 as [H9|H9]; [
- Absurd z=xH;Auto
- | Rewrite H9; NewDestruct z; Simpl;
- [ Reflexivity
- | Reflexivity
- | Absurd xH=xH; [Assumption | Reflexivity]]]]]].
- Exists (double_moins_un p); Split; [
- Reflexivity
- | Clear IHp; Split; [
- NewDestruct p; Simpl; [
- Reflexivity
- | Rewrite is_double_moins_un; Reflexivity
- | Reflexivity ]
- | NewDestruct p; [Right|Right|Left]; Reflexivity ]].
-Qed.
-
-Theorem sub_add:
-(x,y:positive) (compare x y EGAL) = SUPERIEUR -> (add y (true_sub x y)) = x.
-Proof.
-Intros x y H;Elim sub_pos_SUPERIEUR with 1:=H;
-Intros z H1;Elim H1;Intros H2 H3; Elim H3;Intros H4 H5;
-Unfold true_sub ;Rewrite H2; Exact H4.
+Lemma Pminus_mask_Gt :
+ forall p q:positive,
+ (p ?= q) Eq = Gt ->
+ exists h : positive
+ | Pminus_mask p q = IsPos h /\
+ q + h = p /\ (h = xH \/ Pminus_mask_carry p q = IsPos (Ppred h)).
+Proof.
+intro x; induction x as [p| p| ]; intro y; destruct y as [q| q| ];
+ simpl in |- *; intro H; try discriminate H.
+ destruct (IHp q H) as [z [H4 [H6 H7]]]; exists (xO z); split.
+ rewrite H4; reflexivity.
+ split.
+ simpl in |- *; rewrite H6; reflexivity.
+ right; clear H6; destruct (ZL11 z) as [H8| H8];
+ [ rewrite H8; rewrite H8 in H4; rewrite ZL10;
+ [ reflexivity | assumption ]
+ | clear H4; destruct H7 as [H9| H9];
+ [ absurd (z = xH); assumption
+ | rewrite H9; clear H9; destruct z as [p0| p0| ];
+ [ reflexivity | reflexivity | absurd (xH = xH); trivial ] ] ].
+ case Pcompare_Gt_Gt with (1 := H);
+ [ intros H3; elim (IHp q H3); intros z H4; exists (xI z); elim H4;
+ intros H5 H6; elim H6; intros H7 H8; split;
+ [ simpl in |- *; rewrite H5; auto
+ | split;
+ [ simpl in |- *; rewrite H7; trivial
+ | right;
+ change (Pdouble_mask (Pminus_mask p q) = IsPos (Ppred (xI z)))
+ in |- *; rewrite H5; auto ] ]
+ | intros H3; exists xH; rewrite H3; split;
+ [ simpl in |- *; rewrite Pminus_mask_diag; auto | split; auto ] ].
+ exists (xO p); auto.
+ destruct (IHp q) as [z [H4 [H6 H7]]].
+ apply Pcompare_Lt_Gt; assumption.
+ destruct (ZL11 z) as [vZ| ];
+ [ exists xH; split;
+ [ rewrite ZL10; [ reflexivity | rewrite vZ in H4; assumption ]
+ | split;
+ [ simpl in |- *; rewrite Pplus_one_succ_r; rewrite <- vZ;
+ rewrite H6; trivial
+ | auto ] ]
+ | exists (xI (Ppred z)); destruct H7 as [| H8];
+ [ absurd (z = xH); assumption
+ | split;
+ [ rewrite H8; trivial
+ | split;
+ [ simpl in |- *; rewrite Pplus_carry_pred_eq_plus;
+ [ rewrite H6; trivial | assumption ]
+ | right; rewrite H8; reflexivity ] ] ] ].
+ destruct (IHp q H) as [z [H4 [H6 H7]]].
+ exists (xO z); split;
+ [ rewrite H4; auto
+ | split;
+ [ simpl in |- *; rewrite H6; reflexivity
+ | right;
+ change
+ (Pdouble_plus_one_mask (Pminus_mask_carry p q) =
+ IsPos (Pdouble_minus_one z)) in |- *;
+ destruct (ZL11 z) as [H8| H8];
+ [ rewrite H8; simpl in |- *;
+ assert (H9 : Pminus_mask_carry p q = IsNul);
+ [ apply ZL10; rewrite <- H8; assumption
+ | rewrite H9; reflexivity ]
+ | destruct H7 as [H9| H9];
+ [ absurd (z = xH); auto
+ | rewrite H9; destruct z as [p0| p0| ]; simpl in |- *;
+ [ reflexivity
+ | reflexivity
+ | absurd (xH = xH); [ assumption | reflexivity ] ] ] ] ] ].
+ exists (Pdouble_minus_one p); split;
+ [ reflexivity
+ | clear IHp; split;
+ [ destruct p; simpl in |- *;
+ [ reflexivity
+ | rewrite Psucc_o_double_minus_one_eq_xO; reflexivity
+ | reflexivity ]
+ | destruct p; [ right | right | left ]; reflexivity ] ].
+Qed.
+
+Theorem Pplus_minus :
+ forall p q:positive, (p ?= q) Eq = Gt -> q + (p - q) = p.
+Proof.
+intros x y H; elim Pminus_mask_Gt with (1 := H); intros z H1; elim H1;
+ intros H2 H3; elim H3; intros H4 H5; unfold Pminus in |- *;
+ rewrite H2; exact H4.
Qed.
-
diff --git a/theories/NArith/NArith.v b/theories/NArith/NArith.v
index e3392de4c..5e5ab1f0d 100644
--- a/theories/NArith/NArith.v
+++ b/theories/NArith/NArith.v
@@ -11,4 +11,4 @@
(** Library for binary natural numbers *)
Require Export BinPos.
-Require Export BinNat.
+Require Export BinNat. \ No newline at end of file
diff --git a/theories/NArith/Pnat.v b/theories/NArith/Pnat.v
index 22c6b5cb9..c0e2bb020 100644
--- a/theories/NArith/Pnat.v
+++ b/theories/NArith/Pnat.v
@@ -8,7 +8,7 @@
(*i $Id$ i*)
-Require BinPos.
+Require Import BinPos.
(**********************************************************************)
(** Properties of the injection from binary positive numbers to Peano
@@ -16,144 +16,142 @@ Require BinPos.
(** Original development by Pierre Crégut, CNET, Lannion, France *)
-Require Le.
-Require Lt.
-Require Gt.
-Require Plus.
-Require Mult.
-Require Minus.
+Require Import Le.
+Require Import Lt.
+Require Import Gt.
+Require Import Plus.
+Require Import Mult.
+Require Import Minus.
(** [nat_of_P] is a morphism for addition *)
-Lemma convert_add_un :
- (x:positive)(m:nat)
- (positive_to_nat (add_un x) m) = (plus m (positive_to_nat x m)).
+Lemma Pmult_nat_succ_morphism :
+ forall (p:positive) (n:nat), Pmult_nat (Psucc p) n = n + Pmult_nat p n.
Proof.
-Intro x; NewInduction x as [p IHp|p IHp|]; Simpl; Auto; Intro m; Rewrite IHp;
-Rewrite plus_assoc_l; Trivial.
+intro x; induction x as [p IHp| p IHp| ]; simpl in |- *; auto; intro m;
+ rewrite IHp; rewrite plus_assoc; trivial.
Qed.
-Lemma cvt_add_un :
- (p:positive) (convert (add_un p)) = (S (convert p)).
+Lemma nat_of_P_succ_morphism :
+ forall p:positive, nat_of_P (Psucc p) = S (nat_of_P p).
Proof.
- Intro; Change (S (convert p)) with (plus (S O) (convert p));
- Unfold convert; Apply convert_add_un.
+ intro; change (S (nat_of_P p)) with (1 + nat_of_P p) in |- *;
+ unfold nat_of_P in |- *; apply Pmult_nat_succ_morphism.
Qed.
-Theorem convert_add_carry :
- (x,y:positive)(m:nat)
- (positive_to_nat (add_carry x y) m) =
- (plus m (positive_to_nat (add x y) m)).
+Theorem Pmult_nat_plus_carry_morphism :
+ forall (p q:positive) (n:nat),
+ Pmult_nat (Pplus_carry p q) n = n + Pmult_nat (p + q) n.
Proof.
-Intro x; NewInduction x as [p IHp|p IHp|];
- Intro y; NewDestruct y; Simpl; Auto with arith; Intro m; [
- Rewrite IHp; Rewrite plus_assoc_l; Trivial with arith
-| Rewrite IHp; Rewrite plus_assoc_l; Trivial with arith
-| Rewrite convert_add_un; Rewrite plus_assoc_l; Trivial with arith
-| Rewrite convert_add_un; Apply plus_assoc_r ].
+intro x; induction x as [p IHp| p IHp| ]; intro y;
+ [ destruct y as [p0| p0| ]
+ | destruct y as [p0| p0| ]
+ | destruct y as [p| p| ] ]; simpl in |- *; auto with arith;
+ intro m;
+ [ rewrite IHp; rewrite plus_assoc; trivial with arith
+ | rewrite IHp; rewrite plus_assoc; trivial with arith
+ | rewrite Pmult_nat_succ_morphism; rewrite plus_assoc; trivial with arith
+ | rewrite Pmult_nat_succ_morphism; apply plus_assoc_reverse ].
Qed.
-Theorem cvt_carry :
- (x,y:positive)(convert (add_carry x y)) = (S (convert (add x y))).
+Theorem nat_of_P_plus_carry_morphism :
+ forall p q:positive, nat_of_P (Pplus_carry p q) = S (nat_of_P (p + q)).
Proof.
-Intros;Unfold convert; Rewrite convert_add_carry; Simpl; Trivial with arith.
+intros; unfold nat_of_P in |- *; rewrite Pmult_nat_plus_carry_morphism;
+ simpl in |- *; trivial with arith.
Qed.
-Theorem add_verif :
- (x,y:positive)(m:nat)
- (positive_to_nat (add x y) m) =
- (plus (positive_to_nat x m) (positive_to_nat y m)).
+Theorem Pmult_nat_l_plus_morphism :
+ forall (p q:positive) (n:nat),
+ Pmult_nat (p + q) n = Pmult_nat p n + Pmult_nat q n.
Proof.
-Intro x; NewInduction x as [p IHp|p IHp|];
- Intro y; NewDestruct y;Simpl;Auto with arith; [
- Intros m;Rewrite convert_add_carry; Rewrite IHp;
- Rewrite plus_assoc_r; Rewrite plus_assoc_r;
- Rewrite (plus_permute m (positive_to_nat p (plus m m))); Trivial with arith
-| Intros m; Rewrite IHp; Apply plus_assoc_l
-| Intros m; Rewrite convert_add_un;
- Rewrite (plus_sym (plus m (positive_to_nat p (plus m m))));
- Apply plus_assoc_r
-| Intros m; Rewrite IHp; Apply plus_permute
-| Intros m; Rewrite convert_add_un; Apply plus_assoc_r ].
+intro x; induction x as [p IHp| p IHp| ]; intro y;
+ [ destruct y as [p0| p0| ]
+ | destruct y as [p0| p0| ]
+ | destruct y as [p| p| ] ]; simpl in |- *; auto with arith;
+ [ intros m; rewrite Pmult_nat_plus_carry_morphism; rewrite IHp;
+ rewrite plus_assoc_reverse; rewrite plus_assoc_reverse;
+ rewrite (plus_permute m (Pmult_nat p (m + m)));
+ trivial with arith
+ | intros m; rewrite IHp; apply plus_assoc
+ | intros m; rewrite Pmult_nat_succ_morphism;
+ rewrite (plus_comm (m + Pmult_nat p (m + m)));
+ apply plus_assoc_reverse
+ | intros m; rewrite IHp; apply plus_permute
+ | intros m; rewrite Pmult_nat_succ_morphism; apply plus_assoc_reverse ].
Qed.
-Theorem convert_add:
- (x,y:positive) (convert (add x y)) = (plus (convert x) (convert y)).
+Theorem nat_of_P_plus_morphism :
+ forall p q:positive, nat_of_P (p + q) = nat_of_P p + nat_of_P q.
Proof.
-Intros x y; Exact (add_verif x y (S O)).
+intros x y; exact (Pmult_nat_l_plus_morphism x y 1).
Qed.
(** [Pmult_nat] is a morphism for addition *)
-Lemma ZL2:
- (y:positive)(m:nat)
- (positive_to_nat y (plus m m)) =
- (plus (positive_to_nat y m) (positive_to_nat y m)).
+Lemma Pmult_nat_r_plus_morphism :
+ forall (p:positive) (n:nat),
+ Pmult_nat p (n + n) = Pmult_nat p n + Pmult_nat p n.
Proof.
-Intro y; NewInduction y as [p H|p H|]; Intro m; [
- Simpl; Rewrite H; Rewrite plus_assoc_r;
- Rewrite (plus_permute m (positive_to_nat p (plus m m)));
- Rewrite plus_assoc_r; Auto with arith
-| Simpl; Rewrite H; Auto with arith
-| Simpl; Trivial with arith ].
+intro y; induction y as [p H| p H| ]; intro m;
+ [ simpl in |- *; rewrite H; rewrite plus_assoc_reverse;
+ rewrite (plus_permute m (Pmult_nat p (m + m)));
+ rewrite plus_assoc_reverse; auto with arith
+ | simpl in |- *; rewrite H; auto with arith
+ | simpl in |- *; trivial with arith ].
Qed.
-Lemma ZL6:
- (p:positive) (positive_to_nat p (S (S O))) = (plus (convert p) (convert p)).
+Lemma ZL6 : forall p:positive, Pmult_nat p 2 = nat_of_P p + nat_of_P p.
Proof.
-Intro p;Change (2) with (plus (S O) (S O)); Rewrite ZL2; Trivial.
+intro p; change 2 with (1 + 1) in |- *; rewrite Pmult_nat_r_plus_morphism;
+ trivial.
Qed.
(** [nat_of_P] is a morphism for multiplication *)
-Theorem times_convert :
- (x,y:positive) (convert (times x y)) = (mult (convert x) (convert y)).
-Proof.
-Intros x y; NewInduction x as [ x' H | x' H | ]; [
- Change (times (xI x') y) with (add y (xO (times x' y))); Rewrite convert_add;
- Unfold 2 3 convert; Simpl; Do 2 Rewrite ZL6; Rewrite H;
- Rewrite -> mult_plus_distr; Reflexivity
-| Unfold 1 2 convert; Simpl; Do 2 Rewrite ZL6;
- Rewrite H; Rewrite mult_plus_distr; Reflexivity
-| Simpl; Rewrite <- plus_n_O; Reflexivity ].
-Qed.
-V7only [
- Comments "Compatibility with the old version of times and times_convert".
- Syntactic Definition times1 :=
- [x:positive;_:positive->positive;y:positive](times x y).
- Syntactic Definition times1_convert :=
- [x,y:positive;_:positive->positive](times_convert x y).
-].
+Theorem nat_of_P_mult_morphism :
+ forall p q:positive, nat_of_P (p * q) = nat_of_P p * nat_of_P q.
+Proof.
+intros x y; induction x as [x' H| x' H| ];
+ [ change (xI x' * y)%positive with (y + xO (x' * y))%positive in |- *;
+ rewrite nat_of_P_plus_morphism; unfold nat_of_P at 2 3 in |- *;
+ simpl in |- *; do 2 rewrite ZL6; rewrite H; rewrite mult_plus_distr_r;
+ reflexivity
+ | unfold nat_of_P at 1 2 in |- *; simpl in |- *; do 2 rewrite ZL6; rewrite H;
+ rewrite mult_plus_distr_r; reflexivity
+ | simpl in |- *; rewrite <- plus_n_O; reflexivity ].
+Qed.
(** [nat_of_P] maps to the strictly positive subset of [nat] *)
-Lemma ZL4: (y:positive) (EX h:nat |(convert y)=(S h)).
+Lemma ZL4 : forall p:positive, exists h : nat | nat_of_P p = S h.
Proof.
-Intro y; NewInduction y as [p H|p H|]; [
- NewDestruct H as [x H1]; Exists (plus (S x) (S x));
- Unfold convert ;Simpl; Change (2) with (plus (1) (1)); Rewrite ZL2; Unfold convert in H1;
- Rewrite H1; Auto with arith
-| NewDestruct H as [x H2]; Exists (plus x (S x)); Unfold convert;
- Simpl; Change (2) with (plus (1) (1)); Rewrite ZL2;Unfold convert in H2; Rewrite H2; Auto with arith
-| Exists O ;Auto with arith ].
+intro y; induction y as [p H| p H| ];
+ [ destruct H as [x H1]; exists (S x + S x); unfold nat_of_P in |- *;
+ simpl in |- *; change 2 with (1 + 1) in |- *;
+ rewrite Pmult_nat_r_plus_morphism; unfold nat_of_P in H1;
+ rewrite H1; auto with arith
+ | destruct H as [x H2]; exists (x + S x); unfold nat_of_P in |- *;
+ simpl in |- *; change 2 with (1 + 1) in |- *;
+ rewrite Pmult_nat_r_plus_morphism; unfold nat_of_P in H2;
+ rewrite H2; auto with arith
+ | exists 0; auto with arith ].
Qed.
(** Extra lemmas on [lt] on Peano natural numbers *)
-Lemma ZL7:
- (m,n:nat) (lt m n) -> (lt (plus m m) (plus n n)).
+Lemma ZL7 : forall n m:nat, n < m -> n + n < m + m.
Proof.
-Intros m n H; Apply lt_trans with m:=(plus m n); [
- Apply lt_reg_l with 1:=H
-| Rewrite (plus_sym m n); Apply lt_reg_l with 1:=H ].
+intros m n H; apply lt_trans with (m := m + n);
+ [ apply plus_lt_compat_l with (1 := H)
+ | rewrite (plus_comm m n); apply plus_lt_compat_l with (1 := H) ].
Qed.
-Lemma ZL8:
- (m,n:nat) (lt m n) -> (lt (S (plus m m)) (plus n n)).
+Lemma ZL8 : forall n m:nat, n < m -> S (n + n) < m + m.
Proof.
-Intros m n H; Apply le_lt_trans with m:=(plus m n); [
- Change (lt (plus m m) (plus m n)) ; Apply lt_reg_l with 1:=H
-| Rewrite (plus_sym m n); Apply lt_reg_l with 1:=H ].
+intros m n H; apply le_lt_trans with (m := m + n);
+ [ change (m + m < m + n) in |- *; apply plus_lt_compat_l with (1 := H)
+ | rewrite (plus_comm m n); apply plus_lt_compat_l with (1 := H) ].
Qed.
(** [nat_of_P] is a morphism from [positive] to [nat] for [lt] (expressed
@@ -162,29 +160,30 @@ Qed.
Part 1: [lt] on [positive] is finer than [lt] on [nat]
*)
-Lemma compare_convert_INFERIEUR :
- (x,y:positive) (compare x y EGAL) = INFERIEUR ->
- (lt (convert x) (convert y)).
-Proof.
-Intro x; NewInduction x as [p H|p H|];Intro y; NewDestruct y as [q|q|];
- Intro H2; [
- Unfold convert ;Simpl; Apply lt_n_S;
- Do 2 Rewrite ZL6; Apply ZL7; Apply H; Simpl in H2; Assumption
-| Unfold convert ;Simpl; Do 2 Rewrite ZL6;
- Apply ZL8; Apply H;Simpl in H2; Apply ZLSI;Assumption
-| Simpl; Discriminate H2
-| Simpl; Unfold convert ;Simpl;Do 2 Rewrite ZL6;
- Elim (ZLII p q H2); [
- Intros H3;Apply lt_S;Apply ZL7; Apply H;Apply H3
- | Intros E;Rewrite E;Apply lt_n_Sn]
-| Simpl; Unfold convert ;Simpl;Do 2 Rewrite ZL6;
- Apply ZL7;Apply H;Assumption
-| Simpl; Discriminate H2
-| Unfold convert ;Simpl; Apply lt_n_S; Rewrite ZL6;
- Elim (ZL4 q);Intros h H3; Rewrite H3;Simpl; Apply lt_O_Sn
-| Unfold convert ;Simpl; Rewrite ZL6; Elim (ZL4 q);Intros h H3;
- Rewrite H3; Simpl; Rewrite <- plus_n_Sm; Apply lt_n_S; Apply lt_O_Sn
-| Simpl; Discriminate H2 ].
+Lemma nat_of_P_lt_Lt_compare_morphism :
+ forall p q:positive, (p ?= q)%positive Eq = Lt -> nat_of_P p < nat_of_P q.
+Proof.
+intro x; induction x as [p H| p H| ]; intro y; destruct y as [q| q| ];
+ intro H2;
+ [ unfold nat_of_P in |- *; simpl in |- *; apply lt_n_S; do 2 rewrite ZL6;
+ apply ZL7; apply H; simpl in H2; assumption
+ | unfold nat_of_P in |- *; simpl in |- *; do 2 rewrite ZL6; apply ZL8;
+ apply H; simpl in H2; apply Pcompare_Gt_Lt; assumption
+ | simpl in |- *; discriminate H2
+ | simpl in |- *; unfold nat_of_P in |- *; simpl in |- *; do 2 rewrite ZL6;
+ elim (Pcompare_Lt_Lt p q H2);
+ [ intros H3; apply lt_S; apply ZL7; apply H; apply H3
+ | intros E; rewrite E; apply lt_n_Sn ]
+ | simpl in |- *; unfold nat_of_P in |- *; simpl in |- *; do 2 rewrite ZL6;
+ apply ZL7; apply H; assumption
+ | simpl in |- *; discriminate H2
+ | unfold nat_of_P in |- *; simpl in |- *; apply lt_n_S; rewrite ZL6;
+ elim (ZL4 q); intros h H3; rewrite H3; simpl in |- *;
+ apply lt_O_Sn
+ | unfold nat_of_P in |- *; simpl in |- *; rewrite ZL6; elim (ZL4 q);
+ intros h H3; rewrite H3; simpl in |- *; rewrite <- plus_n_Sm;
+ apply lt_n_S; apply lt_O_Sn
+ | simpl in |- *; discriminate H2 ].
Qed.
(** [nat_of_P] is a morphism from [positive] to [nat] for [gt] (expressed
@@ -193,29 +192,30 @@ Qed.
Part 1: [gt] on [positive] is finer than [gt] on [nat]
*)
-Lemma compare_convert_SUPERIEUR :
- (x,y:positive) (compare x y EGAL)=SUPERIEUR -> (gt (convert x) (convert y)).
-Proof.
-Unfold gt; Intro x; NewInduction x as [p H|p H|];
- Intro y; NewDestruct y as [q|q|]; Intro H2; [
- Simpl; Unfold convert ;Simpl;Do 2 Rewrite ZL6;
- Apply lt_n_S; Apply ZL7; Apply H;Assumption
-| Simpl; Unfold convert ;Simpl; Do 2 Rewrite ZL6;
- Elim (ZLSS p q H2); [
- Intros H3;Apply lt_S;Apply ZL7;Apply H;Assumption
- | Intros E;Rewrite E;Apply lt_n_Sn]
-| Unfold convert ;Simpl; Rewrite ZL6;Elim (ZL4 p);
- Intros h H3;Rewrite H3;Simpl; Apply lt_n_S; Apply lt_O_Sn
-| Simpl;Unfold convert ;Simpl;Do 2 Rewrite ZL6;
- Apply ZL8; Apply H; Apply ZLIS; Assumption
-| Simpl; Unfold convert ;Simpl;Do 2 Rewrite ZL6;
- Apply ZL7;Apply H;Assumption
-| Unfold convert ;Simpl; Rewrite ZL6; Elim (ZL4 p);
- Intros h H3;Rewrite H3;Simpl; Rewrite <- plus_n_Sm;Apply lt_n_S;
- Apply lt_O_Sn
-| Simpl; Discriminate H2
-| Simpl; Discriminate H2
-| Simpl; Discriminate H2 ].
+Lemma nat_of_P_gt_Gt_compare_morphism :
+ forall p q:positive, (p ?= q)%positive Eq = Gt -> nat_of_P p > nat_of_P q.
+Proof.
+unfold gt in |- *; intro x; induction x as [p H| p H| ]; intro y;
+ destruct y as [q| q| ]; intro H2;
+ [ simpl in |- *; unfold nat_of_P in |- *; simpl in |- *; do 2 rewrite ZL6;
+ apply lt_n_S; apply ZL7; apply H; assumption
+ | simpl in |- *; unfold nat_of_P in |- *; simpl in |- *; do 2 rewrite ZL6;
+ elim (Pcompare_Gt_Gt p q H2);
+ [ intros H3; apply lt_S; apply ZL7; apply H; assumption
+ | intros E; rewrite E; apply lt_n_Sn ]
+ | unfold nat_of_P in |- *; simpl in |- *; rewrite ZL6; elim (ZL4 p);
+ intros h H3; rewrite H3; simpl in |- *; apply lt_n_S;
+ apply lt_O_Sn
+ | simpl in |- *; unfold nat_of_P in |- *; simpl in |- *; do 2 rewrite ZL6;
+ apply ZL8; apply H; apply Pcompare_Lt_Gt; assumption
+ | simpl in |- *; unfold nat_of_P in |- *; simpl in |- *; do 2 rewrite ZL6;
+ apply ZL7; apply H; assumption
+ | unfold nat_of_P in |- *; simpl in |- *; rewrite ZL6; elim (ZL4 p);
+ intros h H3; rewrite H3; simpl in |- *; rewrite <- plus_n_Sm;
+ apply lt_n_S; apply lt_O_Sn
+ | simpl in |- *; discriminate H2
+ | simpl in |- *; discriminate H2
+ | simpl in |- *; discriminate H2 ].
Qed.
(** [nat_of_P] is a morphism from [positive] to [nat] for [lt] (expressed
@@ -224,18 +224,18 @@ Qed.
Part 2: [lt] on [nat] is finer than [lt] on [positive]
*)
-Lemma convert_compare_INFERIEUR :
- (x,y:positive)(lt (convert x) (convert y)) -> (compare x y EGAL) = INFERIEUR.
+Lemma nat_of_P_lt_Lt_compare_complement_morphism :
+ forall p q:positive, nat_of_P p < nat_of_P q -> (p ?= q)%positive Eq = Lt.
Proof.
-Intros x y; Unfold gt; Elim (Dcompare (compare x y EGAL)); [
- Intros E; Rewrite (compare_convert_EGAL x y E);
- Intros H;Absurd (lt (convert y) (convert y)); [ Apply lt_n_n | Assumption ]
-| Intros H;Elim H; [
- Auto
- | Intros H1 H2; Absurd (lt (convert x) (convert y)); [
- Apply lt_not_sym; Change (gt (convert x) (convert y));
- Apply compare_convert_SUPERIEUR; Assumption
- | Assumption ]]].
+intros x y; unfold gt in |- *; elim (Dcompare ((x ?= y)%positive Eq));
+ [ intros E; rewrite (Pcompare_Eq_eq x y E); intros H;
+ absurd (nat_of_P y < nat_of_P y); [ apply lt_irrefl | assumption ]
+ | intros H; elim H;
+ [ auto
+ | intros H1 H2; absurd (nat_of_P x < nat_of_P y);
+ [ apply lt_asym; change (nat_of_P x > nat_of_P y) in |- *;
+ apply nat_of_P_gt_Gt_compare_morphism; assumption
+ | assumption ] ] ].
Qed.
(** [nat_of_P] is a morphism from [positive] to [nat] for [gt] (expressed
@@ -244,78 +244,78 @@ Qed.
Part 2: [gt] on [nat] is finer than [gt] on [positive]
*)
-Lemma convert_compare_SUPERIEUR :
- (x,y:positive)(gt (convert x) (convert y)) -> (compare x y EGAL) = SUPERIEUR.
+Lemma nat_of_P_gt_Gt_compare_complement_morphism :
+ forall p q:positive, nat_of_P p > nat_of_P q -> (p ?= q)%positive Eq = Gt.
Proof.
-Intros x y; Unfold gt; Elim (Dcompare (compare x y EGAL)); [
- Intros E; Rewrite (compare_convert_EGAL x y E);
- Intros H;Absurd (lt (convert y) (convert y)); [ Apply lt_n_n | Assumption ]
-| Intros H;Elim H; [
- Intros H1 H2; Absurd (lt (convert y) (convert x)); [
- Apply lt_not_sym; Apply compare_convert_INFERIEUR; Assumption
- | Assumption ]
- | Auto]].
+intros x y; unfold gt in |- *; elim (Dcompare ((x ?= y)%positive Eq));
+ [ intros E; rewrite (Pcompare_Eq_eq x y E); intros H;
+ absurd (nat_of_P y < nat_of_P y); [ apply lt_irrefl | assumption ]
+ | intros H; elim H;
+ [ intros H1 H2; absurd (nat_of_P y < nat_of_P x);
+ [ apply lt_asym; apply nat_of_P_lt_Lt_compare_morphism; assumption
+ | assumption ]
+ | auto ] ].
Qed.
(** [nat_of_P] is strictly positive *)
-Lemma compare_positive_to_nat_O :
- (p:positive)(m:nat)(le m (positive_to_nat p m)).
-NewInduction p; Simpl; Auto with arith.
-Intro m; Apply le_trans with (plus m m); Auto with arith.
+Lemma le_Pmult_nat : forall (p:positive) (n:nat), n <= Pmult_nat p n.
+induction p; simpl in |- *; auto with arith.
+intro m; apply le_trans with (m + m); auto with arith.
Qed.
-Lemma compare_convert_O : (p:positive)(lt O (convert p)).
-Intro; Unfold convert; Apply lt_le_trans with (S O); Auto with arith.
-Apply compare_positive_to_nat_O.
+Lemma lt_O_nat_of_P : forall p:positive, 0 < nat_of_P p.
+intro; unfold nat_of_P in |- *; apply lt_le_trans with 1; auto with arith.
+apply le_Pmult_nat.
Qed.
(** Pmult_nat permutes with multiplication *)
-Lemma positive_to_nat_mult : (p:positive) (n,m:nat)
- (positive_to_nat p (mult m n))=(mult m (positive_to_nat p n)).
+Lemma Pmult_nat_mult_permute :
+ forall (p:positive) (n m:nat), Pmult_nat p (m * n) = m * Pmult_nat p n.
Proof.
- Induction p. Intros. Simpl. Rewrite mult_plus_distr_r. Rewrite <- (mult_plus_distr_r m n n).
- Rewrite (H (plus n n) m). Reflexivity.
- Intros. Simpl. Rewrite <- (mult_plus_distr_r m n n). Apply H.
- Trivial.
+ simple induction p. intros. simpl in |- *. rewrite mult_plus_distr_l. rewrite <- (mult_plus_distr_l m n n).
+ rewrite (H (n + n) m). reflexivity.
+ intros. simpl in |- *. rewrite <- (mult_plus_distr_l m n n). apply H.
+ trivial.
Qed.
-Lemma positive_to_nat_2 : (p:positive)
- (positive_to_nat p (2))=(mult (2) (positive_to_nat p (1))).
+Lemma Pmult_nat_2_mult_2_permute :
+ forall p:positive, Pmult_nat p 2 = 2 * Pmult_nat p 1.
Proof.
- Intros. Rewrite <- positive_to_nat_mult. Reflexivity.
+ intros. rewrite <- Pmult_nat_mult_permute. reflexivity.
Qed.
-Lemma positive_to_nat_4 : (p:positive)
- (positive_to_nat p (4))=(mult (2) (positive_to_nat p (2))).
+Lemma Pmult_nat_4_mult_2_permute :
+ forall p:positive, Pmult_nat p 4 = 2 * Pmult_nat p 2.
Proof.
- Intros. Rewrite <- positive_to_nat_mult. Reflexivity.
+ intros. rewrite <- Pmult_nat_mult_permute. reflexivity.
Qed.
(** Mapping of xH, xO and xI through [nat_of_P] *)
-Lemma convert_xH : (convert xH)=(1).
+Lemma nat_of_P_xH : nat_of_P 1 = 1.
Proof.
- Reflexivity.
+ reflexivity.
Qed.
-Lemma convert_xO : (p:positive) (convert (xO p))=(mult (2) (convert p)).
+Lemma nat_of_P_xO : forall p:positive, nat_of_P (xO p) = 2 * nat_of_P p.
Proof.
- Induction p. Unfold convert. Simpl. Intros. Rewrite positive_to_nat_2.
- Rewrite positive_to_nat_4. Rewrite H. Simpl. Rewrite <- plus_Snm_nSm. Reflexivity.
- Unfold convert. Simpl. Intros. Rewrite positive_to_nat_2. Rewrite positive_to_nat_4.
- Rewrite H. Reflexivity.
- Reflexivity.
+ simple induction p. unfold nat_of_P in |- *. simpl in |- *. intros. rewrite Pmult_nat_2_mult_2_permute.
+ rewrite Pmult_nat_4_mult_2_permute. rewrite H. simpl in |- *. rewrite <- plus_Snm_nSm. reflexivity.
+ unfold nat_of_P in |- *. simpl in |- *. intros. rewrite Pmult_nat_2_mult_2_permute. rewrite Pmult_nat_4_mult_2_permute.
+ rewrite H. reflexivity.
+ reflexivity.
Qed.
-Lemma convert_xI : (p:positive) (convert (xI p))=(S (mult (2) (convert p))).
+Lemma nat_of_P_xI : forall p:positive, nat_of_P (xI p) = S (2 * nat_of_P p).
Proof.
- Induction p. Unfold convert. Simpl. Intro p0. Intro. Rewrite positive_to_nat_2.
- Rewrite positive_to_nat_4; Injection H; Intro H1; Rewrite H1; Rewrite <- plus_Snm_nSm; Reflexivity.
- Unfold convert. Simpl. Intros. Rewrite positive_to_nat_2. Rewrite positive_to_nat_4.
- Injection H; Intro H1; Rewrite H1; Reflexivity.
- Reflexivity.
+ simple induction p. unfold nat_of_P in |- *. simpl in |- *. intro p0. intro. rewrite Pmult_nat_2_mult_2_permute.
+ rewrite Pmult_nat_4_mult_2_permute; injection H; intro H1; rewrite H1;
+ rewrite <- plus_Snm_nSm; reflexivity.
+ unfold nat_of_P in |- *. simpl in |- *. intros. rewrite Pmult_nat_2_mult_2_permute. rewrite Pmult_nat_4_mult_2_permute.
+ injection H; intro H1; rewrite H1; reflexivity.
+ reflexivity.
Qed.
(**********************************************************************)
@@ -324,54 +324,61 @@ Qed.
(** Composition of [P_of_succ_nat] and [nat_of_P] is successor on [nat] *)
-Theorem bij1 : (m:nat) (convert (anti_convert m)) = (S m).
+Theorem nat_of_P_o_P_of_succ_nat_eq_succ :
+ forall n:nat, nat_of_P (P_of_succ_nat n) = S n.
Proof.
-Intro m; NewInduction m as [|n H]; [
- Reflexivity
-| Simpl; Rewrite cvt_add_un; Rewrite H; Auto ].
+intro m; induction m as [| n H];
+ [ reflexivity
+ | simpl in |- *; rewrite nat_of_P_succ_morphism; rewrite H; auto ].
Qed.
(** Miscellaneous lemmas on [P_of_succ_nat] *)
-Lemma ZL3: (x:nat) (add_un (anti_convert (plus x x))) = (xO (anti_convert x)).
+Lemma ZL3 :
+ forall n:nat, Psucc (P_of_succ_nat (n + n)) = xO (P_of_succ_nat n).
Proof.
-Intro x; NewInduction x as [|n H]; [
- Simpl; Auto with arith
-| Simpl; Rewrite plus_sym; Simpl; Rewrite H; Rewrite ZL1;Auto with arith].
+intro x; induction x as [| n H];
+ [ simpl in |- *; auto with arith
+ | simpl in |- *; rewrite plus_comm; simpl in |- *; rewrite H;
+ rewrite xO_succ_permute; auto with arith ].
Qed.
-Lemma ZL5: (x:nat) (anti_convert (plus (S x) (S x))) = (xI (anti_convert x)).
+Lemma ZL5 : forall n:nat, P_of_succ_nat (S n + S n) = xI (P_of_succ_nat n).
Proof.
-Intro x; NewInduction x as [|n H];Simpl; [
- Auto with arith
-| Rewrite <- plus_n_Sm; Simpl; Simpl in H; Rewrite H; Auto with arith].
+intro x; induction x as [| n H]; simpl in |- *;
+ [ auto with arith
+ | rewrite <- plus_n_Sm; simpl in |- *; simpl in H; rewrite H;
+ auto with arith ].
Qed.
(** Composition of [nat_of_P] and [P_of_succ_nat] is successor on [positive] *)
-Theorem bij2 : (x:positive) (anti_convert (convert x)) = (add_un x).
+Theorem P_of_succ_nat_o_nat_of_P_eq_succ :
+ forall p:positive, P_of_succ_nat (nat_of_P p) = Psucc p.
Proof.
-Intro x; NewInduction x as [p H|p H|]; [
- Simpl; Rewrite <- H; Change (2) with (plus (1) (1));
- Rewrite ZL2; Elim (ZL4 p);
- Unfold convert; Intros n H1;Rewrite H1; Rewrite ZL3; Auto with arith
-| Unfold convert ;Simpl; Change (2) with (plus (1) (1));
- Rewrite ZL2;
- Rewrite <- (sub_add_one
- (anti_convert
- (plus (positive_to_nat p (S O)) (positive_to_nat p (S O)))));
- Rewrite <- (sub_add_one (xI p));
- Simpl;Rewrite <- H;Elim (ZL4 p); Unfold convert ;Intros n H1;Rewrite H1;
- Rewrite ZL5; Simpl; Trivial with arith
-| Unfold convert; Simpl; Auto with arith ].
+intro x; induction x as [p H| p H| ];
+ [ simpl in |- *; rewrite <- H; change 2 with (1 + 1) in |- *;
+ rewrite Pmult_nat_r_plus_morphism; elim (ZL4 p);
+ unfold nat_of_P in |- *; intros n H1; rewrite H1;
+ rewrite ZL3; auto with arith
+ | unfold nat_of_P in |- *; simpl in |- *; change 2 with (1 + 1) in |- *;
+ rewrite Pmult_nat_r_plus_morphism;
+ rewrite <- (Ppred_succ (P_of_succ_nat (Pmult_nat p 1 + Pmult_nat p 1)));
+ rewrite <- (Ppred_succ (xI p)); simpl in |- *;
+ rewrite <- H; elim (ZL4 p); unfold nat_of_P in |- *;
+ intros n H1; rewrite H1; rewrite ZL5; simpl in |- *;
+ trivial with arith
+ | unfold nat_of_P in |- *; simpl in |- *; auto with arith ].
Qed.
(** Composition of [nat_of_P], [P_of_succ_nat] and [Ppred] is identity
on [positive] *)
-Theorem bij3: (x:positive)(sub_un (anti_convert (convert x))) = x.
+Theorem pred_o_P_of_succ_nat_o_nat_of_P_eq_id :
+ forall p:positive, Ppred (P_of_succ_nat (nat_of_P p)) = p.
Proof.
-Intros x; Rewrite bij2; Rewrite sub_add_one; Trivial with arith.
+intros x; rewrite P_of_succ_nat_o_nat_of_P_eq_succ; rewrite Ppred_succ;
+ trivial with arith.
Qed.
(**********************************************************************)
@@ -380,93 +387,99 @@ Qed.
(** [nat_of_P] is a morphism for subtraction on positive numbers *)
-Theorem true_sub_convert:
- (x,y:positive) (compare x y EGAL) = SUPERIEUR ->
- (convert (true_sub x y)) = (minus (convert x) (convert y)).
+Theorem nat_of_P_minus_morphism :
+ forall p q:positive,
+ (p ?= q)%positive Eq = Gt -> nat_of_P (p - q) = nat_of_P p - nat_of_P q.
Proof.
-Intros x y H; Apply plus_reg_l with (convert y);
-Rewrite le_plus_minus_r; [
- Rewrite <- convert_add; Rewrite sub_add; Auto with arith
-| Apply lt_le_weak; Exact (compare_convert_SUPERIEUR x y H)].
+intros x y H; apply plus_reg_l with (nat_of_P y); rewrite le_plus_minus_r;
+ [ rewrite <- nat_of_P_plus_morphism; rewrite Pplus_minus; auto with arith
+ | apply lt_le_weak; exact (nat_of_P_gt_Gt_compare_morphism x y H) ].
Qed.
(** [nat_of_P] is injective *)
-Lemma convert_intro : (x,y:positive)(convert x)=(convert y) -> x=y.
+Lemma nat_of_P_inj : forall p q:positive, nat_of_P p = nat_of_P q -> p = q.
Proof.
-Intros x y H;Rewrite <- (bij3 x);Rewrite <- (bij3 y); Rewrite H; Trivial with arith.
+intros x y H; rewrite <- (pred_o_P_of_succ_nat_o_nat_of_P_eq_id x);
+ rewrite <- (pred_o_P_of_succ_nat_o_nat_of_P_eq_id y);
+ rewrite H; trivial with arith.
Qed.
-Lemma ZL16: (p,q:positive)(lt (minus (convert p) (convert q)) (convert p)).
+Lemma ZL16 : forall p q:positive, nat_of_P p - nat_of_P q < nat_of_P p.
Proof.
-Intros p q; Elim (ZL4 p);Elim (ZL4 q); Intros h H1 i H2;
-Rewrite H1;Rewrite H2; Simpl;Unfold lt; Apply le_n_S; Apply le_minus.
+intros p q; elim (ZL4 p); elim (ZL4 q); intros h H1 i H2; rewrite H1;
+ rewrite H2; simpl in |- *; unfold lt in |- *; apply le_n_S;
+ apply le_minus.
Qed.
-Lemma ZL17: (p,q:positive)(lt (convert p) (convert (add p q))).
+Lemma ZL17 : forall p q:positive, nat_of_P p < nat_of_P (p + q).
Proof.
-Intros p q; Rewrite convert_add;Unfold lt;Elim (ZL4 q); Intros k H;Rewrite H;
-Rewrite plus_sym;Simpl; Apply le_n_S; Apply le_plus_r.
+intros p q; rewrite nat_of_P_plus_morphism; unfold lt in |- *; elim (ZL4 q);
+ intros k H; rewrite H; rewrite plus_comm; simpl in |- *;
+ apply le_n_S; apply le_plus_r.
Qed.
(** Comparison and subtraction *)
-Lemma compare_true_sub_right :
- (p,q,z:positive)
- (compare q p EGAL)=INFERIEUR->
- (compare z p EGAL)=SUPERIEUR->
- (compare z q EGAL)=SUPERIEUR->
- (compare (true_sub z p) (true_sub z q) EGAL)=INFERIEUR.
-Proof.
-Intros; Apply convert_compare_INFERIEUR; Rewrite true_sub_convert; [
- Rewrite true_sub_convert; [
- Apply simpl_lt_plus_l with p:=(convert q); Rewrite le_plus_minus_r; [
- Rewrite plus_sym; Apply simpl_lt_plus_l with p:=(convert p);
- Rewrite plus_assoc_l; Rewrite le_plus_minus_r; [
- Rewrite (plus_sym (convert p)); Apply lt_reg_l;
- Apply compare_convert_INFERIEUR; Assumption
- | Apply lt_le_weak; Apply compare_convert_INFERIEUR;
- Apply ZC1; Assumption ]
- | Apply lt_le_weak;Apply compare_convert_INFERIEUR;
- Apply ZC1; Assumption ]
- | Assumption ]
- | Assumption ].
-Qed.
-
-Lemma compare_true_sub_left :
- (p,q,z:positive)
- (compare q p EGAL)=INFERIEUR->
- (compare p z EGAL)=SUPERIEUR->
- (compare q z EGAL)=SUPERIEUR->
- (compare (true_sub q z) (true_sub p z) EGAL)=INFERIEUR.
-Proof.
-Intros p q z; Intros;
- Apply convert_compare_INFERIEUR; Rewrite true_sub_convert; [
- Rewrite true_sub_convert; [
- Unfold gt; Apply simpl_lt_plus_l with p:=(convert z);
- Rewrite le_plus_minus_r; [
- Rewrite le_plus_minus_r; [
- Apply compare_convert_INFERIEUR;Assumption
- | Apply lt_le_weak; Apply compare_convert_INFERIEUR;Apply ZC1;Assumption]
- | Apply lt_le_weak; Apply compare_convert_INFERIEUR;Apply ZC1; Assumption]
- | Assumption]
-| Assumption].
+Lemma Pcompare_minus_r :
+ forall p q r:positive,
+ (q ?= p)%positive Eq = Lt ->
+ (r ?= p)%positive Eq = Gt ->
+ (r ?= q)%positive Eq = Gt -> (r - p ?= r - q)%positive Eq = Lt.
+Proof.
+intros; apply nat_of_P_lt_Lt_compare_complement_morphism;
+ rewrite nat_of_P_minus_morphism;
+ [ rewrite nat_of_P_minus_morphism;
+ [ apply plus_lt_reg_l with (p := nat_of_P q); rewrite le_plus_minus_r;
+ [ rewrite plus_comm; apply plus_lt_reg_l with (p := nat_of_P p);
+ rewrite plus_assoc; rewrite le_plus_minus_r;
+ [ rewrite (plus_comm (nat_of_P p)); apply plus_lt_compat_l;
+ apply nat_of_P_lt_Lt_compare_morphism;
+ assumption
+ | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
+ apply ZC1; assumption ]
+ | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism; apply ZC1;
+ assumption ]
+ | assumption ]
+ | assumption ].
+Qed.
+
+Lemma Pcompare_minus_l :
+ forall p q r:positive,
+ (q ?= p)%positive Eq = Lt ->
+ (p ?= r)%positive Eq = Gt ->
+ (q ?= r)%positive Eq = Gt -> (q - r ?= p - r)%positive Eq = Lt.
+Proof.
+intros p q z; intros; apply nat_of_P_lt_Lt_compare_complement_morphism;
+ rewrite nat_of_P_minus_morphism;
+ [ rewrite nat_of_P_minus_morphism;
+ [ unfold gt in |- *; apply plus_lt_reg_l with (p := nat_of_P z);
+ rewrite le_plus_minus_r;
+ [ rewrite le_plus_minus_r;
+ [ apply nat_of_P_lt_Lt_compare_morphism; assumption
+ | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
+ apply ZC1; assumption ]
+ | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism; apply ZC1;
+ assumption ]
+ | assumption ]
+ | assumption ].
Qed.
(** Distributivity of multiplication over subtraction *)
-Theorem times_true_sub_distr:
- (x,y,z:positive) (compare y z EGAL) = SUPERIEUR ->
- (times x (true_sub y z)) = (true_sub (times x y) (times x z)).
-Proof.
-Intros x y z H; Apply convert_intro;
-Rewrite times_convert; Rewrite true_sub_convert; [
- Rewrite true_sub_convert; [
- Do 2 Rewrite times_convert;
- Do 3 Rewrite (mult_sym (convert x));Apply mult_minus_distr
- | Apply convert_compare_SUPERIEUR; Do 2 Rewrite times_convert;
- Unfold gt; Elim (ZL4 x);Intros h H1;Rewrite H1; Apply lt_mult_left;
- Exact (compare_convert_SUPERIEUR y z H) ]
-| Assumption ].
+Theorem Pmult_minus_distr_l :
+ forall p q r:positive,
+ (q ?= r)%positive Eq = Gt ->
+ (p * (q - r))%positive = (p * q - p * r)%positive.
+Proof.
+intros x y z H; apply nat_of_P_inj; rewrite nat_of_P_mult_morphism;
+ rewrite nat_of_P_minus_morphism;
+ [ rewrite nat_of_P_minus_morphism;
+ [ do 2 rewrite nat_of_P_mult_morphism;
+ do 3 rewrite (mult_comm (nat_of_P x)); apply mult_minus_distr_r
+ | apply nat_of_P_gt_Gt_compare_complement_morphism;
+ do 2 rewrite nat_of_P_mult_morphism; unfold gt in |- *;
+ elim (ZL4 x); intros h H1; rewrite H1; apply mult_S_lt_compat_l;
+ exact (nat_of_P_gt_Gt_compare_morphism y z H) ]
+ | assumption ].
Qed.
-
diff --git a/theories/Reals/Alembert.v b/theories/Reals/Alembert.v
index 455803aa1..7d8a93914 100644
--- a/theories/Reals/Alembert.v
+++ b/theories/Reals/Alembert.v
@@ -8,12 +8,12 @@
(*i $Id$ i*)
-Require Rbase.
-Require Rfunctions.
-Require Rseries.
-Require SeqProp.
-Require PartSum.
-Require Max.
+Require Import Rbase.
+Require Import Rfunctions.
+Require Import Rseries.
+Require Import SeqProp.
+Require Import PartSum.
+Require Import Max.
Open Local Scope R_scope.
@@ -21,529 +21,706 @@ Open Local Scope R_scope.
(* Various versions of the criterion of D'Alembert *)
(***************************************************)
-Lemma Alembert_C1 : (An:nat->R) ((n:nat)``0<(An n)``) -> (Un_cv [n:nat](Rabsolu ``(An (S n))/(An n)``) R0) -> (SigT R [l:R](Un_cv [N:nat](sum_f_R0 An N) l)).
-Intros An H H0.
-Cut (sigTT R [l:R](is_lub (EUn [N:nat](sum_f_R0 An N)) l)) -> (SigT R [l:R](Un_cv [N:nat](sum_f_R0 An N) l)).
-Intro; Apply X.
-Apply complet.
-Unfold Un_cv in H0; Unfold bound; Cut ``0</2``; [Intro | Apply Rlt_Rinv; Sup0].
-Elim (H0 ``/2`` H1); Intros.
-Exists ``(sum_f_R0 An x)+2*(An (S x))``.
-Unfold is_upper_bound; Intros; Unfold EUn in H3; Elim H3; Intros.
-Rewrite H4; Assert H5 := (lt_eq_lt_dec x1 x).
-Elim H5; Intros.
-Elim a; Intro.
-Replace (sum_f_R0 An x) with (Rplus (sum_f_R0 An x1) (sum_f_R0 [i:nat](An (plus (S x1) i)) (minus x (S x1)))).
-Pattern 1 (sum_f_R0 An x1); Rewrite <- Rplus_Or; Rewrite Rplus_assoc; Apply Rle_compatibility.
-Left; Apply gt0_plus_gt0_is_gt0.
-Apply tech1; Intros; Apply H.
-Apply Rmult_lt_pos; [Sup0 | Apply H].
-Symmetry; Apply tech2; Assumption.
-Rewrite b; Pattern 1 (sum_f_R0 An x); Rewrite <- Rplus_Or; Apply Rle_compatibility.
-Left; Apply Rmult_lt_pos; [Sup0 | Apply H].
-Replace (sum_f_R0 An x1) with (Rplus (sum_f_R0 An x) (sum_f_R0 [i:nat](An (plus (S x) i)) (minus x1 (S x)))).
-Apply Rle_compatibility.
-Cut (Rle (sum_f_R0 [i:nat](An (plus (S x) i)) (minus x1 (S x))) (Rmult (An (S x)) (sum_f_R0 [i:nat](pow ``/2`` i) (minus x1 (S x))))).
-Intro; Apply Rle_trans with (Rmult (An (S x)) (sum_f_R0 [i:nat](pow ``/2`` i) (minus x1 (S x)))).
-Assumption.
-Rewrite <- (Rmult_sym (An (S x))); Apply Rle_monotony.
-Left; Apply H.
-Rewrite tech3.
-Replace ``1-/2`` with ``/2``.
-Unfold Rdiv; Rewrite Rinv_Rinv.
-Pattern 3 ``2``; Rewrite <- Rmult_1r; Rewrite <- (Rmult_sym ``2``); Apply Rle_monotony.
-Left; Sup0.
-Left; Apply Rlt_anti_compatibility with ``(pow (/2) (S (minus x1 (S x))))``.
-Replace ``(pow (/2) (S (minus x1 (S x))))+(1-(pow (/2) (S (minus x1 (S x)))))`` with R1; [Idtac | Ring].
-Rewrite <- (Rplus_sym ``1``); Pattern 1 R1; Rewrite <- Rplus_Or; Apply Rlt_compatibility.
-Apply pow_lt; Apply Rlt_Rinv; Sup0.
-DiscrR.
-Apply r_Rmult_mult with ``2``.
-Rewrite Rminus_distr; Rewrite <- Rinv_r_sym.
-Ring.
-DiscrR.
-DiscrR.
-Pattern 3 R1; Replace R1 with ``/1``; [Apply tech7; DiscrR | Apply Rinv_R1].
-Replace (An (S x)) with (An (plus (S x) O)).
-Apply (tech6 [i:nat](An (plus (S x) i)) ``/2``).
-Left; Apply Rlt_Rinv; Sup0.
-Intro; Cut (n:nat)(ge n x)->``(An (S n))</2*(An n)``.
-Intro; Replace (plus (S x) (S i)) with (S (plus (S x) i)).
-Apply H6; Unfold ge; Apply tech8.
-Apply INR_eq; Rewrite S_INR; Do 2 Rewrite plus_INR; Do 2 Rewrite S_INR; Ring.
-Intros; Unfold R_dist in H2; Apply Rlt_monotony_contra with ``/(An n)``.
-Apply Rlt_Rinv; Apply H.
-Do 2 Rewrite (Rmult_sym ``/(An n)``); Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Replace ``(An (S n))*/(An n)`` with ``(Rabsolu ((Rabsolu ((An (S n))/(An n)))-0))``.
-Apply H2; Assumption.
-Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_Rabsolu; Rewrite Rabsolu_right.
-Unfold Rdiv; Reflexivity.
-Left; Unfold Rdiv; Change ``0<(An (S n))*/(An n)``; Apply Rmult_lt_pos; [Apply H | Apply Rlt_Rinv; Apply H].
-Red; Intro; Assert H8 := (H n); Rewrite H7 in H8; Elim (Rlt_antirefl ? H8).
-Replace (plus (S x) O) with (S x); [Reflexivity | Ring].
-Symmetry; Apply tech2; Assumption.
-Exists (sum_f_R0 An O); Unfold EUn; Exists O; Reflexivity.
-Intro; Elim X; Intros.
-Apply Specif.existT with x; Apply tech10; [Unfold Un_growing; Intro; Rewrite tech5; Pattern 1 (sum_f_R0 An n); Rewrite <- Rplus_Or; Apply Rle_compatibility; Left; Apply H | Apply p].
+Lemma Alembert_C1 :
+ forall An:nat -> R,
+ (forall n:nat, 0 < An n) ->
+ Un_cv (fun n:nat => Rabs (An (S n) / An n)) 0 ->
+ sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l).
+intros An H H0.
+cut
+ (sigT (fun l:R => is_lub (EUn (fun N:nat => sum_f_R0 An N)) l) ->
+ sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l)).
+intro; apply X.
+apply completeness.
+unfold Un_cv in H0; unfold bound in |- *; cut (0 < / 2);
+ [ intro | apply Rinv_0_lt_compat; prove_sup0 ].
+elim (H0 (/ 2) H1); intros.
+exists (sum_f_R0 An x + 2 * An (S x)).
+unfold is_upper_bound in |- *; intros; unfold EUn in H3; elim H3; intros.
+rewrite H4; assert (H5 := lt_eq_lt_dec x1 x).
+elim H5; intros.
+elim a; intro.
+replace (sum_f_R0 An x) with
+ (sum_f_R0 An x1 + sum_f_R0 (fun i:nat => An (S x1 + i)%nat) (x - S x1)).
+pattern (sum_f_R0 An x1) at 1 in |- *; rewrite <- Rplus_0_r;
+ rewrite Rplus_assoc; apply Rplus_le_compat_l.
+left; apply Rplus_lt_0_compat.
+apply tech1; intros; apply H.
+apply Rmult_lt_0_compat; [ prove_sup0 | apply H ].
+symmetry in |- *; apply tech2; assumption.
+rewrite b; pattern (sum_f_R0 An x) at 1 in |- *; rewrite <- Rplus_0_r;
+ apply Rplus_le_compat_l.
+left; apply Rmult_lt_0_compat; [ prove_sup0 | apply H ].
+replace (sum_f_R0 An x1) with
+ (sum_f_R0 An x + sum_f_R0 (fun i:nat => An (S x + i)%nat) (x1 - S x)).
+apply Rplus_le_compat_l.
+cut
+ (sum_f_R0 (fun i:nat => An (S x + i)%nat) (x1 - S x) <=
+ An (S x) * sum_f_R0 (fun i:nat => (/ 2) ^ i) (x1 - S x)).
+intro;
+ apply Rle_trans with
+ (An (S x) * sum_f_R0 (fun i:nat => (/ 2) ^ i) (x1 - S x)).
+assumption.
+rewrite <- (Rmult_comm (An (S x))); apply Rmult_le_compat_l.
+left; apply H.
+rewrite tech3.
+replace (1 - / 2) with (/ 2).
+unfold Rdiv in |- *; rewrite Rinv_involutive.
+pattern 2 at 3 in |- *; rewrite <- Rmult_1_r; rewrite <- (Rmult_comm 2);
+ apply Rmult_le_compat_l.
+left; prove_sup0.
+left; apply Rplus_lt_reg_r with ((/ 2) ^ S (x1 - S x)).
+replace ((/ 2) ^ S (x1 - S x) + (1 - (/ 2) ^ S (x1 - S x))) with 1;
+ [ idtac | ring ].
+rewrite <- (Rplus_comm 1); pattern 1 at 1 in |- *; rewrite <- Rplus_0_r;
+ apply Rplus_lt_compat_l.
+apply pow_lt; apply Rinv_0_lt_compat; prove_sup0.
+discrR.
+apply Rmult_eq_reg_l with 2.
+rewrite Rmult_minus_distr_l; rewrite <- Rinv_r_sym.
+ring.
+discrR.
+discrR.
+pattern 1 at 3 in |- *; replace 1 with (/ 1);
+ [ apply tech7; discrR | apply Rinv_1 ].
+replace (An (S x)) with (An (S x + 0)%nat).
+apply (tech6 (fun i:nat => An (S x + i)%nat) (/ 2)).
+left; apply Rinv_0_lt_compat; prove_sup0.
+intro; cut (forall n:nat, (n >= x)%nat -> An (S n) < / 2 * An n).
+intro; replace (S x + S i)%nat with (S (S x + i)).
+apply H6; unfold ge in |- *; apply tech8.
+apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; do 2 rewrite S_INR; ring.
+intros; unfold R_dist in H2; apply Rmult_lt_reg_l with (/ An n).
+apply Rinv_0_lt_compat; apply H.
+do 2 rewrite (Rmult_comm (/ An n)); rewrite Rmult_assoc;
+ rewrite <- Rinv_r_sym.
+rewrite Rmult_1_r;
+ replace (An (S n) * / An n) with (Rabs (Rabs (An (S n) / An n) - 0)).
+apply H2; assumption.
+unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r;
+ rewrite Rabs_Rabsolu; rewrite Rabs_right.
+unfold Rdiv in |- *; reflexivity.
+left; unfold Rdiv in |- *; change (0 < An (S n) * / An n) in |- *;
+ apply Rmult_lt_0_compat; [ apply H | apply Rinv_0_lt_compat; apply H ].
+red in |- *; intro; assert (H8 := H n); rewrite H7 in H8;
+ elim (Rlt_irrefl _ H8).
+replace (S x + 0)%nat with (S x); [ reflexivity | ring ].
+symmetry in |- *; apply tech2; assumption.
+exists (sum_f_R0 An 0); unfold EUn in |- *; exists 0%nat; reflexivity.
+intro; elim X; intros.
+apply existT with x; apply tech10;
+ [ unfold Un_growing in |- *; intro; rewrite tech5;
+ pattern (sum_f_R0 An n) at 1 in |- *; rewrite <- Rplus_0_r;
+ apply Rplus_le_compat_l; left; apply H
+ | apply p ].
Qed.
-Lemma Alembert_C2 : (An:nat->R) ((n:nat)``(An n)<>0``) -> (Un_cv [n:nat](Rabsolu ``(An (S n))/(An n)``) R0) -> (SigT R [l:R](Un_cv [N:nat](sum_f_R0 An N) l)).
-Intros.
-Pose Vn := [i:nat]``(2*(Rabsolu (An i))+(An i))/2``.
-Pose Wn := [i:nat]``(2*(Rabsolu (An i))-(An i))/2``.
-Cut (n:nat)``0<(Vn n)``.
-Intro; Cut (n:nat)``0<(Wn n)``.
-Intro; Cut (Un_cv [n:nat](Rabsolu ``(Vn (S n))/(Vn n)``) ``0``).
-Intro; Cut (Un_cv [n:nat](Rabsolu ``(Wn (S n))/(Wn n)``) ``0``).
-Intro; Assert H5 := (Alembert_C1 Vn H1 H3).
-Assert H6 := (Alembert_C1 Wn H2 H4).
-Elim H5; Intros.
-Elim H6; Intros.
-Apply Specif.existT with ``x-x0``; Unfold Un_cv; Unfold Un_cv in p; Unfold Un_cv in p0; Intros; Cut ``0<eps/2``.
-Intro; Elim (p ``eps/2`` H8); Clear p; Intros.
-Elim (p0 ``eps/2`` H8); Clear p0; Intros.
-Pose N := (max x1 x2).
-Exists N; Intros; Replace (sum_f_R0 An n) with (Rminus (sum_f_R0 Vn n) (sum_f_R0 Wn n)).
-Unfold R_dist; Replace (Rminus (Rminus (sum_f_R0 Vn n) (sum_f_R0 Wn n)) (Rminus x x0)) with (Rplus (Rminus (sum_f_R0 Vn n) x) (Ropp (Rminus (sum_f_R0 Wn n) x0))); [Idtac | Ring]; Apply Rle_lt_trans with (Rplus (Rabsolu (Rminus (sum_f_R0 Vn n) x)) (Rabsolu (Ropp (Rminus (sum_f_R0 Wn n) x0)))).
-Apply Rabsolu_triang.
-Rewrite Rabsolu_Ropp; Apply Rlt_le_trans with ``eps/2+eps/2``.
-Apply Rplus_lt.
-Unfold R_dist in H9; Apply H9; Unfold ge; Apply le_trans with N; [Unfold N; Apply le_max_l | Assumption].
-Unfold R_dist in H10; Apply H10; Unfold ge; Apply le_trans with N; [Unfold N; Apply le_max_r | Assumption].
-Right; Symmetry; Apply double_var.
-Symmetry; Apply tech11; Intro; Unfold Vn Wn; Unfold Rdiv; Do 2 Rewrite <- (Rmult_sym ``/2``); Apply r_Rmult_mult with ``2``.
-Rewrite Rminus_distr; Repeat Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
-Ring.
-DiscrR.
-DiscrR.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
-Cut (n:nat)``/2*(Rabsolu (An n))<=(Wn n)<=(3*/2)*(Rabsolu (An n))``.
-Intro; Cut (n:nat)``/(Wn n)<=2*/(Rabsolu (An n))``.
-Intro; Cut (n:nat)``(Wn (S n))/(Wn n)<=3*(Rabsolu (An (S n))/(An n))``.
-Intro; Unfold Un_cv; Intros; Unfold Un_cv in H0; Cut ``0<eps/3``.
-Intro; Elim (H0 ``eps/3`` H8); Intros.
-Exists x; Intros.
-Assert H11 := (H9 n H10).
-Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_Rabsolu; Unfold R_dist in H11; Unfold Rminus in H11; Rewrite Ropp_O in H11; Rewrite Rplus_Or in H11; Rewrite Rabsolu_Rabsolu in H11; Rewrite Rabsolu_right.
-Apply Rle_lt_trans with ``3*(Rabsolu ((An (S n))/(An n)))``.
-Apply H6.
-Apply Rlt_monotony_contra with ``/3``.
-Apply Rlt_Rinv; Sup0.
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym; [Idtac | DiscrR]; Rewrite Rmult_1l; Rewrite <- (Rmult_sym eps); Unfold Rdiv in H11; Exact H11.
-Left; Change ``0<(Wn (S n))/(Wn n)``; Unfold Rdiv; Apply Rmult_lt_pos.
-Apply H2.
-Apply Rlt_Rinv; Apply H2.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
-Intro; Unfold Rdiv; Rewrite Rabsolu_mult; Rewrite <- Rmult_assoc; Replace ``3`` with ``2*(3*/2)``; [Idtac | Rewrite <- Rmult_assoc; Apply Rinv_r_simpl_m; DiscrR]; Apply Rle_trans with ``(Wn (S n))*2*/(Rabsolu (An n))``.
-Rewrite Rmult_assoc; Apply Rle_monotony.
-Left; Apply H2.
-Apply H5.
-Rewrite Rabsolu_Rinv.
-Replace ``(Wn (S n))*2*/(Rabsolu (An n))`` with ``(2*/(Rabsolu (An n)))*(Wn (S n))``; [Idtac | Ring]; Replace ``2*(3*/2)*(Rabsolu (An (S n)))*/(Rabsolu (An n))`` with ``(2*/(Rabsolu (An n)))*((3*/2)*(Rabsolu (An (S n))))``; [Idtac | Ring]; Apply Rle_monotony.
-Left; Apply Rmult_lt_pos.
-Sup0.
-Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Apply H.
-Elim (H4 (S n)); Intros; Assumption.
-Apply H.
-Intro; Apply Rle_monotony_contra with (Wn n).
-Apply H2.
-Rewrite <- Rinv_r_sym.
-Apply Rle_monotony_contra with (Rabsolu (An n)).
-Apply Rabsolu_pos_lt; Apply H.
-Rewrite Rmult_1r; Replace ``(Rabsolu (An n))*((Wn n)*(2*/(Rabsolu (An n))))`` with ``2*(Wn n)*((Rabsolu (An n))*/(Rabsolu (An n)))``; [Idtac | Ring]; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Apply Rle_monotony_contra with ``/2``.
-Apply Rlt_Rinv; Sup0.
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l; Elim (H4 n); Intros; Assumption.
-DiscrR.
-Apply Rabsolu_no_R0; Apply H.
-Red; Intro; Assert H6 := (H2 n); Rewrite H5 in H6; Elim (Rlt_antirefl ? H6).
-Intro; Split.
-Unfold Wn; Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Sup0.
-Pattern 1 (Rabsolu (An n)); Rewrite <- Rplus_Or; Rewrite double; Unfold Rminus; Rewrite Rplus_assoc; Apply Rle_compatibility.
-Apply Rle_anti_compatibility with (An n).
-Rewrite Rplus_Or; Rewrite (Rplus_sym (An n)); Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Apply Rle_Rabsolu.
-Unfold Wn; Unfold Rdiv; Repeat Rewrite <- (Rmult_sym ``/2``); Repeat Rewrite Rmult_assoc; Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Sup0.
-Unfold Rminus; Rewrite double; Replace ``3*(Rabsolu (An n))`` with ``(Rabsolu (An n))+(Rabsolu (An n))+(Rabsolu (An n))``; [Idtac | Ring]; Repeat Rewrite Rplus_assoc; Repeat Apply Rle_compatibility.
-Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu.
-Cut (n:nat)``/2*(Rabsolu (An n))<=(Vn n)<=(3*/2)*(Rabsolu (An n))``.
-Intro; Cut (n:nat)``/(Vn n)<=2*/(Rabsolu (An n))``.
-Intro; Cut (n:nat)``(Vn (S n))/(Vn n)<=3*(Rabsolu (An (S n))/(An n))``.
-Intro; Unfold Un_cv; Intros; Unfold Un_cv in H1; Cut ``0<eps/3``.
-Intro; Elim (H0 ``eps/3`` H7); Intros.
-Exists x; Intros.
-Assert H10 := (H8 n H9).
-Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_Rabsolu; Unfold R_dist in H10; Unfold Rminus in H10; Rewrite Ropp_O in H10; Rewrite Rplus_Or in H10; Rewrite Rabsolu_Rabsolu in H10; Rewrite Rabsolu_right.
-Apply Rle_lt_trans with ``3*(Rabsolu ((An (S n))/(An n)))``.
-Apply H5.
-Apply Rlt_monotony_contra with ``/3``.
-Apply Rlt_Rinv; Sup0.
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym; [Idtac | DiscrR]; Rewrite Rmult_1l; Rewrite <- (Rmult_sym eps); Unfold Rdiv in H10; Exact H10.
-Left; Change ``0<(Vn (S n))/(Vn n)``; Unfold Rdiv; Apply Rmult_lt_pos.
-Apply H1.
-Apply Rlt_Rinv; Apply H1.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
-Intro; Unfold Rdiv; Rewrite Rabsolu_mult; Rewrite <- Rmult_assoc; Replace ``3`` with ``2*(3*/2)``; [Idtac | Rewrite <- Rmult_assoc; Apply Rinv_r_simpl_m; DiscrR]; Apply Rle_trans with ``(Vn (S n))*2*/(Rabsolu (An n))``.
-Rewrite Rmult_assoc; Apply Rle_monotony.
-Left; Apply H1.
-Apply H4.
-Rewrite Rabsolu_Rinv.
-Replace ``(Vn (S n))*2*/(Rabsolu (An n))`` with ``(2*/(Rabsolu (An n)))*(Vn (S n))``; [Idtac | Ring]; Replace ``2*(3*/2)*(Rabsolu (An (S n)))*/(Rabsolu (An n))`` with ``(2*/(Rabsolu (An n)))*((3*/2)*(Rabsolu (An (S n))))``; [Idtac | Ring]; Apply Rle_monotony.
-Left; Apply Rmult_lt_pos.
-Sup0.
-Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Apply H.
-Elim (H3 (S n)); Intros; Assumption.
-Apply H.
-Intro; Apply Rle_monotony_contra with (Vn n).
-Apply H1.
-Rewrite <- Rinv_r_sym.
-Apply Rle_monotony_contra with (Rabsolu (An n)).
-Apply Rabsolu_pos_lt; Apply H.
-Rewrite Rmult_1r; Replace ``(Rabsolu (An n))*((Vn n)*(2*/(Rabsolu (An n))))`` with ``2*(Vn n)*((Rabsolu (An n))*/(Rabsolu (An n)))``; [Idtac | Ring]; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Apply Rle_monotony_contra with ``/2``.
-Apply Rlt_Rinv; Sup0.
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l; Elim (H3 n); Intros; Assumption.
-DiscrR.
-Apply Rabsolu_no_R0; Apply H.
-Red; Intro; Assert H5 := (H1 n); Rewrite H4 in H5; Elim (Rlt_antirefl ? H5).
-Intro; Split.
-Unfold Vn; Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Sup0.
-Pattern 1 (Rabsolu (An n)); Rewrite <- Rplus_Or; Rewrite double; Rewrite Rplus_assoc; Apply Rle_compatibility.
-Apply Rle_anti_compatibility with ``-(An n)``; Rewrite Rplus_Or; Rewrite <- (Rplus_sym (An n)); Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu.
-Unfold Vn; Unfold Rdiv; Repeat Rewrite <- (Rmult_sym ``/2``); Repeat Rewrite Rmult_assoc; Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Sup0.
-Unfold Rminus; Rewrite double; Replace ``3*(Rabsolu (An n))`` with ``(Rabsolu (An n))+(Rabsolu (An n))+(Rabsolu (An n))``; [Idtac | Ring]; Repeat Rewrite Rplus_assoc; Repeat Apply Rle_compatibility; Apply Rle_Rabsolu.
-Intro; Unfold Wn; Unfold Rdiv; Rewrite <- (Rmult_Or ``/2``); Rewrite <- (Rmult_sym ``/2``); Apply Rlt_monotony.
-Apply Rlt_Rinv; Sup0.
-Apply Rlt_anti_compatibility with (An n); Rewrite Rplus_Or; Unfold Rminus; Rewrite (Rplus_sym (An n)); Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Apply Rle_lt_trans with (Rabsolu (An n)).
-Apply Rle_Rabsolu.
-Rewrite double; Pattern 1 (Rabsolu (An n)); Rewrite <- Rplus_Or; Apply Rlt_compatibility; Apply Rabsolu_pos_lt; Apply H.
-Intro; Unfold Vn; Unfold Rdiv; Rewrite <- (Rmult_Or ``/2``); Rewrite <- (Rmult_sym ``/2``); Apply Rlt_monotony.
-Apply Rlt_Rinv; Sup0.
-Apply Rlt_anti_compatibility with ``-(An n)``; Rewrite Rplus_Or; Unfold Rminus; Rewrite (Rplus_sym ``-(An n)``); Rewrite Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or; Apply Rle_lt_trans with (Rabsolu (An n)).
-Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu.
-Rewrite double; Pattern 1 (Rabsolu (An n)); Rewrite <- Rplus_Or; Apply Rlt_compatibility; Apply Rabsolu_pos_lt; Apply H.
+Lemma Alembert_C2 :
+ forall An:nat -> R,
+ (forall n:nat, An n <> 0) ->
+ Un_cv (fun n:nat => Rabs (An (S n) / An n)) 0 ->
+ sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l).
+intros.
+pose (Vn := fun i:nat => (2 * Rabs (An i) + An i) / 2).
+pose (Wn := fun i:nat => (2 * Rabs (An i) - An i) / 2).
+cut (forall n:nat, 0 < Vn n).
+intro; cut (forall n:nat, 0 < Wn n).
+intro; cut (Un_cv (fun n:nat => Rabs (Vn (S n) / Vn n)) 0).
+intro; cut (Un_cv (fun n:nat => Rabs (Wn (S n) / Wn n)) 0).
+intro; assert (H5 := Alembert_C1 Vn H1 H3).
+assert (H6 := Alembert_C1 Wn H2 H4).
+elim H5; intros.
+elim H6; intros.
+apply existT with (x - x0); unfold Un_cv in |- *; unfold Un_cv in p;
+ unfold Un_cv in p0; intros; cut (0 < eps / 2).
+intro; elim (p (eps / 2) H8); clear p; intros.
+elim (p0 (eps / 2) H8); clear p0; intros.
+pose (N := max x1 x2).
+exists N; intros;
+ replace (sum_f_R0 An n) with (sum_f_R0 Vn n - sum_f_R0 Wn n).
+unfold R_dist in |- *;
+ replace (sum_f_R0 Vn n - sum_f_R0 Wn n - (x - x0)) with
+ (sum_f_R0 Vn n - x + - (sum_f_R0 Wn n - x0)); [ idtac | ring ];
+ apply Rle_lt_trans with
+ (Rabs (sum_f_R0 Vn n - x) + Rabs (- (sum_f_R0 Wn n - x0))).
+apply Rabs_triang.
+rewrite Rabs_Ropp; apply Rlt_le_trans with (eps / 2 + eps / 2).
+apply Rplus_lt_compat.
+unfold R_dist in H9; apply H9; unfold ge in |- *; apply le_trans with N;
+ [ unfold N in |- *; apply le_max_l | assumption ].
+unfold R_dist in H10; apply H10; unfold ge in |- *; apply le_trans with N;
+ [ unfold N in |- *; apply le_max_r | assumption ].
+right; symmetry in |- *; apply double_var.
+symmetry in |- *; apply tech11; intro; unfold Vn, Wn in |- *;
+ unfold Rdiv in |- *; do 2 rewrite <- (Rmult_comm (/ 2));
+ apply Rmult_eq_reg_l with 2.
+rewrite Rmult_minus_distr_l; repeat rewrite <- Rmult_assoc;
+ rewrite <- Rinv_r_sym.
+ring.
+discrR.
+discrR.
+unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
+cut (forall n:nat, / 2 * Rabs (An n) <= Wn n <= 3 * / 2 * Rabs (An n)).
+intro; cut (forall n:nat, / Wn n <= 2 * / Rabs (An n)).
+intro; cut (forall n:nat, Wn (S n) / Wn n <= 3 * Rabs (An (S n) / An n)).
+intro; unfold Un_cv in |- *; intros; unfold Un_cv in H0; cut (0 < eps / 3).
+intro; elim (H0 (eps / 3) H8); intros.
+exists x; intros.
+assert (H11 := H9 n H10).
+unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0;
+ rewrite Rplus_0_r; rewrite Rabs_Rabsolu; unfold R_dist in H11;
+ unfold Rminus in H11; rewrite Ropp_0 in H11; rewrite Rplus_0_r in H11;
+ rewrite Rabs_Rabsolu in H11; rewrite Rabs_right.
+apply Rle_lt_trans with (3 * Rabs (An (S n) / An n)).
+apply H6.
+apply Rmult_lt_reg_l with (/ 3).
+apply Rinv_0_lt_compat; prove_sup0.
+rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ];
+ rewrite Rmult_1_l; rewrite <- (Rmult_comm eps); unfold Rdiv in H11;
+ exact H11.
+left; change (0 < Wn (S n) / Wn n) in |- *; unfold Rdiv in |- *;
+ apply Rmult_lt_0_compat.
+apply H2.
+apply Rinv_0_lt_compat; apply H2.
+unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
+intro; unfold Rdiv in |- *; rewrite Rabs_mult; rewrite <- Rmult_assoc;
+ replace 3 with (2 * (3 * / 2));
+ [ idtac | rewrite <- Rmult_assoc; apply Rinv_r_simpl_m; discrR ];
+ apply Rle_trans with (Wn (S n) * 2 * / Rabs (An n)).
+rewrite Rmult_assoc; apply Rmult_le_compat_l.
+left; apply H2.
+apply H5.
+rewrite Rabs_Rinv.
+replace (Wn (S n) * 2 * / Rabs (An n)) with (2 * / Rabs (An n) * Wn (S n));
+ [ idtac | ring ];
+ replace (2 * (3 * / 2) * Rabs (An (S n)) * / Rabs (An n)) with
+ (2 * / Rabs (An n) * (3 * / 2 * Rabs (An (S n))));
+ [ idtac | ring ]; apply Rmult_le_compat_l.
+left; apply Rmult_lt_0_compat.
+prove_sup0.
+apply Rinv_0_lt_compat; apply Rabs_pos_lt; apply H.
+elim (H4 (S n)); intros; assumption.
+apply H.
+intro; apply Rmult_le_reg_l with (Wn n).
+apply H2.
+rewrite <- Rinv_r_sym.
+apply Rmult_le_reg_l with (Rabs (An n)).
+apply Rabs_pos_lt; apply H.
+rewrite Rmult_1_r;
+ replace (Rabs (An n) * (Wn n * (2 * / Rabs (An n)))) with
+ (2 * Wn n * (Rabs (An n) * / Rabs (An n))); [ idtac | ring ];
+ rewrite <- Rinv_r_sym.
+rewrite Rmult_1_r; apply Rmult_le_reg_l with (/ 2).
+apply Rinv_0_lt_compat; prove_sup0.
+rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
+rewrite Rmult_1_l; elim (H4 n); intros; assumption.
+discrR.
+apply Rabs_no_R0; apply H.
+red in |- *; intro; assert (H6 := H2 n); rewrite H5 in H6;
+ elim (Rlt_irrefl _ H6).
+intro; split.
+unfold Wn in |- *; unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2));
+ apply Rmult_le_compat_l.
+left; apply Rinv_0_lt_compat; prove_sup0.
+pattern (Rabs (An n)) at 1 in |- *; rewrite <- Rplus_0_r; rewrite double;
+ unfold Rminus in |- *; rewrite Rplus_assoc; apply Rplus_le_compat_l.
+apply Rplus_le_reg_l with (An n).
+rewrite Rplus_0_r; rewrite (Rplus_comm (An n)); rewrite Rplus_assoc;
+ rewrite Rplus_opp_l; rewrite Rplus_0_r; apply RRle_abs.
+unfold Wn in |- *; unfold Rdiv in |- *; repeat rewrite <- (Rmult_comm (/ 2));
+ repeat rewrite Rmult_assoc; apply Rmult_le_compat_l.
+left; apply Rinv_0_lt_compat; prove_sup0.
+unfold Rminus in |- *; rewrite double;
+ replace (3 * Rabs (An n)) with (Rabs (An n) + Rabs (An n) + Rabs (An n));
+ [ idtac | ring ]; repeat rewrite Rplus_assoc; repeat apply Rplus_le_compat_l.
+rewrite <- Rabs_Ropp; apply RRle_abs.
+cut (forall n:nat, / 2 * Rabs (An n) <= Vn n <= 3 * / 2 * Rabs (An n)).
+intro; cut (forall n:nat, / Vn n <= 2 * / Rabs (An n)).
+intro; cut (forall n:nat, Vn (S n) / Vn n <= 3 * Rabs (An (S n) / An n)).
+intro; unfold Un_cv in |- *; intros; unfold Un_cv in H1; cut (0 < eps / 3).
+intro; elim (H0 (eps / 3) H7); intros.
+exists x; intros.
+assert (H10 := H8 n H9).
+unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0;
+ rewrite Rplus_0_r; rewrite Rabs_Rabsolu; unfold R_dist in H10;
+ unfold Rminus in H10; rewrite Ropp_0 in H10; rewrite Rplus_0_r in H10;
+ rewrite Rabs_Rabsolu in H10; rewrite Rabs_right.
+apply Rle_lt_trans with (3 * Rabs (An (S n) / An n)).
+apply H5.
+apply Rmult_lt_reg_l with (/ 3).
+apply Rinv_0_lt_compat; prove_sup0.
+rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ];
+ rewrite Rmult_1_l; rewrite <- (Rmult_comm eps); unfold Rdiv in H10;
+ exact H10.
+left; change (0 < Vn (S n) / Vn n) in |- *; unfold Rdiv in |- *;
+ apply Rmult_lt_0_compat.
+apply H1.
+apply Rinv_0_lt_compat; apply H1.
+unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
+intro; unfold Rdiv in |- *; rewrite Rabs_mult; rewrite <- Rmult_assoc;
+ replace 3 with (2 * (3 * / 2));
+ [ idtac | rewrite <- Rmult_assoc; apply Rinv_r_simpl_m; discrR ];
+ apply Rle_trans with (Vn (S n) * 2 * / Rabs (An n)).
+rewrite Rmult_assoc; apply Rmult_le_compat_l.
+left; apply H1.
+apply H4.
+rewrite Rabs_Rinv.
+replace (Vn (S n) * 2 * / Rabs (An n)) with (2 * / Rabs (An n) * Vn (S n));
+ [ idtac | ring ];
+ replace (2 * (3 * / 2) * Rabs (An (S n)) * / Rabs (An n)) with
+ (2 * / Rabs (An n) * (3 * / 2 * Rabs (An (S n))));
+ [ idtac | ring ]; apply Rmult_le_compat_l.
+left; apply Rmult_lt_0_compat.
+prove_sup0.
+apply Rinv_0_lt_compat; apply Rabs_pos_lt; apply H.
+elim (H3 (S n)); intros; assumption.
+apply H.
+intro; apply Rmult_le_reg_l with (Vn n).
+apply H1.
+rewrite <- Rinv_r_sym.
+apply Rmult_le_reg_l with (Rabs (An n)).
+apply Rabs_pos_lt; apply H.
+rewrite Rmult_1_r;
+ replace (Rabs (An n) * (Vn n * (2 * / Rabs (An n)))) with
+ (2 * Vn n * (Rabs (An n) * / Rabs (An n))); [ idtac | ring ];
+ rewrite <- Rinv_r_sym.
+rewrite Rmult_1_r; apply Rmult_le_reg_l with (/ 2).
+apply Rinv_0_lt_compat; prove_sup0.
+rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
+rewrite Rmult_1_l; elim (H3 n); intros; assumption.
+discrR.
+apply Rabs_no_R0; apply H.
+red in |- *; intro; assert (H5 := H1 n); rewrite H4 in H5;
+ elim (Rlt_irrefl _ H5).
+intro; split.
+unfold Vn in |- *; unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2));
+ apply Rmult_le_compat_l.
+left; apply Rinv_0_lt_compat; prove_sup0.
+pattern (Rabs (An n)) at 1 in |- *; rewrite <- Rplus_0_r; rewrite double;
+ rewrite Rplus_assoc; apply Rplus_le_compat_l.
+apply Rplus_le_reg_l with (- An n); rewrite Rplus_0_r;
+ rewrite <- (Rplus_comm (An n)); rewrite <- Rplus_assoc;
+ rewrite Rplus_opp_l; rewrite Rplus_0_l; rewrite <- Rabs_Ropp;
+ apply RRle_abs.
+unfold Vn in |- *; unfold Rdiv in |- *; repeat rewrite <- (Rmult_comm (/ 2));
+ repeat rewrite Rmult_assoc; apply Rmult_le_compat_l.
+left; apply Rinv_0_lt_compat; prove_sup0.
+unfold Rminus in |- *; rewrite double;
+ replace (3 * Rabs (An n)) with (Rabs (An n) + Rabs (An n) + Rabs (An n));
+ [ idtac | ring ]; repeat rewrite Rplus_assoc; repeat apply Rplus_le_compat_l;
+ apply RRle_abs.
+intro; unfold Wn in |- *; unfold Rdiv in |- *; rewrite <- (Rmult_0_r (/ 2));
+ rewrite <- (Rmult_comm (/ 2)); apply Rmult_lt_compat_l.
+apply Rinv_0_lt_compat; prove_sup0.
+apply Rplus_lt_reg_r with (An n); rewrite Rplus_0_r; unfold Rminus in |- *;
+ rewrite (Rplus_comm (An n)); rewrite Rplus_assoc;
+ rewrite Rplus_opp_l; rewrite Rplus_0_r;
+ apply Rle_lt_trans with (Rabs (An n)).
+apply RRle_abs.
+rewrite double; pattern (Rabs (An n)) at 1 in |- *; rewrite <- Rplus_0_r;
+ apply Rplus_lt_compat_l; apply Rabs_pos_lt; apply H.
+intro; unfold Vn in |- *; unfold Rdiv in |- *; rewrite <- (Rmult_0_r (/ 2));
+ rewrite <- (Rmult_comm (/ 2)); apply Rmult_lt_compat_l.
+apply Rinv_0_lt_compat; prove_sup0.
+apply Rplus_lt_reg_r with (- An n); rewrite Rplus_0_r; unfold Rminus in |- *;
+ rewrite (Rplus_comm (- An n)); rewrite Rplus_assoc;
+ rewrite Rplus_opp_r; rewrite Rplus_0_r;
+ apply Rle_lt_trans with (Rabs (An n)).
+rewrite <- Rabs_Ropp; apply RRle_abs.
+rewrite double; pattern (Rabs (An n)) at 1 in |- *; rewrite <- Rplus_0_r;
+ apply Rplus_lt_compat_l; apply Rabs_pos_lt; apply H.
Qed.
-Lemma AlembertC3_step1 : (An:nat->R;x:R) ``x<>0`` -> ((n:nat)``(An n)<>0``) -> (Un_cv [n:nat](Rabsolu ``(An (S n))/(An n)``) ``0``) -> (SigT R [l:R](Pser An x l)).
-Intros; Pose Bn := [i:nat]``(An i)*(pow x i)``.
-Cut (n:nat)``(Bn n)<>0``.
-Intro; Cut (Un_cv [n:nat](Rabsolu ``(Bn (S n))/(Bn n)``) ``0``).
-Intro; Assert H4 := (Alembert_C2 Bn H2 H3).
-Elim H4; Intros.
-Apply Specif.existT with x0; Unfold Bn in p; Apply tech12; Assumption.
-Unfold Un_cv; Intros; Unfold Un_cv in H1; Cut ``0<eps/(Rabsolu x)``.
-Intro; Elim (H1 ``eps/(Rabsolu x)`` H4); Intros.
-Exists x0; Intros; Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_Rabsolu; Unfold Bn; Replace ``((An (S n))*(pow x (S n)))/((An n)*(pow x n))`` with ``(An (S n))/(An n)*x``.
-Rewrite Rabsolu_mult; Apply Rlt_monotony_contra with ``/(Rabsolu x)``.
-Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption.
-Rewrite <- (Rmult_sym (Rabsolu x)); Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l; Rewrite <- (Rmult_sym eps); Unfold Rdiv in H5; Replace ``(Rabsolu ((An (S n))/(An n)))`` with ``(R_dist (Rabsolu ((An (S n))*/(An n))) 0)``.
-Apply H5; Assumption.
-Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_Rabsolu; Unfold Rdiv; Reflexivity.
-Apply Rabsolu_no_R0; Assumption.
-Replace (S n) with (plus n (1)); [Idtac | Ring]; Rewrite pow_add; Unfold Rdiv; Rewrite Rinv_Rmult.
-Replace ``(An (plus n (S O)))*((pow x n)*(pow x (S O)))*(/(An n)*/(pow x n))`` with ``(An (plus n (S O)))*(pow x (S O))*/(An n)*((pow x n)*/(pow x n))``; [Idtac | Ring]; Rewrite <- Rinv_r_sym.
-Simpl; Ring.
-Apply pow_nonzero; Assumption.
-Apply H0.
-Apply pow_nonzero; Assumption.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption].
-Intro; Unfold Bn; Apply prod_neq_R0; [Apply H0 | Apply pow_nonzero; Assumption].
+Lemma AlembertC3_step1 :
+ forall (An:nat -> R) (x:R),
+ x <> 0 ->
+ (forall n:nat, An n <> 0) ->
+ Un_cv (fun n:nat => Rabs (An (S n) / An n)) 0 ->
+ sigT (fun l:R => Pser An x l).
+intros; pose (Bn := fun i:nat => An i * x ^ i).
+cut (forall n:nat, Bn n <> 0).
+intro; cut (Un_cv (fun n:nat => Rabs (Bn (S n) / Bn n)) 0).
+intro; assert (H4 := Alembert_C2 Bn H2 H3).
+elim H4; intros.
+apply existT with x0; unfold Bn in p; apply tech12; assumption.
+unfold Un_cv in |- *; intros; unfold Un_cv in H1; cut (0 < eps / Rabs x).
+intro; elim (H1 (eps / Rabs x) H4); intros.
+exists x0; intros; unfold R_dist in |- *; unfold Rminus in |- *;
+ rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_Rabsolu;
+ unfold Bn in |- *;
+ replace (An (S n) * x ^ S n / (An n * x ^ n)) with (An (S n) / An n * x).
+rewrite Rabs_mult; apply Rmult_lt_reg_l with (/ Rabs x).
+apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption.
+rewrite <- (Rmult_comm (Rabs x)); rewrite <- Rmult_assoc;
+ rewrite <- Rinv_l_sym.
+rewrite Rmult_1_l; rewrite <- (Rmult_comm eps); unfold Rdiv in H5;
+ replace (Rabs (An (S n) / An n)) with (R_dist (Rabs (An (S n) * / An n)) 0).
+apply H5; assumption.
+unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0;
+ rewrite Rplus_0_r; rewrite Rabs_Rabsolu; unfold Rdiv in |- *;
+ reflexivity.
+apply Rabs_no_R0; assumption.
+replace (S n) with (n + 1)%nat; [ idtac | ring ]; rewrite pow_add;
+ unfold Rdiv in |- *; rewrite Rinv_mult_distr.
+replace (An (n + 1)%nat * (x ^ n * x ^ 1) * (/ An n * / x ^ n)) with
+ (An (n + 1)%nat * x ^ 1 * / An n * (x ^ n * / x ^ n));
+ [ idtac | ring ]; rewrite <- Rinv_r_sym.
+simpl in |- *; ring.
+apply pow_nonzero; assumption.
+apply H0.
+apply pow_nonzero; assumption.
+unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ assumption | apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption ].
+intro; unfold Bn in |- *; apply prod_neq_R0;
+ [ apply H0 | apply pow_nonzero; assumption ].
Qed.
-Lemma AlembertC3_step2 : (An:nat->R;x:R) ``x==0`` -> (SigT R [l:R](Pser An x l)).
-Intros; Apply Specif.existT with (An O).
-Unfold Pser; Unfold infinit_sum; Intros; Exists O; Intros; Replace (sum_f_R0 [n0:nat]``(An n0)*(pow x n0)`` n) with (An O).
-Unfold R_dist; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption.
-Induction n.
-Simpl; Ring.
-Rewrite tech5; Rewrite Hrecn; [Rewrite H; Simpl; Ring | Unfold ge; Apply le_O_n].
+Lemma AlembertC3_step2 :
+ forall (An:nat -> R) (x:R), x = 0 -> sigT (fun l:R => Pser An x l).
+intros; apply existT with (An 0%nat).
+unfold Pser in |- *; unfold infinit_sum in |- *; intros; exists 0%nat; intros;
+ replace (sum_f_R0 (fun n0:nat => An n0 * x ^ n0) n) with (An 0%nat).
+unfold R_dist in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r;
+ rewrite Rabs_R0; assumption.
+induction n as [| n Hrecn].
+simpl in |- *; ring.
+rewrite tech5; rewrite Hrecn;
+ [ rewrite H; simpl in |- *; ring | unfold ge in |- *; apply le_O_n ].
Qed.
(* An useful criterion of convergence for power series *)
-Theorem Alembert_C3 : (An:nat->R;x:R) ((n:nat)``(An n)<>0``) -> (Un_cv [n:nat](Rabsolu ``(An (S n))/(An n)``) ``0``) -> (SigT R [l:R](Pser An x l)).
-Intros; Case (total_order_T x R0); Intro.
-Elim s; Intro.
-Cut ``x<>0``.
-Intro; Apply AlembertC3_step1; Assumption.
-Red; Intro; Rewrite H1 in a; Elim (Rlt_antirefl ? a).
-Apply AlembertC3_step2; Assumption.
-Cut ``x<>0``.
-Intro; Apply AlembertC3_step1; Assumption.
-Red; Intro; Rewrite H1 in r; Elim (Rlt_antirefl ? r).
+Theorem Alembert_C3 :
+ forall (An:nat -> R) (x:R),
+ (forall n:nat, An n <> 0) ->
+ Un_cv (fun n:nat => Rabs (An (S n) / An n)) 0 ->
+ sigT (fun l:R => Pser An x l).
+intros; case (total_order_T x 0); intro.
+elim s; intro.
+cut (x <> 0).
+intro; apply AlembertC3_step1; assumption.
+red in |- *; intro; rewrite H1 in a; elim (Rlt_irrefl _ a).
+apply AlembertC3_step2; assumption.
+cut (x <> 0).
+intro; apply AlembertC3_step1; assumption.
+red in |- *; intro; rewrite H1 in r; elim (Rlt_irrefl _ r).
Qed.
-Lemma Alembert_C4 : (An:nat->R;k:R) ``0<=k<1`` -> ((n:nat)``0<(An n)``) -> (Un_cv [n:nat](Rabsolu ``(An (S n))/(An n)``) k) -> (SigT R [l:R](Un_cv [N:nat](sum_f_R0 An N) l)).
-Intros An k Hyp H H0.
-Cut (sigTT R [l:R](is_lub (EUn [N:nat](sum_f_R0 An N)) l)) -> (SigT R [l:R](Un_cv [N:nat](sum_f_R0 An N) l)).
-Intro; Apply X.
-Apply complet.
-Assert H1 := (tech13 ? ? Hyp H0).
-Elim H1; Intros.
-Elim H2; Intros.
-Elim H4; Intros.
-Unfold bound; Exists ``(sum_f_R0 An x0)+/(1-x)*(An (S x0))``.
-Unfold is_upper_bound; Intros; Unfold EUn in H6.
-Elim H6; Intros.
-Rewrite H7.
-Assert H8 := (lt_eq_lt_dec x2 x0).
-Elim H8; Intros.
-Elim a; Intro.
-Replace (sum_f_R0 An x0) with (Rplus (sum_f_R0 An x2) (sum_f_R0 [i:nat](An (plus (S x2) i)) (minus x0 (S x2)))).
-Pattern 1 (sum_f_R0 An x2); Rewrite <- Rplus_Or.
-Rewrite Rplus_assoc; Apply Rle_compatibility.
-Left; Apply gt0_plus_gt0_is_gt0.
-Apply tech1.
-Intros; Apply H.
-Apply Rmult_lt_pos.
-Apply Rlt_Rinv; Apply Rlt_anti_compatibility with x; Rewrite Rplus_Or; Replace ``x+(1-x)`` with R1; [Elim H3; Intros; Assumption | Ring].
-Apply H.
-Symmetry; Apply tech2; Assumption.
-Rewrite b; Pattern 1 (sum_f_R0 An x0); Rewrite <- Rplus_Or; Apply Rle_compatibility.
-Left; Apply Rmult_lt_pos.
-Apply Rlt_Rinv; Apply Rlt_anti_compatibility with x; Rewrite Rplus_Or; Replace ``x+(1-x)`` with R1; [Elim H3; Intros; Assumption | Ring].
-Apply H.
-Replace (sum_f_R0 An x2) with (Rplus (sum_f_R0 An x0) (sum_f_R0 [i:nat](An (plus (S x0) i)) (minus x2 (S x0)))).
-Apply Rle_compatibility.
-Cut (Rle (sum_f_R0 [i:nat](An (plus (S x0) i)) (minus x2 (S x0))) (Rmult (An (S x0)) (sum_f_R0 [i:nat](pow x i) (minus x2 (S x0))))).
-Intro; Apply Rle_trans with (Rmult (An (S x0)) (sum_f_R0 [i:nat](pow x i) (minus x2 (S x0)))).
-Assumption.
-Rewrite <- (Rmult_sym (An (S x0))); Apply Rle_monotony.
-Left; Apply H.
-Rewrite tech3.
-Unfold Rdiv; Apply Rle_monotony_contra with ``1-x``.
-Apply Rlt_anti_compatibility with x; Rewrite Rplus_Or.
-Replace ``x+(1-x)`` with R1; [Elim H3; Intros; Assumption | Ring].
-Do 2 Rewrite (Rmult_sym ``1-x``).
-Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Apply Rle_anti_compatibility with ``(pow x (S (minus x2 (S x0))))``.
-Replace ``(pow x (S (minus x2 (S x0))))+(1-(pow x (S (minus x2 (S x0)))))`` with R1; [Idtac | Ring].
-Rewrite <- (Rplus_sym R1); Pattern 1 R1; Rewrite <- Rplus_Or; Apply Rle_compatibility.
-Left; Apply pow_lt.
-Apply Rle_lt_trans with k.
-Elim Hyp; Intros; Assumption.
-Elim H3; Intros; Assumption.
-Apply Rminus_eq_contra.
-Red; Intro.
-Elim H3; Intros.
-Rewrite H10 in H12; Elim (Rlt_antirefl ? H12).
-Red; Intro.
-Elim H3; Intros.
-Rewrite H10 in H12; Elim (Rlt_antirefl ? H12).
-Replace (An (S x0)) with (An (plus (S x0) O)).
-Apply (tech6 [i:nat](An (plus (S x0) i)) x).
-Left; Apply Rle_lt_trans with k.
-Elim Hyp; Intros; Assumption.
-Elim H3; Intros; Assumption.
-Intro.
-Cut (n:nat)(ge n x0)->``(An (S n))<x*(An n)``.
-Intro.
-Replace (plus (S x0) (S i)) with (S (plus (S x0) i)).
-Apply H9.
-Unfold ge.
-Apply tech8.
- Apply INR_eq; Rewrite S_INR; Do 2 Rewrite plus_INR; Do 2 Rewrite S_INR; Ring.
-Intros.
-Apply Rlt_monotony_contra with ``/(An n)``.
-Apply Rlt_Rinv; Apply H.
-Do 2 Rewrite (Rmult_sym ``/(An n)``).
-Rewrite Rmult_assoc.
-Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r.
-Replace ``(An (S n))*/(An n)`` with ``(Rabsolu ((An (S n))/(An n)))``.
-Apply H5; Assumption.
-Rewrite Rabsolu_right.
-Unfold Rdiv; Reflexivity.
-Left; Unfold Rdiv; Change ``0<(An (S n))*/(An n)``; Apply Rmult_lt_pos.
-Apply H.
-Apply Rlt_Rinv; Apply H.
-Red; Intro.
-Assert H11 := (H n).
-Rewrite H10 in H11; Elim (Rlt_antirefl ? H11).
-Replace (plus (S x0) O) with (S x0); [Reflexivity | Ring].
-Symmetry; Apply tech2; Assumption.
-Exists (sum_f_R0 An O); Unfold EUn; Exists O; Reflexivity.
-Intro; Elim X; Intros.
-Apply Specif.existT with x; Apply tech10; [Unfold Un_growing; Intro; Rewrite tech5; Pattern 1 (sum_f_R0 An n); Rewrite <- Rplus_Or; Apply Rle_compatibility; Left; Apply H | Apply p].
+Lemma Alembert_C4 :
+ forall (An:nat -> R) (k:R),
+ 0 <= k < 1 ->
+ (forall n:nat, 0 < An n) ->
+ Un_cv (fun n:nat => Rabs (An (S n) / An n)) k ->
+ sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l).
+intros An k Hyp H H0.
+cut
+ (sigT (fun l:R => is_lub (EUn (fun N:nat => sum_f_R0 An N)) l) ->
+ sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l)).
+intro; apply X.
+apply completeness.
+assert (H1 := tech13 _ _ Hyp H0).
+elim H1; intros.
+elim H2; intros.
+elim H4; intros.
+unfold bound in |- *; exists (sum_f_R0 An x0 + / (1 - x) * An (S x0)).
+unfold is_upper_bound in |- *; intros; unfold EUn in H6.
+elim H6; intros.
+rewrite H7.
+assert (H8 := lt_eq_lt_dec x2 x0).
+elim H8; intros.
+elim a; intro.
+replace (sum_f_R0 An x0) with
+ (sum_f_R0 An x2 + sum_f_R0 (fun i:nat => An (S x2 + i)%nat) (x0 - S x2)).
+pattern (sum_f_R0 An x2) at 1 in |- *; rewrite <- Rplus_0_r.
+rewrite Rplus_assoc; apply Rplus_le_compat_l.
+left; apply Rplus_lt_0_compat.
+apply tech1.
+intros; apply H.
+apply Rmult_lt_0_compat.
+apply Rinv_0_lt_compat; apply Rplus_lt_reg_r with x; rewrite Rplus_0_r;
+ replace (x + (1 - x)) with 1; [ elim H3; intros; assumption | ring ].
+apply H.
+symmetry in |- *; apply tech2; assumption.
+rewrite b; pattern (sum_f_R0 An x0) at 1 in |- *; rewrite <- Rplus_0_r;
+ apply Rplus_le_compat_l.
+left; apply Rmult_lt_0_compat.
+apply Rinv_0_lt_compat; apply Rplus_lt_reg_r with x; rewrite Rplus_0_r;
+ replace (x + (1 - x)) with 1; [ elim H3; intros; assumption | ring ].
+apply H.
+replace (sum_f_R0 An x2) with
+ (sum_f_R0 An x0 + sum_f_R0 (fun i:nat => An (S x0 + i)%nat) (x2 - S x0)).
+apply Rplus_le_compat_l.
+cut
+ (sum_f_R0 (fun i:nat => An (S x0 + i)%nat) (x2 - S x0) <=
+ An (S x0) * sum_f_R0 (fun i:nat => x ^ i) (x2 - S x0)).
+intro;
+ apply Rle_trans with (An (S x0) * sum_f_R0 (fun i:nat => x ^ i) (x2 - S x0)).
+assumption.
+rewrite <- (Rmult_comm (An (S x0))); apply Rmult_le_compat_l.
+left; apply H.
+rewrite tech3.
+unfold Rdiv in |- *; apply Rmult_le_reg_l with (1 - x).
+apply Rplus_lt_reg_r with x; rewrite Rplus_0_r.
+replace (x + (1 - x)) with 1; [ elim H3; intros; assumption | ring ].
+do 2 rewrite (Rmult_comm (1 - x)).
+rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r; apply Rplus_le_reg_l with (x ^ S (x2 - S x0)).
+replace (x ^ S (x2 - S x0) + (1 - x ^ S (x2 - S x0))) with 1;
+ [ idtac | ring ].
+rewrite <- (Rplus_comm 1); pattern 1 at 1 in |- *; rewrite <- Rplus_0_r;
+ apply Rplus_le_compat_l.
+left; apply pow_lt.
+apply Rle_lt_trans with k.
+elim Hyp; intros; assumption.
+elim H3; intros; assumption.
+apply Rminus_eq_contra.
+red in |- *; intro.
+elim H3; intros.
+rewrite H10 in H12; elim (Rlt_irrefl _ H12).
+red in |- *; intro.
+elim H3; intros.
+rewrite H10 in H12; elim (Rlt_irrefl _ H12).
+replace (An (S x0)) with (An (S x0 + 0)%nat).
+apply (tech6 (fun i:nat => An (S x0 + i)%nat) x).
+left; apply Rle_lt_trans with k.
+elim Hyp; intros; assumption.
+elim H3; intros; assumption.
+intro.
+cut (forall n:nat, (n >= x0)%nat -> An (S n) < x * An n).
+intro.
+replace (S x0 + S i)%nat with (S (S x0 + i)).
+apply H9.
+unfold ge in |- *.
+apply tech8.
+ apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; do 2 rewrite S_INR;
+ ring.
+intros.
+apply Rmult_lt_reg_l with (/ An n).
+apply Rinv_0_lt_compat; apply H.
+do 2 rewrite (Rmult_comm (/ An n)).
+rewrite Rmult_assoc.
+rewrite <- Rinv_r_sym.
+rewrite Rmult_1_r.
+replace (An (S n) * / An n) with (Rabs (An (S n) / An n)).
+apply H5; assumption.
+rewrite Rabs_right.
+unfold Rdiv in |- *; reflexivity.
+left; unfold Rdiv in |- *; change (0 < An (S n) * / An n) in |- *;
+ apply Rmult_lt_0_compat.
+apply H.
+apply Rinv_0_lt_compat; apply H.
+red in |- *; intro.
+assert (H11 := H n).
+rewrite H10 in H11; elim (Rlt_irrefl _ H11).
+replace (S x0 + 0)%nat with (S x0); [ reflexivity | ring ].
+symmetry in |- *; apply tech2; assumption.
+exists (sum_f_R0 An 0); unfold EUn in |- *; exists 0%nat; reflexivity.
+intro; elim X; intros.
+apply existT with x; apply tech10;
+ [ unfold Un_growing in |- *; intro; rewrite tech5;
+ pattern (sum_f_R0 An n) at 1 in |- *; rewrite <- Rplus_0_r;
+ apply Rplus_le_compat_l; left; apply H
+ | apply p ].
Qed.
-Lemma Alembert_C5 : (An:nat->R;k:R) ``0<=k<1`` -> ((n:nat)``(An n)<>0``) -> (Un_cv [n:nat](Rabsolu ``(An (S n))/(An n)``) k) -> (SigT R [l:R](Un_cv [N:nat](sum_f_R0 An N) l)).
-Intros.
-Cut (sigTT R [l:R](Un_cv [N:nat](sum_f_R0 An N) l)) -> (SigT R [l:R](Un_cv [N:nat](sum_f_R0 An N) l)).
-Intro Hyp0; Apply Hyp0.
-Apply cv_cauchy_2.
-Apply cauchy_abs.
-Apply cv_cauchy_1.
-Cut (SigT R [l:R](Un_cv [N:nat](sum_f_R0 [i:nat](Rabsolu (An i)) N) l)) -> (sigTT R [l:R](Un_cv [N:nat](sum_f_R0 [i:nat](Rabsolu (An i)) N) l)).
-Intro Hyp; Apply Hyp.
-Apply (Alembert_C4 [i:nat](Rabsolu (An i)) k).
-Assumption.
-Intro; Apply Rabsolu_pos_lt; Apply H0.
-Unfold Un_cv.
-Unfold Un_cv in H1.
-Unfold Rdiv.
-Intros.
-Elim (H1 eps H2); Intros.
-Exists x; Intros.
-Rewrite <- Rabsolu_Rinv.
-Rewrite <- Rabsolu_mult.
-Rewrite Rabsolu_Rabsolu.
-Unfold Rdiv in H3; Apply H3; Assumption.
-Apply H0.
-Intro.
-Elim X; Intros.
-Apply existTT with x.
-Assumption.
-Intro.
-Elim X; Intros.
-Apply Specif.existT with x.
-Assumption.
+Lemma Alembert_C5 :
+ forall (An:nat -> R) (k:R),
+ 0 <= k < 1 ->
+ (forall n:nat, An n <> 0) ->
+ Un_cv (fun n:nat => Rabs (An (S n) / An n)) k ->
+ sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l).
+intros.
+cut
+ (sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l) ->
+ sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l)).
+intro Hyp0; apply Hyp0.
+apply cv_cauchy_2.
+apply cauchy_abs.
+apply cv_cauchy_1.
+cut
+ (sigT
+ (fun l:R => Un_cv (fun N:nat => sum_f_R0 (fun i:nat => Rabs (An i)) N) l) ->
+ sigT
+ (fun l:R => Un_cv (fun N:nat => sum_f_R0 (fun i:nat => Rabs (An i)) N) l)).
+intro Hyp; apply Hyp.
+apply (Alembert_C4 (fun i:nat => Rabs (An i)) k).
+assumption.
+intro; apply Rabs_pos_lt; apply H0.
+unfold Un_cv in |- *.
+unfold Un_cv in H1.
+unfold Rdiv in |- *.
+intros.
+elim (H1 eps H2); intros.
+exists x; intros.
+rewrite <- Rabs_Rinv.
+rewrite <- Rabs_mult.
+rewrite Rabs_Rabsolu.
+unfold Rdiv in H3; apply H3; assumption.
+apply H0.
+intro.
+elim X; intros.
+apply existT with x.
+assumption.
+intro.
+elim X; intros.
+apply existT with x.
+assumption.
Qed.
(* Convergence of power series in D(O,1/k) *)
(* k=0 is described in Alembert_C3 *)
-Lemma Alembert_C6 : (An:nat->R;x,k:R) ``0<k`` -> ((n:nat)``(An n)<>0``) -> (Un_cv [n:nat](Rabsolu ``(An (S n))/(An n)``) k) -> ``(Rabsolu x)</k`` -> (SigT R [l:R](Pser An x l)).
-Intros.
-Cut (SigT R [l:R](Un_cv [N:nat](sum_f_R0 [i:nat]``(An i)*(pow x i)`` N) l)).
-Intro.
-Elim X; Intros.
-Apply Specif.existT with x0.
-Apply tech12; Assumption.
-Case (total_order_T x R0); Intro.
-Elim s; Intro.
-EApply Alembert_C5 with ``k*(Rabsolu x)``.
-Split.
-Unfold Rdiv; Apply Rmult_le_pos.
-Left; Assumption.
-Left; Apply Rabsolu_pos_lt.
-Red; Intro; Rewrite H3 in a; Elim (Rlt_antirefl ? a).
-Apply Rlt_monotony_contra with ``/k``.
-Apply Rlt_Rinv; Assumption.
-Rewrite <- Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l.
-Rewrite Rmult_1r; Assumption.
-Red; Intro; Rewrite H3 in H; Elim (Rlt_antirefl ? H).
-Intro; Apply prod_neq_R0.
-Apply H0.
-Apply pow_nonzero.
-Red; Intro; Rewrite H3 in a; Elim (Rlt_antirefl ? a).
-Unfold Un_cv; Unfold Un_cv in H1.
-Intros.
-Cut ``0<eps/(Rabsolu x)``.
-Intro.
-Elim (H1 ``eps/(Rabsolu x)`` H4); Intros.
-Exists x0.
-Intros.
-Replace ``((An (S n))*(pow x (S n)))/((An n)*(pow x n))`` with ``(An (S n))/(An n)*x``.
-Unfold R_dist.
-Rewrite Rabsolu_mult.
-Replace ``(Rabsolu ((An (S n))/(An n)))*(Rabsolu x)-k*(Rabsolu x)`` with ``(Rabsolu x)*((Rabsolu ((An (S n))/(An n)))-k)``; [Idtac | Ring].
-Rewrite Rabsolu_mult.
-Rewrite Rabsolu_Rabsolu.
-Apply Rlt_monotony_contra with ``/(Rabsolu x)``.
-Apply Rlt_Rinv; Apply Rabsolu_pos_lt.
-Red; Intro; Rewrite H7 in a; Elim (Rlt_antirefl ? a).
-Rewrite <- Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l.
-Rewrite <- (Rmult_sym eps).
-Unfold R_dist in H5.
-Unfold Rdiv; Unfold Rdiv in H5; Apply H5; Assumption.
-Apply Rabsolu_no_R0.
-Red; Intro; Rewrite H7 in a; Elim (Rlt_antirefl ? a).
-Unfold Rdiv; Replace (S n) with (plus n (1)); [Idtac | Ring].
-Rewrite pow_add.
-Simpl.
-Rewrite Rmult_1r.
-Rewrite Rinv_Rmult.
-Replace ``(An (plus n (S O)))*((pow x n)*x)*(/(An n)*/(pow x n))`` with ``(An (plus n (S O)))*/(An n)*x*((pow x n)*/(pow x n))``; [Idtac | Ring].
-Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Reflexivity.
-Apply pow_nonzero.
-Red; Intro; Rewrite H7 in a; Elim (Rlt_antirefl ? a).
-Apply H0.
-Apply pow_nonzero.
-Red; Intro; Rewrite H7 in a; Elim (Rlt_antirefl ? a).
-Unfold Rdiv; Apply Rmult_lt_pos.
-Assumption.
-Apply Rlt_Rinv; Apply Rabsolu_pos_lt.
-Red; Intro H7; Rewrite H7 in a; Elim (Rlt_antirefl ? a).
-Apply Specif.existT with (An O).
-Unfold Un_cv.
-Intros.
-Exists O.
-Intros.
-Unfold R_dist.
-Replace (sum_f_R0 [i:nat]``(An i)*(pow x i)`` n) with (An O).
-Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption.
-Induction n.
-Simpl; Ring.
-Rewrite tech5.
-Rewrite <- Hrecn.
-Rewrite b; Simpl; Ring.
-Unfold ge; Apply le_O_n.
-EApply Alembert_C5 with ``k*(Rabsolu x)``.
-Split.
-Unfold Rdiv; Apply Rmult_le_pos.
-Left; Assumption.
-Left; Apply Rabsolu_pos_lt.
-Red; Intro; Rewrite H3 in r; Elim (Rlt_antirefl ? r).
-Apply Rlt_monotony_contra with ``/k``.
-Apply Rlt_Rinv; Assumption.
-Rewrite <- Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l.
-Rewrite Rmult_1r; Assumption.
-Red; Intro; Rewrite H3 in H; Elim (Rlt_antirefl ? H).
-Intro; Apply prod_neq_R0.
-Apply H0.
-Apply pow_nonzero.
-Red; Intro; Rewrite H3 in r; Elim (Rlt_antirefl ? r).
-Unfold Un_cv; Unfold Un_cv in H1.
-Intros.
-Cut ``0<eps/(Rabsolu x)``.
-Intro.
-Elim (H1 ``eps/(Rabsolu x)`` H4); Intros.
-Exists x0.
-Intros.
-Replace ``((An (S n))*(pow x (S n)))/((An n)*(pow x n))`` with ``(An (S n))/(An n)*x``.
-Unfold R_dist.
-Rewrite Rabsolu_mult.
-Replace ``(Rabsolu ((An (S n))/(An n)))*(Rabsolu x)-k*(Rabsolu x)`` with ``(Rabsolu x)*((Rabsolu ((An (S n))/(An n)))-k)``; [Idtac | Ring].
-Rewrite Rabsolu_mult.
-Rewrite Rabsolu_Rabsolu.
-Apply Rlt_monotony_contra with ``/(Rabsolu x)``.
-Apply Rlt_Rinv; Apply Rabsolu_pos_lt.
-Red; Intro; Rewrite H7 in r; Elim (Rlt_antirefl ? r).
-Rewrite <- Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l.
-Rewrite <- (Rmult_sym eps).
-Unfold R_dist in H5.
-Unfold Rdiv; Unfold Rdiv in H5; Apply H5; Assumption.
-Apply Rabsolu_no_R0.
-Red; Intro; Rewrite H7 in r; Elim (Rlt_antirefl ? r).
-Unfold Rdiv; Replace (S n) with (plus n (1)); [Idtac | Ring].
-Rewrite pow_add.
-Simpl.
-Rewrite Rmult_1r.
-Rewrite Rinv_Rmult.
-Replace ``(An (plus n (S O)))*((pow x n)*x)*(/(An n)*/(pow x n))`` with ``(An (plus n (S O)))*/(An n)*x*((pow x n)*/(pow x n))``; [Idtac | Ring].
-Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Reflexivity.
-Apply pow_nonzero.
-Red; Intro; Rewrite H7 in r; Elim (Rlt_antirefl ? r).
-Apply H0.
-Apply pow_nonzero.
-Red; Intro; Rewrite H7 in r; Elim (Rlt_antirefl ? r).
-Unfold Rdiv; Apply Rmult_lt_pos.
-Assumption.
-Apply Rlt_Rinv; Apply Rabsolu_pos_lt.
-Red; Intro H7; Rewrite H7 in r; Elim (Rlt_antirefl ? r).
-Qed.
+Lemma Alembert_C6 :
+ forall (An:nat -> R) (x k:R),
+ 0 < k ->
+ (forall n:nat, An n <> 0) ->
+ Un_cv (fun n:nat => Rabs (An (S n) / An n)) k ->
+ Rabs x < / k -> sigT (fun l:R => Pser An x l).
+intros.
+cut
+ (sigT
+ (fun l:R => Un_cv (fun N:nat => sum_f_R0 (fun i:nat => An i * x ^ i) N) l)).
+intro.
+elim X; intros.
+apply existT with x0.
+apply tech12; assumption.
+case (total_order_T x 0); intro.
+elim s; intro.
+eapply Alembert_C5 with (k * Rabs x).
+split.
+unfold Rdiv in |- *; apply Rmult_le_pos.
+left; assumption.
+left; apply Rabs_pos_lt.
+red in |- *; intro; rewrite H3 in a; elim (Rlt_irrefl _ a).
+apply Rmult_lt_reg_l with (/ k).
+apply Rinv_0_lt_compat; assumption.
+rewrite <- Rmult_assoc.
+rewrite <- Rinv_l_sym.
+rewrite Rmult_1_l.
+rewrite Rmult_1_r; assumption.
+red in |- *; intro; rewrite H3 in H; elim (Rlt_irrefl _ H).
+intro; apply prod_neq_R0.
+apply H0.
+apply pow_nonzero.
+red in |- *; intro; rewrite H3 in a; elim (Rlt_irrefl _ a).
+unfold Un_cv in |- *; unfold Un_cv in H1.
+intros.
+cut (0 < eps / Rabs x).
+intro.
+elim (H1 (eps / Rabs x) H4); intros.
+exists x0.
+intros.
+replace (An (S n) * x ^ S n / (An n * x ^ n)) with (An (S n) / An n * x).
+unfold R_dist in |- *.
+rewrite Rabs_mult.
+replace (Rabs (An (S n) / An n) * Rabs x - k * Rabs x) with
+ (Rabs x * (Rabs (An (S n) / An n) - k)); [ idtac | ring ].
+rewrite Rabs_mult.
+rewrite Rabs_Rabsolu.
+apply Rmult_lt_reg_l with (/ Rabs x).
+apply Rinv_0_lt_compat; apply Rabs_pos_lt.
+red in |- *; intro; rewrite H7 in a; elim (Rlt_irrefl _ a).
+rewrite <- Rmult_assoc.
+rewrite <- Rinv_l_sym.
+rewrite Rmult_1_l.
+rewrite <- (Rmult_comm eps).
+unfold R_dist in H5.
+unfold Rdiv in |- *; unfold Rdiv in H5; apply H5; assumption.
+apply Rabs_no_R0.
+red in |- *; intro; rewrite H7 in a; elim (Rlt_irrefl _ a).
+unfold Rdiv in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ].
+rewrite pow_add.
+simpl in |- *.
+rewrite Rmult_1_r.
+rewrite Rinv_mult_distr.
+replace (An (n + 1)%nat * (x ^ n * x) * (/ An n * / x ^ n)) with
+ (An (n + 1)%nat * / An n * x * (x ^ n * / x ^ n));
+ [ idtac | ring ].
+rewrite <- Rinv_r_sym.
+rewrite Rmult_1_r; reflexivity.
+apply pow_nonzero.
+red in |- *; intro; rewrite H7 in a; elim (Rlt_irrefl _ a).
+apply H0.
+apply pow_nonzero.
+red in |- *; intro; rewrite H7 in a; elim (Rlt_irrefl _ a).
+unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+assumption.
+apply Rinv_0_lt_compat; apply Rabs_pos_lt.
+red in |- *; intro H7; rewrite H7 in a; elim (Rlt_irrefl _ a).
+apply existT with (An 0%nat).
+unfold Un_cv in |- *.
+intros.
+exists 0%nat.
+intros.
+unfold R_dist in |- *.
+replace (sum_f_R0 (fun i:nat => An i * x ^ i) n) with (An 0%nat).
+unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption.
+induction n as [| n Hrecn].
+simpl in |- *; ring.
+rewrite tech5.
+rewrite <- Hrecn.
+rewrite b; simpl in |- *; ring.
+unfold ge in |- *; apply le_O_n.
+eapply Alembert_C5 with (k * Rabs x).
+split.
+unfold Rdiv in |- *; apply Rmult_le_pos.
+left; assumption.
+left; apply Rabs_pos_lt.
+red in |- *; intro; rewrite H3 in r; elim (Rlt_irrefl _ r).
+apply Rmult_lt_reg_l with (/ k).
+apply Rinv_0_lt_compat; assumption.
+rewrite <- Rmult_assoc.
+rewrite <- Rinv_l_sym.
+rewrite Rmult_1_l.
+rewrite Rmult_1_r; assumption.
+red in |- *; intro; rewrite H3 in H; elim (Rlt_irrefl _ H).
+intro; apply prod_neq_R0.
+apply H0.
+apply pow_nonzero.
+red in |- *; intro; rewrite H3 in r; elim (Rlt_irrefl _ r).
+unfold Un_cv in |- *; unfold Un_cv in H1.
+intros.
+cut (0 < eps / Rabs x).
+intro.
+elim (H1 (eps / Rabs x) H4); intros.
+exists x0.
+intros.
+replace (An (S n) * x ^ S n / (An n * x ^ n)) with (An (S n) / An n * x).
+unfold R_dist in |- *.
+rewrite Rabs_mult.
+replace (Rabs (An (S n) / An n) * Rabs x - k * Rabs x) with
+ (Rabs x * (Rabs (An (S n) / An n) - k)); [ idtac | ring ].
+rewrite Rabs_mult.
+rewrite Rabs_Rabsolu.
+apply Rmult_lt_reg_l with (/ Rabs x).
+apply Rinv_0_lt_compat; apply Rabs_pos_lt.
+red in |- *; intro; rewrite H7 in r; elim (Rlt_irrefl _ r).
+rewrite <- Rmult_assoc.
+rewrite <- Rinv_l_sym.
+rewrite Rmult_1_l.
+rewrite <- (Rmult_comm eps).
+unfold R_dist in H5.
+unfold Rdiv in |- *; unfold Rdiv in H5; apply H5; assumption.
+apply Rabs_no_R0.
+red in |- *; intro; rewrite H7 in r; elim (Rlt_irrefl _ r).
+unfold Rdiv in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ].
+rewrite pow_add.
+simpl in |- *.
+rewrite Rmult_1_r.
+rewrite Rinv_mult_distr.
+replace (An (n + 1)%nat * (x ^ n * x) * (/ An n * / x ^ n)) with
+ (An (n + 1)%nat * / An n * x * (x ^ n * / x ^ n));
+ [ idtac | ring ].
+rewrite <- Rinv_r_sym.
+rewrite Rmult_1_r; reflexivity.
+apply pow_nonzero.
+red in |- *; intro; rewrite H7 in r; elim (Rlt_irrefl _ r).
+apply H0.
+apply pow_nonzero.
+red in |- *; intro; rewrite H7 in r; elim (Rlt_irrefl _ r).
+unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+assumption.
+apply Rinv_0_lt_compat; apply Rabs_pos_lt.
+red in |- *; intro H7; rewrite H7 in r; elim (Rlt_irrefl _ r).
+Qed. \ No newline at end of file
diff --git a/theories/Reals/AltSeries.v b/theories/Reals/AltSeries.v
index c35f18a73..e9be3fc02 100644
--- a/theories/Reals/AltSeries.v
+++ b/theories/Reals/AltSeries.v
@@ -8,156 +8,204 @@
(*i $Id$ i*)
-Require Rbase.
-Require Rfunctions.
-Require Rseries.
-Require SeqProp.
-Require PartSum.
-Require Max.
-V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
+Require Import Rbase.
+Require Import Rfunctions.
+Require Import Rseries.
+Require Import SeqProp.
+Require Import PartSum.
+Require Import Max.
Open Local Scope R_scope.
(**********)
-Definition tg_alt [Un:nat->R] : nat->R := [i:nat]``(pow (-1) i)*(Un i)``.
-Definition positivity_seq [Un:nat->R] : Prop := (n:nat)``0<=(Un n)``.
+Definition tg_alt (Un:nat -> R) (i:nat) : R := (-1) ^ i * Un i.
+Definition positivity_seq (Un:nat -> R) : Prop := forall n:nat, 0 <= Un n.
-Lemma CV_ALT_step0 : (Un:nat->R) (Un_decreasing Un) -> (Un_growing [N:nat](sum_f_R0 (tg_alt Un) (S (mult (2) N)))).
-Intros; Unfold Un_growing; Intro.
-Cut (mult (S (S O)) (S n)) = (S (S (mult (2) n))).
-Intro; Rewrite H0.
-Do 4 Rewrite tech5; Repeat Rewrite Rplus_assoc; Apply Rle_compatibility.
-Pattern 1 (tg_alt Un (S (mult (S (S O)) n))); Rewrite <- Rplus_Or.
-Apply Rle_compatibility.
-Unfold tg_alt; Rewrite <- H0; Rewrite pow_1_odd; Rewrite pow_1_even; Rewrite Rmult_1l.
-Apply Rle_anti_compatibility with ``(Un (S (mult (S (S O)) (S n))))``.
-Rewrite Rplus_Or; Replace ``(Un (S (mult (S (S O)) (S n))))+((Un (mult (S (S O)) (S n)))+ -1*(Un (S (mult (S (S O)) (S n)))))`` with ``(Un (mult (S (S O)) (S n)))``; [Idtac | Ring].
-Apply H.
-Cut (n:nat) (S n)=(plus n (1)); [Intro | Intro; Ring].
-Rewrite (H0 n); Rewrite (H0 (S (mult (2) n))); Rewrite (H0 (mult (2) n)); Ring.
+Lemma CV_ALT_step0 :
+ forall Un:nat -> R,
+ Un_decreasing Un ->
+ Un_growing (fun N:nat => sum_f_R0 (tg_alt Un) (S (2 * N))).
+intros; unfold Un_growing in |- *; intro.
+cut ((2 * S n)%nat = S (S (2 * n))).
+intro; rewrite H0.
+do 4 rewrite tech5; repeat rewrite Rplus_assoc; apply Rplus_le_compat_l.
+pattern (tg_alt Un (S (2 * n))) at 1 in |- *; rewrite <- Rplus_0_r.
+apply Rplus_le_compat_l.
+unfold tg_alt in |- *; rewrite <- H0; rewrite pow_1_odd; rewrite pow_1_even;
+ rewrite Rmult_1_l.
+apply Rplus_le_reg_l with (Un (S (2 * S n))).
+rewrite Rplus_0_r;
+ replace (Un (S (2 * S n)) + (Un (2 * S n)%nat + -1 * Un (S (2 * S n)))) with
+ (Un (2 * S n)%nat); [ idtac | ring ].
+apply H.
+cut (forall n:nat, S n = (n + 1)%nat); [ intro | intro; ring ].
+rewrite (H0 n); rewrite (H0 (S (2 * n))); rewrite (H0 (2 * n)%nat); ring.
Qed.
-Lemma CV_ALT_step1 : (Un:nat->R) (Un_decreasing Un) -> (Un_decreasing [N:nat](sum_f_R0 (tg_alt Un) (mult (2) N))).
-Intros; Unfold Un_decreasing; Intro.
-Cut (mult (S (S O)) (S n)) = (S (S (mult (2) n))).
-Intro; Rewrite H0; Do 2 Rewrite tech5; Repeat Rewrite Rplus_assoc.
-Pattern 2 (sum_f_R0 (tg_alt Un) (mult (S (S O)) n)); Rewrite <- Rplus_Or.
-Apply Rle_compatibility.
-Unfold tg_alt; Rewrite <- H0; Rewrite pow_1_odd; Rewrite pow_1_even; Rewrite Rmult_1l.
-Apply Rle_anti_compatibility with ``(Un (S (mult (S (S O)) n)))``.
-Rewrite Rplus_Or; Replace ``(Un (S (mult (S (S O)) n)))+( -1*(Un (S (mult (S (S O)) n)))+(Un (mult (S (S O)) (S n))))`` with ``(Un (mult (S (S O)) (S n)))``; [Idtac | Ring].
-Rewrite H0; Apply H.
-Cut (n:nat) (S n)=(plus n (1)); [Intro | Intro; Ring].
-Rewrite (H0 n); Rewrite (H0 (S (mult (2) n))); Rewrite (H0 (mult (2) n)); Ring.
+Lemma CV_ALT_step1 :
+ forall Un:nat -> R,
+ Un_decreasing Un ->
+ Un_decreasing (fun N:nat => sum_f_R0 (tg_alt Un) (2 * N)).
+intros; unfold Un_decreasing in |- *; intro.
+cut ((2 * S n)%nat = S (S (2 * n))).
+intro; rewrite H0; do 2 rewrite tech5; repeat rewrite Rplus_assoc.
+pattern (sum_f_R0 (tg_alt Un) (2 * n)) at 2 in |- *; rewrite <- Rplus_0_r.
+apply Rplus_le_compat_l.
+unfold tg_alt in |- *; rewrite <- H0; rewrite pow_1_odd; rewrite pow_1_even;
+ rewrite Rmult_1_l.
+apply Rplus_le_reg_l with (Un (S (2 * n))).
+rewrite Rplus_0_r;
+ replace (Un (S (2 * n)) + (-1 * Un (S (2 * n)) + Un (2 * S n)%nat)) with
+ (Un (2 * S n)%nat); [ idtac | ring ].
+rewrite H0; apply H.
+cut (forall n:nat, S n = (n + 1)%nat); [ intro | intro; ring ].
+rewrite (H0 n); rewrite (H0 (S (2 * n))); rewrite (H0 (2 * n)%nat); ring.
Qed.
(**********)
-Lemma CV_ALT_step2 : (Un:nat->R;N:nat) (Un_decreasing Un) -> (positivity_seq Un) -> (Rle (sum_f_R0 [i:nat](tg_alt Un (S i)) (S (mult (2) N))) R0).
-Intros; Induction N.
-Simpl; Unfold tg_alt; Simpl; Rewrite Rmult_1r.
-Replace ``-1* -1*(Un (S (S O)))`` with (Un (S (S O))); [Idtac | Ring].
-Apply Rle_anti_compatibility with ``(Un (S O))``; Rewrite Rplus_Or.
-Replace ``(Un (S O))+ (-1*(Un (S O))+(Un (S (S O))))`` with (Un (S (S O))); [Apply H | Ring].
-Cut (S (mult (2) (S N))) = (S (S (S (mult (2) N)))).
-Intro; Rewrite H1; Do 2 Rewrite tech5.
-Apply Rle_trans with (sum_f_R0 [i:nat](tg_alt Un (S i)) (S (mult (S (S O)) N))).
-Pattern 2 (sum_f_R0 [i:nat](tg_alt Un (S i)) (S (mult (S (S O)) N))); Rewrite <- Rplus_Or.
-Rewrite Rplus_assoc; Apply Rle_compatibility.
-Unfold tg_alt; Rewrite <- H1.
-Rewrite pow_1_odd.
-Cut (S (S (mult (2) (S N)))) = (mult (2) (S (S N))).
-Intro; Rewrite H2; Rewrite pow_1_even; Rewrite Rmult_1l; Rewrite <- H2.
-Apply Rle_anti_compatibility with ``(Un (S (mult (S (S O)) (S N))))``.
-Rewrite Rplus_Or; Replace ``(Un (S (mult (S (S O)) (S N))))+( -1*(Un (S (mult (S (S O)) (S N))))+(Un (S (S (mult (S (S O)) (S N))))))`` with ``(Un (S (S (mult (S (S O)) (S N)))))``; [Idtac | Ring].
-Apply H.
-Apply INR_eq; Rewrite mult_INR; Repeat Rewrite S_INR; Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Apply HrecN.
-Apply INR_eq; Repeat Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
+Lemma CV_ALT_step2 :
+ forall (Un:nat -> R) (N:nat),
+ Un_decreasing Un ->
+ positivity_seq Un ->
+ sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * N)) <= 0.
+intros; induction N as [| N HrecN].
+simpl in |- *; unfold tg_alt in |- *; simpl in |- *; rewrite Rmult_1_r.
+replace (-1 * -1 * Un 2%nat) with (Un 2%nat); [ idtac | ring ].
+apply Rplus_le_reg_l with (Un 1%nat); rewrite Rplus_0_r.
+replace (Un 1%nat + (-1 * Un 1%nat + Un 2%nat)) with (Un 2%nat);
+ [ apply H | ring ].
+cut (S (2 * S N) = S (S (S (2 * N)))).
+intro; rewrite H1; do 2 rewrite tech5.
+apply Rle_trans with (sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * N))).
+pattern (sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * N))) at 2 in |- *;
+ rewrite <- Rplus_0_r.
+rewrite Rplus_assoc; apply Rplus_le_compat_l.
+unfold tg_alt in |- *; rewrite <- H1.
+rewrite pow_1_odd.
+cut (S (S (2 * S N)) = (2 * S (S N))%nat).
+intro; rewrite H2; rewrite pow_1_even; rewrite Rmult_1_l; rewrite <- H2.
+apply Rplus_le_reg_l with (Un (S (2 * S N))).
+rewrite Rplus_0_r;
+ replace (Un (S (2 * S N)) + (-1 * Un (S (2 * S N)) + Un (S (S (2 * S N)))))
+ with (Un (S (S (2 * S N)))); [ idtac | ring ].
+apply H.
+apply INR_eq; rewrite mult_INR; repeat rewrite S_INR; rewrite mult_INR;
+ repeat rewrite S_INR; ring.
+apply HrecN.
+apply INR_eq; repeat rewrite S_INR; do 2 rewrite mult_INR;
+ repeat rewrite S_INR; ring.
Qed.
(* A more general inequality *)
-Lemma CV_ALT_step3 : (Un:nat->R;N:nat) (Un_decreasing Un) -> (positivity_seq Un) -> (Rle (sum_f_R0 [i:nat](tg_alt Un (S i)) N) R0).
-Intros; Induction N.
-Simpl; Unfold tg_alt; Simpl; Rewrite Rmult_1r.
-Apply Rle_anti_compatibility with (Un (S O)).
-Rewrite Rplus_Or; Replace ``(Un (S O))+ -1*(Un (S O))`` with R0; [Apply H0 | Ring].
-Assert H1 := (even_odd_cor N).
-Elim H1; Intros.
-Elim H2; Intro.
-Rewrite H3; Apply CV_ALT_step2; Assumption.
-Rewrite H3; Rewrite tech5.
-Apply Rle_trans with (sum_f_R0 [i:nat](tg_alt Un (S i)) (S (mult (S (S O)) x))).
-Pattern 2 (sum_f_R0 [i:nat](tg_alt Un (S i)) (S (mult (S (S O)) x))); Rewrite <- Rplus_Or.
-Apply Rle_compatibility.
-Unfold tg_alt; Simpl.
-Replace (plus x (plus x O)) with (mult (2) x); [Idtac | Ring].
-Rewrite pow_1_even.
-Replace `` -1*( -1*( -1*1))*(Un (S (S (S (mult (S (S O)) x)))))`` with ``-(Un (S (S (S (mult (S (S O)) x)))))``; [Idtac | Ring].
-Apply Rle_anti_compatibility with (Un (S (S (S (mult (S (S O)) x))))).
-Rewrite Rplus_Or; Rewrite Rplus_Ropp_r.
-Apply H0.
-Apply CV_ALT_step2; Assumption.
+Lemma CV_ALT_step3 :
+ forall (Un:nat -> R) (N:nat),
+ Un_decreasing Un ->
+ positivity_seq Un -> sum_f_R0 (fun i:nat => tg_alt Un (S i)) N <= 0.
+intros; induction N as [| N HrecN].
+simpl in |- *; unfold tg_alt in |- *; simpl in |- *; rewrite Rmult_1_r.
+apply Rplus_le_reg_l with (Un 1%nat).
+rewrite Rplus_0_r; replace (Un 1%nat + -1 * Un 1%nat) with 0;
+ [ apply H0 | ring ].
+assert (H1 := even_odd_cor N).
+elim H1; intros.
+elim H2; intro.
+rewrite H3; apply CV_ALT_step2; assumption.
+rewrite H3; rewrite tech5.
+apply Rle_trans with (sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * x))).
+pattern (sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * x))) at 2 in |- *;
+ rewrite <- Rplus_0_r.
+apply Rplus_le_compat_l.
+unfold tg_alt in |- *; simpl in |- *.
+replace (x + (x + 0))%nat with (2 * x)%nat; [ idtac | ring ].
+rewrite pow_1_even.
+replace (-1 * (-1 * (-1 * 1)) * Un (S (S (S (2 * x))))) with
+ (- Un (S (S (S (2 * x))))); [ idtac | ring ].
+apply Rplus_le_reg_l with (Un (S (S (S (2 * x))))).
+rewrite Rplus_0_r; rewrite Rplus_opp_r.
+apply H0.
+apply CV_ALT_step2; assumption.
Qed.
(**********)
-Lemma CV_ALT_step4 : (Un:nat->R) (Un_decreasing Un) -> (positivity_seq Un) -> (has_ub [N:nat](sum_f_R0 (tg_alt Un) (S (mult (2) N)))).
-Intros; Unfold has_ub; Unfold bound.
-Exists ``(Un O)``.
-Unfold is_upper_bound; Intros; Elim H1; Intros.
-Rewrite H2; Rewrite decomp_sum.
-Replace (tg_alt Un O) with ``(Un O)``.
-Pattern 2 ``(Un O)``; Rewrite <- Rplus_Or.
-Apply Rle_compatibility.
-Apply CV_ALT_step3; Assumption.
-Unfold tg_alt; Simpl; Ring.
-Apply lt_O_Sn.
+Lemma CV_ALT_step4 :
+ forall Un:nat -> R,
+ Un_decreasing Un ->
+ positivity_seq Un ->
+ has_ub (fun N:nat => sum_f_R0 (tg_alt Un) (S (2 * N))).
+intros; unfold has_ub in |- *; unfold bound in |- *.
+exists (Un 0%nat).
+unfold is_upper_bound in |- *; intros; elim H1; intros.
+rewrite H2; rewrite decomp_sum.
+replace (tg_alt Un 0) with (Un 0%nat).
+pattern (Un 0%nat) at 2 in |- *; rewrite <- Rplus_0_r.
+apply Rplus_le_compat_l.
+apply CV_ALT_step3; assumption.
+unfold tg_alt in |- *; simpl in |- *; ring.
+apply lt_O_Sn.
Qed.
(* This lemma gives an interesting result about alternated series *)
-Lemma CV_ALT : (Un:nat->R) (Un_decreasing Un) -> (positivity_seq Un) -> (Un_cv Un R0) -> (sigTT R [l:R](Un_cv [N:nat](sum_f_R0 (tg_alt Un) N) l)).
-Intros.
-Assert H2 := (CV_ALT_step0 ? H).
-Assert H3 := (CV_ALT_step4 ? H H0).
-Assert X := (growing_cv ? H2 H3).
-Elim X; Intros.
-Apply existTT with x.
-Unfold Un_cv; Unfold R_dist; Unfold Un_cv in H1; Unfold R_dist in H1; Unfold Un_cv in p; Unfold R_dist in p.
-Intros; Cut ``0<eps/2``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]].
-Elim (H1 ``eps/2`` H5); Intros N2 H6.
-Elim (p ``eps/2`` H5); Intros N1 H7.
-Pose N := (max (S (mult (2) N1)) N2).
-Exists N; Intros.
-Assert H9 := (even_odd_cor n).
-Elim H9; Intros P H10.
-Cut (le N1 P).
-Intro; Elim H10; Intro.
-Replace ``(sum_f_R0 (tg_alt Un) n)-x`` with ``((sum_f_R0 (tg_alt Un) (S n))-x)+(-(tg_alt Un (S n)))``.
-Apply Rle_lt_trans with ``(Rabsolu ((sum_f_R0 (tg_alt Un) (S n))-x))+(Rabsolu (-(tg_alt Un (S n))))``.
-Apply Rabsolu_triang.
-Rewrite (double_var eps); Apply Rplus_lt.
-Rewrite H12; Apply H7; Assumption.
-Rewrite Rabsolu_Ropp; Unfold tg_alt; Rewrite Rabsolu_mult; Rewrite pow_1_abs; Rewrite Rmult_1l; Unfold Rminus in H6; Rewrite Ropp_O in H6; Rewrite <- (Rplus_Or (Un (S n))); Apply H6.
-Unfold ge; Apply le_trans with n.
-Apply le_trans with N; [Unfold N; Apply le_max_r | Assumption].
-Apply le_n_Sn.
-Rewrite tech5; Ring.
-Rewrite H12; Apply Rlt_trans with ``eps/2``.
-Apply H7; Assumption.
-Unfold Rdiv; Apply Rlt_monotony_contra with ``2``.
-Sup0.
-Rewrite (Rmult_sym ``2``); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Rewrite Rmult_1r | DiscrR].
-Rewrite RIneq.double.
-Pattern 1 eps; Rewrite <- (Rplus_Or eps); Apply Rlt_compatibility; Assumption.
-Elim H10; Intro; Apply le_double.
-Rewrite <- H11; Apply le_trans with N.
-Unfold N; Apply le_trans with (S (mult (2) N1)); [Apply le_n_Sn | Apply le_max_l].
-Assumption.
-Apply lt_n_Sm_le.
-Rewrite <- H11.
-Apply lt_le_trans with N.
-Unfold N; Apply lt_le_trans with (S (mult (2) N1)).
-Apply lt_n_Sn.
-Apply le_max_l.
-Assumption.
+Lemma CV_ALT :
+ forall Un:nat -> R,
+ Un_decreasing Un ->
+ positivity_seq Un ->
+ Un_cv Un 0 ->
+ sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 (tg_alt Un) N) l).
+intros.
+assert (H2 := CV_ALT_step0 _ H).
+assert (H3 := CV_ALT_step4 _ H H0).
+assert (X := growing_cv _ H2 H3).
+elim X; intros.
+apply existT with x.
+unfold Un_cv in |- *; unfold R_dist in |- *; unfold Un_cv in H1;
+ unfold R_dist in H1; unfold Un_cv in p; unfold R_dist in p.
+intros; cut (0 < eps / 2);
+ [ intro
+ | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ].
+elim (H1 (eps / 2) H5); intros N2 H6.
+elim (p (eps / 2) H5); intros N1 H7.
+pose (N := max (S (2 * N1)) N2).
+exists N; intros.
+assert (H9 := even_odd_cor n).
+elim H9; intros P H10.
+cut (N1 <= P)%nat.
+intro; elim H10; intro.
+replace (sum_f_R0 (tg_alt Un) n - x) with
+ (sum_f_R0 (tg_alt Un) (S n) - x + - tg_alt Un (S n)).
+apply Rle_lt_trans with
+ (Rabs (sum_f_R0 (tg_alt Un) (S n) - x) + Rabs (- tg_alt Un (S n))).
+apply Rabs_triang.
+rewrite (double_var eps); apply Rplus_lt_compat.
+rewrite H12; apply H7; assumption.
+rewrite Rabs_Ropp; unfold tg_alt in |- *; rewrite Rabs_mult;
+ rewrite pow_1_abs; rewrite Rmult_1_l; unfold Rminus in H6;
+ rewrite Ropp_0 in H6; rewrite <- (Rplus_0_r (Un (S n)));
+ apply H6.
+unfold ge in |- *; apply le_trans with n.
+apply le_trans with N; [ unfold N in |- *; apply le_max_r | assumption ].
+apply le_n_Sn.
+rewrite tech5; ring.
+rewrite H12; apply Rlt_trans with (eps / 2).
+apply H7; assumption.
+unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2.
+prove_sup0.
+rewrite (Rmult_comm 2); rewrite Rmult_assoc; rewrite <- Rinv_l_sym;
+ [ rewrite Rmult_1_r | discrR ].
+rewrite double.
+pattern eps at 1 in |- *; rewrite <- (Rplus_0_r eps); apply Rplus_lt_compat_l;
+ assumption.
+elim H10; intro; apply le_double.
+rewrite <- H11; apply le_trans with N.
+unfold N in |- *; apply le_trans with (S (2 * N1));
+ [ apply le_n_Sn | apply le_max_l ].
+assumption.
+apply lt_n_Sm_le.
+rewrite <- H11.
+apply lt_le_trans with N.
+unfold N in |- *; apply lt_le_trans with (S (2 * N1)).
+apply lt_n_Sn.
+apply le_max_l.
+assumption.
Qed.
(************************************************)
@@ -165,198 +213,236 @@ Qed.
(* *)
(* Applications: PI, cos, sin *)
(************************************************)
-Theorem alternated_series : (Un:nat->R) (Un_decreasing Un) -> (Un_cv Un R0) -> (sigTT R [l:R](Un_cv [N:nat](sum_f_R0 (tg_alt Un) N) l)).
-Intros; Apply CV_ALT.
-Assumption.
-Unfold positivity_seq; Apply decreasing_ineq; Assumption.
-Assumption.
+Theorem alternated_series :
+ forall Un:nat -> R,
+ Un_decreasing Un ->
+ Un_cv Un 0 ->
+ sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 (tg_alt Un) N) l).
+intros; apply CV_ALT.
+assumption.
+unfold positivity_seq in |- *; apply decreasing_ineq; assumption.
+assumption.
Qed.
-Theorem alternated_series_ineq : (Un:nat->R;l:R;N:nat) (Un_decreasing Un) -> (Un_cv Un R0) -> (Un_cv [N:nat](sum_f_R0 (tg_alt Un) N) l) -> ``(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) N)))<=l<=(sum_f_R0 (tg_alt Un) (mult (S (S O)) N))``.
-Intros.
-Cut (Un_cv [N:nat](sum_f_R0 (tg_alt Un) (mult (2) N)) l).
-Cut (Un_cv [N:nat](sum_f_R0 (tg_alt Un) (S (mult (2) N))) l).
-Intros; Split.
-Apply (growing_ineq [N:nat](sum_f_R0 (tg_alt Un) (S (mult (2) N)))).
-Apply CV_ALT_step0; Assumption.
-Assumption.
-Apply (decreasing_ineq [N:nat](sum_f_R0 (tg_alt Un) (mult (2) N))).
-Apply CV_ALT_step1; Assumption.
-Assumption.
-Unfold Un_cv; Unfold R_dist; Unfold Un_cv in H1; Unfold R_dist in H1; Intros.
-Elim (H1 eps H2); Intros.
-Exists x; Intros.
-Apply H3.
-Unfold ge; Apply le_trans with (mult (2) n).
-Apply le_trans with n.
-Assumption.
-Assert H5 := (mult_O_le n (2)).
-Elim H5; Intro.
-Cut ~(O)=(2); [Intro; Elim H7; Symmetry; Assumption | Discriminate].
-Assumption.
-Apply le_n_Sn.
-Unfold Un_cv; Unfold R_dist; Unfold Un_cv in H1; Unfold R_dist in H1; Intros.
-Elim (H1 eps H2); Intros.
-Exists x; Intros.
-Apply H3.
-Unfold ge; Apply le_trans with n.
-Assumption.
-Assert H5 := (mult_O_le n (2)).
-Elim H5; Intro.
-Cut ~(O)=(2); [Intro; Elim H7; Symmetry; Assumption | Discriminate].
-Assumption.
+Theorem alternated_series_ineq :
+ forall (Un:nat -> R) (l:R) (N:nat),
+ Un_decreasing Un ->
+ Un_cv Un 0 ->
+ Un_cv (fun N:nat => sum_f_R0 (tg_alt Un) N) l ->
+ sum_f_R0 (tg_alt Un) (S (2 * N)) <= l <= sum_f_R0 (tg_alt Un) (2 * N).
+intros.
+cut (Un_cv (fun N:nat => sum_f_R0 (tg_alt Un) (2 * N)) l).
+cut (Un_cv (fun N:nat => sum_f_R0 (tg_alt Un) (S (2 * N))) l).
+intros; split.
+apply (growing_ineq (fun N:nat => sum_f_R0 (tg_alt Un) (S (2 * N)))).
+apply CV_ALT_step0; assumption.
+assumption.
+apply (decreasing_ineq (fun N:nat => sum_f_R0 (tg_alt Un) (2 * N))).
+apply CV_ALT_step1; assumption.
+assumption.
+unfold Un_cv in |- *; unfold R_dist in |- *; unfold Un_cv in H1;
+ unfold R_dist in H1; intros.
+elim (H1 eps H2); intros.
+exists x; intros.
+apply H3.
+unfold ge in |- *; apply le_trans with (2 * n)%nat.
+apply le_trans with n.
+assumption.
+assert (H5 := mult_O_le n 2).
+elim H5; intro.
+cut (0%nat <> 2%nat);
+ [ intro; elim H7; symmetry in |- *; assumption | discriminate ].
+assumption.
+apply le_n_Sn.
+unfold Un_cv in |- *; unfold R_dist in |- *; unfold Un_cv in H1;
+ unfold R_dist in H1; intros.
+elim (H1 eps H2); intros.
+exists x; intros.
+apply H3.
+unfold ge in |- *; apply le_trans with n.
+assumption.
+assert (H5 := mult_O_le n 2).
+elim H5; intro.
+cut (0%nat <> 2%nat);
+ [ intro; elim H7; symmetry in |- *; assumption | discriminate ].
+assumption.
Qed.
(************************************)
(* Application : construction of PI *)
(************************************)
-Definition PI_tg := [n:nat]``/(INR (plus (mult (S (S O)) n) (S O)))``.
+Definition PI_tg (n:nat) := / INR (2 * n + 1).
-Lemma PI_tg_pos : (n:nat)``0<=(PI_tg n)``.
-Intro; Unfold PI_tg; Left; Apply Rlt_Rinv; Apply lt_INR_0; Replace (plus (mult (2) n) (1)) with (S (mult (2) n)); [Apply lt_O_Sn | Ring].
+Lemma PI_tg_pos : forall n:nat, 0 <= PI_tg n.
+intro; unfold PI_tg in |- *; left; apply Rinv_0_lt_compat; apply lt_INR_0;
+ replace (2 * n + 1)%nat with (S (2 * n)); [ apply lt_O_Sn | ring ].
Qed.
-Lemma PI_tg_decreasing : (Un_decreasing PI_tg).
-Unfold PI_tg Un_decreasing; Intro.
-Apply Rle_monotony_contra with ``(INR (plus (mult (S (S O)) n) (S O)))``.
-Apply lt_INR_0.
-Replace (plus (mult (2) n) (1)) with (S (mult (2) n)); [Apply lt_O_Sn | Ring].
-Rewrite <- Rinv_r_sym.
-Apply Rle_monotony_contra with ``(INR (plus (mult (S (S O)) (S n)) (S O)))``.
-Apply lt_INR_0.
-Replace (plus (mult (2) (S n)) (1)) with (S (mult (2) (S n))); [Apply lt_O_Sn | Ring].
-Rewrite (Rmult_sym ``(INR (plus (mult (S (S O)) (S n)) (S O)))``); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Do 2 Rewrite Rmult_1r; Apply le_INR.
-Replace (plus (mult (2) (S n)) (1)) with (S (S (plus (mult (2) n) (1)))).
-Apply le_trans with (S (plus (mult (2) n) (1))); Apply le_n_Sn.
-Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite plus_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Apply not_O_INR; Discriminate.
-Apply not_O_INR; Replace (plus (mult (2) n) (1)) with (S (mult (2) n)); [Discriminate | Ring].
+Lemma PI_tg_decreasing : Un_decreasing PI_tg.
+unfold PI_tg, Un_decreasing in |- *; intro.
+apply Rmult_le_reg_l with (INR (2 * n + 1)).
+apply lt_INR_0.
+replace (2 * n + 1)%nat with (S (2 * n)); [ apply lt_O_Sn | ring ].
+rewrite <- Rinv_r_sym.
+apply Rmult_le_reg_l with (INR (2 * S n + 1)).
+apply lt_INR_0.
+replace (2 * S n + 1)%nat with (S (2 * S n)); [ apply lt_O_Sn | ring ].
+rewrite (Rmult_comm (INR (2 * S n + 1))); rewrite Rmult_assoc;
+ rewrite <- Rinv_l_sym.
+do 2 rewrite Rmult_1_r; apply le_INR.
+replace (2 * S n + 1)%nat with (S (S (2 * n + 1))).
+apply le_trans with (S (2 * n + 1)); apply le_n_Sn.
+apply INR_eq; do 2 rewrite S_INR; do 2 rewrite plus_INR;
+ do 2 rewrite mult_INR; repeat rewrite S_INR; ring.
+apply not_O_INR; discriminate.
+apply not_O_INR; replace (2 * n + 1)%nat with (S (2 * n));
+ [ discriminate | ring ].
Qed.
-Lemma PI_tg_cv : (Un_cv PI_tg R0).
-Unfold Un_cv; Unfold R_dist; Intros.
-Cut ``0<2*eps``; [Intro | Apply Rmult_lt_pos; [Sup0 | Assumption]].
-Assert H1 := (archimed ``/(2*eps)``).
-Cut (Zle `0` ``(up (/(2*eps)))``).
-Intro; Assert H3 := (IZN ``(up (/(2*eps)))`` H2).
-Elim H3; Intros N H4.
-Cut (lt O N).
-Intro; Exists N; Intros.
-Cut (lt O n).
-Intro; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_right.
-Unfold PI_tg; Apply Rlt_trans with ``/(INR (mult (S (S O)) n))``.
-Apply Rlt_monotony_contra with ``(INR (mult (S (S O)) n))``.
-Apply lt_INR_0.
-Replace (mult (2) n) with (plus n n); [Idtac | Ring].
-Apply lt_le_trans with n.
-Assumption.
-Apply le_plus_l.
-Rewrite <- Rinv_r_sym.
-Apply Rlt_monotony_contra with ``(INR (plus (mult (S (S O)) n) (S O)))``.
-Apply lt_INR_0.
-Replace (plus (mult (2) n) (1)) with (S (mult (2) n)); [Apply lt_O_Sn | Ring].
-Rewrite (Rmult_sym ``(INR (plus (mult (S (S O)) n) (S O)))``).
-Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Do 2 Rewrite Rmult_1r; Apply lt_INR.
-Replace (plus (mult (2) n) (1)) with (S (mult (2) n)); [Apply lt_n_Sn | Ring].
-Apply not_O_INR; Replace (plus (mult (2) n) (1)) with (S (mult (2) n)); [Discriminate | Ring].
-Replace n with (S (pred n)).
-Apply not_O_INR; Discriminate.
-Symmetry; Apply S_pred with O.
-Assumption.
-Apply Rle_lt_trans with ``/(INR (mult (S (S O)) N))``.
-Apply Rle_monotony_contra with ``(INR (mult (S (S O)) N))``.
-Rewrite mult_INR; Apply Rmult_lt_pos; [Simpl; Sup0 | Apply lt_INR_0; Assumption].
-Rewrite <- Rinv_r_sym.
-Apply Rle_monotony_contra with ``(INR (mult (S (S O)) n))``.
-Rewrite mult_INR; Apply Rmult_lt_pos; [Simpl; Sup0 | Apply lt_INR_0; Assumption].
-Rewrite (Rmult_sym (INR (mult (S (S O)) n))); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Do 2 Rewrite Rmult_1r; Apply le_INR.
-Apply mult_le; Assumption.
-Replace n with (S (pred n)).
-Apply not_O_INR; Discriminate.
-Symmetry; Apply S_pred with O.
-Assumption.
-Replace N with (S (pred N)).
-Apply not_O_INR; Discriminate.
-Symmetry; Apply S_pred with O.
-Assumption.
-Rewrite mult_INR.
-Rewrite Rinv_Rmult.
-Replace (INR (S (S O))) with ``2``; [Idtac | Reflexivity].
-Apply Rlt_monotony_contra with ``2``.
-Sup0.
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Idtac | DiscrR].
-Rewrite Rmult_1l; Apply Rlt_monotony_contra with (INR N).
-Apply lt_INR_0; Assumption.
-Rewrite <- Rinv_r_sym.
-Apply Rlt_monotony_contra with ``/(2*eps)``.
-Apply Rlt_Rinv; Assumption.
-Rewrite Rmult_1r; Replace ``/(2*eps)*((INR N)*(2*eps))`` with ``(INR N)*((2*eps)*/(2*eps))``; [Idtac | Ring].
-Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Replace (INR N) with (IZR (INZ N)).
-Rewrite <- H4.
-Elim H1; Intros; Assumption.
-Symmetry; Apply INR_IZR_INZ.
-Apply prod_neq_R0; [DiscrR | Red; Intro; Rewrite H8 in H; Elim (Rlt_antirefl ? H)].
-Apply not_O_INR.
-Red; Intro; Rewrite H8 in H5; Elim (lt_n_n ? H5).
-Replace (INR (S (S O))) with ``2``; [DiscrR | Reflexivity].
-Apply not_O_INR.
-Red; Intro; Rewrite H8 in H5; Elim (lt_n_n ? H5).
-Apply Rle_sym1; Apply PI_tg_pos.
-Apply lt_le_trans with N; Assumption.
-Elim H1; Intros H5 _.
-Assert H6 := (lt_eq_lt_dec O N).
-Elim H6; Intro.
-Elim a; Intro.
-Assumption.
-Rewrite <- b in H4.
-Rewrite H4 in H5.
-Simpl in H5.
-Cut ``0</(2*eps)``; [Intro | Apply Rlt_Rinv; Assumption].
-Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H7 H5)).
-Elim (lt_n_O ? b).
-Apply le_IZR.
-Simpl.
-Left; Apply Rlt_trans with ``/(2*eps)``.
-Apply Rlt_Rinv; Assumption.
-Elim H1; Intros; Assumption.
+Lemma PI_tg_cv : Un_cv PI_tg 0.
+unfold Un_cv in |- *; unfold R_dist in |- *; intros.
+cut (0 < 2 * eps);
+ [ intro | apply Rmult_lt_0_compat; [ prove_sup0 | assumption ] ].
+assert (H1 := archimed (/ (2 * eps))).
+cut (0 <= up (/ (2 * eps)))%Z.
+intro; assert (H3 := IZN (up (/ (2 * eps))) H2).
+elim H3; intros N H4.
+cut (0 < N)%nat.
+intro; exists N; intros.
+cut (0 < n)%nat.
+intro; unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r;
+ rewrite Rabs_right.
+unfold PI_tg in |- *; apply Rlt_trans with (/ INR (2 * n)).
+apply Rmult_lt_reg_l with (INR (2 * n)).
+apply lt_INR_0.
+replace (2 * n)%nat with (n + n)%nat; [ idtac | ring ].
+apply lt_le_trans with n.
+assumption.
+apply le_plus_l.
+rewrite <- Rinv_r_sym.
+apply Rmult_lt_reg_l with (INR (2 * n + 1)).
+apply lt_INR_0.
+replace (2 * n + 1)%nat with (S (2 * n)); [ apply lt_O_Sn | ring ].
+rewrite (Rmult_comm (INR (2 * n + 1))).
+rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+do 2 rewrite Rmult_1_r; apply lt_INR.
+replace (2 * n + 1)%nat with (S (2 * n)); [ apply lt_n_Sn | ring ].
+apply not_O_INR; replace (2 * n + 1)%nat with (S (2 * n));
+ [ discriminate | ring ].
+replace n with (S (pred n)).
+apply not_O_INR; discriminate.
+symmetry in |- *; apply S_pred with 0%nat.
+assumption.
+apply Rle_lt_trans with (/ INR (2 * N)).
+apply Rmult_le_reg_l with (INR (2 * N)).
+rewrite mult_INR; apply Rmult_lt_0_compat;
+ [ simpl in |- *; prove_sup0 | apply lt_INR_0; assumption ].
+rewrite <- Rinv_r_sym.
+apply Rmult_le_reg_l with (INR (2 * n)).
+rewrite mult_INR; apply Rmult_lt_0_compat;
+ [ simpl in |- *; prove_sup0 | apply lt_INR_0; assumption ].
+rewrite (Rmult_comm (INR (2 * n))); rewrite Rmult_assoc;
+ rewrite <- Rinv_l_sym.
+do 2 rewrite Rmult_1_r; apply le_INR.
+apply (fun m n p:nat => mult_le_compat_l p n m); assumption.
+replace n with (S (pred n)).
+apply not_O_INR; discriminate.
+symmetry in |- *; apply S_pred with 0%nat.
+assumption.
+replace N with (S (pred N)).
+apply not_O_INR; discriminate.
+symmetry in |- *; apply S_pred with 0%nat.
+assumption.
+rewrite mult_INR.
+rewrite Rinv_mult_distr.
+replace (INR 2) with 2; [ idtac | reflexivity ].
+apply Rmult_lt_reg_l with 2.
+prove_sup0.
+rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym; [ idtac | discrR ].
+rewrite Rmult_1_l; apply Rmult_lt_reg_l with (INR N).
+apply lt_INR_0; assumption.
+rewrite <- Rinv_r_sym.
+apply Rmult_lt_reg_l with (/ (2 * eps)).
+apply Rinv_0_lt_compat; assumption.
+rewrite Rmult_1_r;
+ replace (/ (2 * eps) * (INR N * (2 * eps))) with
+ (INR N * (2 * eps * / (2 * eps))); [ idtac | ring ].
+rewrite <- Rinv_r_sym.
+rewrite Rmult_1_r; replace (INR N) with (IZR (Z_of_nat N)).
+rewrite <- H4.
+elim H1; intros; assumption.
+symmetry in |- *; apply INR_IZR_INZ.
+apply prod_neq_R0;
+ [ discrR | red in |- *; intro; rewrite H8 in H; elim (Rlt_irrefl _ H) ].
+apply not_O_INR.
+red in |- *; intro; rewrite H8 in H5; elim (lt_irrefl _ H5).
+replace (INR 2) with 2; [ discrR | reflexivity ].
+apply not_O_INR.
+red in |- *; intro; rewrite H8 in H5; elim (lt_irrefl _ H5).
+apply Rle_ge; apply PI_tg_pos.
+apply lt_le_trans with N; assumption.
+elim H1; intros H5 _.
+assert (H6 := lt_eq_lt_dec 0 N).
+elim H6; intro.
+elim a; intro.
+assumption.
+rewrite <- b in H4.
+rewrite H4 in H5.
+simpl in H5.
+cut (0 < / (2 * eps)); [ intro | apply Rinv_0_lt_compat; assumption ].
+elim (Rlt_irrefl _ (Rlt_trans _ _ _ H7 H5)).
+elim (lt_n_O _ b).
+apply le_IZR.
+simpl in |- *.
+left; apply Rlt_trans with (/ (2 * eps)).
+apply Rinv_0_lt_compat; assumption.
+elim H1; intros; assumption.
Qed.
-Lemma exist_PI : (sigTT R [l:R](Un_cv [N:nat](sum_f_R0 (tg_alt PI_tg) N) l)).
-Apply alternated_series.
-Apply PI_tg_decreasing.
-Apply PI_tg_cv.
+Lemma exist_PI :
+ sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 (tg_alt PI_tg) N) l).
+apply alternated_series.
+apply PI_tg_decreasing.
+apply PI_tg_cv.
Qed.
(* Now, PI is defined *)
-Definition PI : R := (Rmult ``4`` (Cases exist_PI of (existTT a b) => a end)).
+Definition PI : R := 4 * match exist_PI with
+ | existT a b => a
+ end.
(* We can get an approximation of PI with the following inequality *)
-Lemma PI_ineq : (N:nat) ``(sum_f_R0 (tg_alt PI_tg) (S (mult (S (S O)) N)))<=PI/4<=(sum_f_R0 (tg_alt PI_tg) (mult (S (S O)) N))``.
-Intro; Apply alternated_series_ineq.
-Apply PI_tg_decreasing.
-Apply PI_tg_cv.
-Unfold PI; Case exist_PI; Intro.
-Replace ``(4*x)/4`` with x.
-Trivial.
-Unfold Rdiv; Rewrite (Rmult_sym ``4``); Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1r; Reflexivity | DiscrR].
+Lemma PI_ineq :
+ forall N:nat,
+ sum_f_R0 (tg_alt PI_tg) (S (2 * N)) <= PI / 4 <=
+ sum_f_R0 (tg_alt PI_tg) (2 * N).
+intro; apply alternated_series_ineq.
+apply PI_tg_decreasing.
+apply PI_tg_cv.
+unfold PI in |- *; case exist_PI; intro.
+replace (4 * x / 4) with x.
+trivial.
+unfold Rdiv in |- *; rewrite (Rmult_comm 4); rewrite Rmult_assoc;
+ rewrite <- Rinv_r_sym; [ rewrite Rmult_1_r; reflexivity | discrR ].
Qed.
-Lemma PI_RGT_0 : ``0<PI``.
-Assert H := (PI_ineq O).
-Apply Rlt_monotony_contra with ``/4``.
-Apply Rlt_Rinv; Sup0.
-Rewrite Rmult_Or; Rewrite Rmult_sym.
-Elim H; Clear H; Intros H _.
-Unfold Rdiv in H; Apply Rlt_le_trans with ``(sum_f_R0 (tg_alt PI_tg) (S (mult (S (S O)) O)))``.
-Simpl; Unfold tg_alt; Simpl; Rewrite Rmult_1l; Rewrite Rmult_1r; Apply Rlt_anti_compatibility with ``(PI_tg (S O))``.
-Rewrite Rplus_Or; Replace ``(PI_tg (S O))+((PI_tg O)+ -1*(PI_tg (S O)))`` with ``(PI_tg O)``; [Unfold PI_tg | Ring].
-Simpl; Apply Rinv_lt.
-Rewrite Rmult_1l; Replace ``2+1`` with ``3``; [Sup0 | Ring].
-Rewrite Rplus_sym; Pattern 1 R1; Rewrite <- Rplus_Or; Apply Rlt_compatibility; Sup0.
-Assumption.
-Qed.
+Lemma PI_RGT_0 : 0 < PI.
+assert (H := PI_ineq 0).
+apply Rmult_lt_reg_l with (/ 4).
+apply Rinv_0_lt_compat; prove_sup0.
+rewrite Rmult_0_r; rewrite Rmult_comm.
+elim H; clear H; intros H _.
+unfold Rdiv in H;
+ apply Rlt_le_trans with (sum_f_R0 (tg_alt PI_tg) (S (2 * 0))).
+simpl in |- *; unfold tg_alt in |- *; simpl in |- *; rewrite Rmult_1_l;
+ rewrite Rmult_1_r; apply Rplus_lt_reg_r with (PI_tg 1).
+rewrite Rplus_0_r;
+ replace (PI_tg 1 + (PI_tg 0 + -1 * PI_tg 1)) with (PI_tg 0);
+ [ unfold PI_tg in |- * | ring ].
+simpl in |- *; apply Rinv_lt_contravar.
+rewrite Rmult_1_l; replace (2 + 1) with 3; [ prove_sup0 | ring ].
+rewrite Rplus_comm; pattern 1 at 1 in |- *; rewrite <- Rplus_0_r;
+ apply Rplus_lt_compat_l; prove_sup0.
+assumption.
+Qed. \ No newline at end of file
diff --git a/theories/Reals/ArithProp.v b/theories/Reals/ArithProp.v
index 7ec8ad1ed..72c99fc10 100644
--- a/theories/Reals/ArithProp.v
+++ b/theories/Reals/ArithProp.v
@@ -8,127 +8,171 @@
(*i $Id$ i*)
-Require Rbase.
-Require Rbasic_fun.
-Require Even.
-Require Div2.
-V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
+Require Import Rbase.
+Require Import Rbasic_fun.
+Require Import Even.
+Require Import Div2.
Open Local Scope Z_scope.
Open Local Scope R_scope.
-Lemma minus_neq_O : (n,i:nat) (lt i n) -> ~(minus n i)=O.
-Intros; Red; Intro.
-Cut (n,m:nat) (le m n) -> (minus n m)=O -> n=m.
-Intro; Assert H2 := (H1 ? ? (lt_le_weak ? ? H) H0); Rewrite H2 in H; Elim (lt_n_n ? H).
-Pose R := [n,m:nat](le m n)->(minus n m)=(0)->n=m.
-Cut ((n,m:nat)(R n m)) -> ((n0,m:nat)(le m n0)->(minus n0 m)=(0)->n0=m).
-Intro; Apply H1.
-Apply nat_double_ind.
-Unfold R; Intros; Inversion H2; Reflexivity.
-Unfold R; Intros; Simpl in H3; Assumption.
-Unfold R; Intros; Simpl in H4; Assert H5 := (le_S_n ? ? H3); Assert H6 := (H2 H5 H4); Rewrite H6; Reflexivity.
-Unfold R; Intros; Apply H1; Assumption.
+Lemma minus_neq_O : forall n i:nat, (i < n)%nat -> (n - i)%nat <> 0%nat.
+intros; red in |- *; intro.
+cut (forall n m:nat, (m <= n)%nat -> (n - m)%nat = 0%nat -> n = m).
+intro; assert (H2 := H1 _ _ (lt_le_weak _ _ H) H0); rewrite H2 in H;
+ elim (lt_irrefl _ H).
+pose (R := fun n m:nat => (m <= n)%nat -> (n - m)%nat = 0%nat -> n = m).
+cut
+ ((forall n m:nat, R n m) ->
+ forall n0 m:nat, (m <= n0)%nat -> (n0 - m)%nat = 0%nat -> n0 = m).
+intro; apply H1.
+apply nat_double_ind.
+unfold R in |- *; intros; inversion H2; reflexivity.
+unfold R in |- *; intros; simpl in H3; assumption.
+unfold R in |- *; intros; simpl in H4; assert (H5 := le_S_n _ _ H3);
+ assert (H6 := H2 H5 H4); rewrite H6; reflexivity.
+unfold R in |- *; intros; apply H1; assumption.
Qed.
-Lemma le_minusni_n : (n,i:nat) (le i n)->(le (minus n i) n).
-Pose R := [m,n:nat] (le n m) -> (le (minus m n) m).
-Cut ((m,n:nat)(R m n)) -> ((n,i:nat)(le i n)->(le (minus n i) n)).
-Intro; Apply H.
-Apply nat_double_ind.
-Unfold R; Intros; Simpl; Apply le_n.
-Unfold R; Intros; Simpl; Apply le_n.
-Unfold R; Intros; Simpl; Apply le_trans with n.
-Apply H0; Apply le_S_n; Assumption.
-Apply le_n_Sn.
-Unfold R; Intros; Apply H; Assumption.
+Lemma le_minusni_n : forall n i:nat, (i <= n)%nat -> (n - i <= n)%nat.
+pose (R := fun m n:nat => (n <= m)%nat -> (m - n <= m)%nat).
+cut
+ ((forall m n:nat, R m n) -> forall n i:nat, (i <= n)%nat -> (n - i <= n)%nat).
+intro; apply H.
+apply nat_double_ind.
+unfold R in |- *; intros; simpl in |- *; apply le_n.
+unfold R in |- *; intros; simpl in |- *; apply le_n.
+unfold R in |- *; intros; simpl in |- *; apply le_trans with n.
+apply H0; apply le_S_n; assumption.
+apply le_n_Sn.
+unfold R in |- *; intros; apply H; assumption.
Qed.
-Lemma lt_minus_O_lt : (m,n:nat) (lt m n) -> (lt O (minus n m)).
-Intros n m; Pattern n m; Apply nat_double_ind; [
- Intros; Rewrite <- minus_n_O; Assumption
-| Intros; Elim (lt_n_O ? H)
-| Intros; Simpl; Apply H; Apply lt_S_n; Assumption].
+Lemma lt_minus_O_lt : forall m n:nat, (m < n)%nat -> (0 < n - m)%nat.
+intros n m; pattern n, m in |- *; apply nat_double_ind;
+ [ intros; rewrite <- minus_n_O; assumption
+ | intros; elim (lt_n_O _ H)
+ | intros; simpl in |- *; apply H; apply lt_S_n; assumption ].
Qed.
-Lemma even_odd_cor : (n:nat) (EX p : nat | n=(mult (2) p)\/n=(S (mult (2) p))).
-Intro.
-Assert H := (even_or_odd n).
-Exists (div2 n).
-Assert H0 := (even_odd_double n).
-Elim H0; Intros.
-Elim H1; Intros H3 _.
-Elim H2; Intros H4 _.
-Replace (mult (2) (div2 n)) with (Div2.double (div2 n)).
-Elim H; Intro.
-Left.
-Apply H3; Assumption.
-Right.
-Apply H4; Assumption.
-Unfold Div2.double; Ring.
+Lemma even_odd_cor :
+ forall n:nat, exists p : nat | n = (2 * p)%nat \/ n = S (2 * p).
+intro.
+assert (H := even_or_odd n).
+exists (div2 n).
+assert (H0 := even_odd_double n).
+elim H0; intros.
+elim H1; intros H3 _.
+elim H2; intros H4 _.
+replace (2 * div2 n)%nat with (double (div2 n)).
+elim H; intro.
+left.
+apply H3; assumption.
+right.
+apply H4; assumption.
+unfold double in |- *; ring.
Qed.
(* 2m <= 2n => m<=n *)
-Lemma le_double : (m,n:nat) (le (mult (2) m) (mult (2) n)) -> (le m n).
-Intros; Apply INR_le.
-Assert H1 := (le_INR ? ? H).
-Do 2 Rewrite mult_INR in H1.
-Apply Rle_monotony_contra with ``(INR (S (S O)))``.
-Replace (INR (S (S O))) with ``2``; [Sup0 | Reflexivity].
-Assumption.
+Lemma le_double : forall m n:nat, (2 * m <= 2 * n)%nat -> (m <= n)%nat.
+intros; apply INR_le.
+assert (H1 := le_INR _ _ H).
+do 2 rewrite mult_INR in H1.
+apply Rmult_le_reg_l with (INR 2).
+replace (INR 2) with 2; [ prove_sup0 | reflexivity ].
+assumption.
Qed.
(* Here, we have the euclidian division *)
(* This lemma is used in the proof of sin_eq_0 : (sin x)=0<->x=kPI *)
-Lemma euclidian_division : (x,y:R) ``y<>0`` -> (EXT k:Z | (EXT r : R | ``x==(IZR k)*y+r``/\``0<=r<(Rabsolu y)``)).
-Intros.
-Pose k0 := Cases (case_Rabsolu y) of
- (leftT _) => (Zminus `1` (up ``x/-y``))
- | (rightT _) => (Zminus (up ``x/y``) `1`) end.
-Exists k0.
-Exists ``x-(IZR k0)*y``.
-Split.
-Ring.
-Unfold k0; Case (case_Rabsolu y); Intro.
-Assert H0 := (archimed ``x/-y``); Rewrite <- Z_R_minus; Simpl; Unfold Rminus.
-Replace ``-((1+ -(IZR (up (x/( -y)))))*y)`` with ``((IZR (up (x/-y)))-1)*y``; [Idtac | Ring].
-Split.
-Apply Rle_monotony_contra with ``/-y``.
-Apply Rlt_Rinv; Apply Rgt_RO_Ropp; Exact r.
-Rewrite Rmult_Or; Rewrite (Rmult_sym ``/-y``); Rewrite Rmult_Rplus_distrl; Rewrite <- Ropp_Rinv; [Idtac | Assumption].
-Rewrite Rmult_assoc; Repeat Rewrite Ropp_mul3; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1r | Assumption].
-Apply Rle_anti_compatibility with ``(IZR (up (x/( -y))))-x/( -y)``.
-Rewrite Rplus_Or; Unfold Rdiv; Pattern 4 ``/-y``; Rewrite <- Ropp_Rinv; [Idtac | Assumption].
-Replace ``(IZR (up (x*/ -y)))-x* -/y+( -(x*/y)+ -((IZR (up (x*/ -y)))-1))`` with R1; [Idtac | Ring].
-Elim H0; Intros _ H1; Unfold Rdiv in H1; Exact H1.
-Rewrite (Rabsolu_left ? r); Apply Rlt_monotony_contra with ``/-y``.
-Apply Rlt_Rinv; Apply Rgt_RO_Ropp; Exact r.
-Rewrite <- Rinv_l_sym.
-Rewrite (Rmult_sym ``/-y``); Rewrite Rmult_Rplus_distrl; Rewrite <- Ropp_Rinv; [Idtac | Assumption].
-Rewrite Rmult_assoc; Repeat Rewrite Ropp_mul3; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1r | Assumption]; Apply Rlt_anti_compatibility with ``((IZR (up (x/( -y))))-1)``.
-Replace ``(IZR (up (x/( -y))))-1+1`` with ``(IZR (up (x/( -y))))``; [Idtac | Ring].
-Replace ``(IZR (up (x/( -y))))-1+( -(x*/y)+ -((IZR (up (x/( -y))))-1))`` with ``-(x*/y)``; [Idtac | Ring].
-Rewrite <- Ropp_mul3; Rewrite (Ropp_Rinv ? H); Elim H0; Unfold Rdiv; Intros H1 _; Exact H1.
-Apply Ropp_neq; Assumption.
-Assert H0 := (archimed ``x/y``); Rewrite <- Z_R_minus; Simpl; Cut ``0<y``.
-Intro; Unfold Rminus; Replace ``-(((IZR (up (x/y)))+ -1)*y)`` with ``(1-(IZR (up (x/y))))*y``; [Idtac | Ring].
-Split.
-Apply Rle_monotony_contra with ``/y``.
-Apply Rlt_Rinv; Assumption.
-Rewrite Rmult_Or; Rewrite (Rmult_sym ``/y``); Rewrite Rmult_Rplus_distrl; Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1r | Assumption]; Apply Rle_anti_compatibility with ``(IZR (up (x/y)))-x/y``; Rewrite Rplus_Or; Unfold Rdiv; Replace ``(IZR (up (x*/y)))-x*/y+(x*/y+(1-(IZR (up (x*/y)))))`` with R1; [Idtac | Ring]; Elim H0; Intros _ H2; Unfold Rdiv in H2; Exact H2.
-Rewrite (Rabsolu_right ? r); Apply Rlt_monotony_contra with ``/y``.
-Apply Rlt_Rinv; Assumption.
-Rewrite <- (Rinv_l_sym ? H); Rewrite (Rmult_sym ``/y``); Rewrite Rmult_Rplus_distrl; Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1r | Assumption]; Apply Rlt_anti_compatibility with ``((IZR (up (x/y)))-1)``; Replace ``(IZR (up (x/y)))-1+1`` with ``(IZR (up (x/y)))``; [Idtac | Ring]; Replace ``(IZR (up (x/y)))-1+(x*/y+(1-(IZR (up (x/y)))))`` with ``x*/y``; [Idtac | Ring]; Elim H0; Unfold Rdiv; Intros H2 _; Exact H2.
-Case (total_order_T R0 y); Intro.
-Elim s; Intro.
-Assumption.
-Elim H; Symmetry; Exact b.
-Assert H1 := (Rle_sym2 ? ? r); Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H1 r0)).
+Lemma euclidian_division :
+ forall x y:R,
+ y <> 0 ->
+ exists k : Z | ( exists r : R | x = IZR k * y + r /\ 0 <= r < Rabs y).
+intros.
+pose
+ (k0 :=
+ match Rcase_abs y with
+ | left _ => (1 - up (x / - y))%Z
+ | right _ => (up (x / y) - 1)%Z
+ end).
+exists k0.
+exists (x - IZR k0 * y).
+split.
+ring.
+unfold k0 in |- *; case (Rcase_abs y); intro.
+assert (H0 := archimed (x / - y)); rewrite <- Z_R_minus; simpl in |- *;
+ unfold Rminus in |- *.
+replace (- ((1 + - IZR (up (x / - y))) * y)) with
+ ((IZR (up (x / - y)) - 1) * y); [ idtac | ring ].
+split.
+apply Rmult_le_reg_l with (/ - y).
+apply Rinv_0_lt_compat; apply Ropp_0_gt_lt_contravar; exact r.
+rewrite Rmult_0_r; rewrite (Rmult_comm (/ - y)); rewrite Rmult_plus_distr_r;
+ rewrite <- Ropp_inv_permute; [ idtac | assumption ].
+rewrite Rmult_assoc; repeat rewrite Ropp_mult_distr_r_reverse;
+ rewrite <- Rinv_r_sym; [ rewrite Rmult_1_r | assumption ].
+apply Rplus_le_reg_l with (IZR (up (x / - y)) - x / - y).
+rewrite Rplus_0_r; unfold Rdiv in |- *; pattern (/ - y) at 4 in |- *;
+ rewrite <- Ropp_inv_permute; [ idtac | assumption ].
+replace
+ (IZR (up (x * / - y)) - x * - / y +
+ (- (x * / y) + - (IZR (up (x * / - y)) - 1))) with 1;
+ [ idtac | ring ].
+elim H0; intros _ H1; unfold Rdiv in H1; exact H1.
+rewrite (Rabs_left _ r); apply Rmult_lt_reg_l with (/ - y).
+apply Rinv_0_lt_compat; apply Ropp_0_gt_lt_contravar; exact r.
+rewrite <- Rinv_l_sym.
+rewrite (Rmult_comm (/ - y)); rewrite Rmult_plus_distr_r;
+ rewrite <- Ropp_inv_permute; [ idtac | assumption ].
+rewrite Rmult_assoc; repeat rewrite Ropp_mult_distr_r_reverse;
+ rewrite <- Rinv_r_sym; [ rewrite Rmult_1_r | assumption ];
+ apply Rplus_lt_reg_r with (IZR (up (x / - y)) - 1).
+replace (IZR (up (x / - y)) - 1 + 1) with (IZR (up (x / - y)));
+ [ idtac | ring ].
+replace (IZR (up (x / - y)) - 1 + (- (x * / y) + - (IZR (up (x / - y)) - 1)))
+ with (- (x * / y)); [ idtac | ring ].
+rewrite <- Ropp_mult_distr_r_reverse; rewrite (Ropp_inv_permute _ H); elim H0;
+ unfold Rdiv in |- *; intros H1 _; exact H1.
+apply Ropp_neq_0_compat; assumption.
+assert (H0 := archimed (x / y)); rewrite <- Z_R_minus; simpl in |- *;
+ cut (0 < y).
+intro; unfold Rminus in |- *;
+ replace (- ((IZR (up (x / y)) + -1) * y)) with ((1 - IZR (up (x / y))) * y);
+ [ idtac | ring ].
+split.
+apply Rmult_le_reg_l with (/ y).
+apply Rinv_0_lt_compat; assumption.
+rewrite Rmult_0_r; rewrite (Rmult_comm (/ y)); rewrite Rmult_plus_distr_r;
+ rewrite Rmult_assoc; rewrite <- Rinv_r_sym;
+ [ rewrite Rmult_1_r | assumption ];
+ apply Rplus_le_reg_l with (IZR (up (x / y)) - x / y);
+ rewrite Rplus_0_r; unfold Rdiv in |- *;
+ replace
+ (IZR (up (x * / y)) - x * / y + (x * / y + (1 - IZR (up (x * / y))))) with
+ 1; [ idtac | ring ]; elim H0; intros _ H2; unfold Rdiv in H2;
+ exact H2.
+rewrite (Rabs_right _ r); apply Rmult_lt_reg_l with (/ y).
+apply Rinv_0_lt_compat; assumption.
+rewrite <- (Rinv_l_sym _ H); rewrite (Rmult_comm (/ y));
+ rewrite Rmult_plus_distr_r; rewrite Rmult_assoc; rewrite <- Rinv_r_sym;
+ [ rewrite Rmult_1_r | assumption ];
+ apply Rplus_lt_reg_r with (IZR (up (x / y)) - 1);
+ replace (IZR (up (x / y)) - 1 + 1) with (IZR (up (x / y)));
+ [ idtac | ring ];
+ replace (IZR (up (x / y)) - 1 + (x * / y + (1 - IZR (up (x / y))))) with
+ (x * / y); [ idtac | ring ]; elim H0; unfold Rdiv in |- *;
+ intros H2 _; exact H2.
+case (total_order_T 0 y); intro.
+elim s; intro.
+assumption.
+elim H; symmetry in |- *; exact b.
+assert (H1 := Rge_le _ _ r); elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 r0)).
Qed.
-Lemma tech8 : (n,i:nat) (le n (plus (S n) i)).
-Intros; Induction i.
-Replace (plus (S n) O) with (S n); [Apply le_n_Sn | Ring].
-Replace (plus (S n) (S i)) with (S (plus (S n) i)).
-Apply le_S; Assumption.
-Apply INR_eq; Rewrite S_INR; Do 2 Rewrite plus_INR; Do 2 Rewrite S_INR; Ring.
-Qed.
+Lemma tech8 : forall n i:nat, (n <= S n + i)%nat.
+intros; induction i as [| i Hreci].
+replace (S n + 0)%nat with (S n); [ apply le_n_Sn | ring ].
+replace (S n + S i)%nat with (S (S n + i)).
+apply le_S; assumption.
+apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; do 2 rewrite S_INR; ring.
+Qed. \ No newline at end of file
diff --git a/theories/Reals/Binomial.v b/theories/Reals/Binomial.v
index 5bbf8c7dd..e8173b82e 100644
--- a/theories/Reals/Binomial.v
+++ b/theories/Reals/Binomial.v
@@ -8,174 +8,197 @@
(*i $Id$ i*)
-Require Rbase.
-Require Rfunctions.
-Require PartSum.
-V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
+Require Import Rbase.
+Require Import Rfunctions.
+Require Import PartSum.
Open Local Scope R_scope.
-Definition C [n,p:nat] : R := ``(INR (fact n))/((INR (fact p))*(INR (fact (minus n p))))``.
+Definition C (n p:nat) : R :=
+ INR (fact n) / (INR (fact p) * INR (fact (n - p))).
-Lemma pascal_step1 : (n,i:nat) (le i n) -> (C n i) == (C n (minus n i)).
-Intros; Unfold C; Replace (minus n (minus n i)) with i.
-Rewrite Rmult_sym.
-Reflexivity.
-Apply plus_minus; Rewrite plus_sym; Apply le_plus_minus; Assumption.
+Lemma pascal_step1 : forall n i:nat, (i <= n)%nat -> C n i = C n (n - i).
+intros; unfold C in |- *; replace (n - (n - i))%nat with i.
+rewrite Rmult_comm.
+reflexivity.
+apply plus_minus; rewrite plus_comm; apply le_plus_minus; assumption.
Qed.
-Lemma pascal_step2 : (n,i:nat) (le i n) -> (C (S n) i) == ``(INR (S n))/(INR (minus (S n) i))*(C n i)``.
-Intros; Unfold C; Replace (minus (S n) i) with (S (minus n i)).
-Cut (n:nat) (fact (S n))=(mult (S n) (fact n)).
-Intro; Repeat Rewrite H0.
-Unfold Rdiv; Repeat Rewrite mult_INR; Repeat Rewrite Rinv_Rmult.
-Ring.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply not_O_INR; Discriminate.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply prod_neq_R0.
-Apply not_O_INR; Discriminate.
-Apply INR_fact_neq_0.
-Intro; Reflexivity.
-Apply minus_Sn_m; Assumption.
+Lemma pascal_step2 :
+ forall n i:nat,
+ (i <= n)%nat -> C (S n) i = INR (S n) / INR (S n - i) * C n i.
+intros; unfold C in |- *; replace (S n - i)%nat with (S (n - i)).
+cut (forall n:nat, fact (S n) = (S n * fact n)%nat).
+intro; repeat rewrite H0.
+unfold Rdiv in |- *; repeat rewrite mult_INR; repeat rewrite Rinv_mult_distr.
+ring.
+apply INR_fact_neq_0.
+apply INR_fact_neq_0.
+apply not_O_INR; discriminate.
+apply INR_fact_neq_0.
+apply INR_fact_neq_0.
+apply prod_neq_R0.
+apply not_O_INR; discriminate.
+apply INR_fact_neq_0.
+intro; reflexivity.
+apply minus_Sn_m; assumption.
Qed.
-Lemma pascal_step3 : (n,i:nat) (lt i n) -> (C n (S i)) == ``(INR (minus n i))/(INR (S i))*(C n i)``.
-Intros; Unfold C.
-Cut (n:nat) (fact (S n))=(mult (S n) (fact n)).
-Intro.
-Cut (minus n i) = (S (minus n (S i))).
-Intro.
-Pattern 2 (minus n i); Rewrite H1.
-Repeat Rewrite H0; Unfold Rdiv; Repeat Rewrite mult_INR; Repeat Rewrite Rinv_Rmult.
-Rewrite <- H1; Rewrite (Rmult_sym ``/(INR (minus n i))``); Repeat Rewrite Rmult_assoc; Rewrite (Rmult_sym (INR (minus n i))); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Ring.
-Apply not_O_INR; Apply minus_neq_O; Assumption.
-Apply not_O_INR; Discriminate.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply prod_neq_R0; [Apply not_O_INR; Discriminate | Apply INR_fact_neq_0].
-Apply not_O_INR; Discriminate.
-Apply INR_fact_neq_0.
-Apply prod_neq_R0; [Apply not_O_INR; Discriminate | Apply INR_fact_neq_0].
-Apply INR_fact_neq_0.
-Rewrite minus_Sn_m.
-Simpl; Reflexivity.
-Apply lt_le_S; Assumption.
-Intro; Reflexivity.
+Lemma pascal_step3 :
+ forall n i:nat, (i < n)%nat -> C n (S i) = INR (n - i) / INR (S i) * C n i.
+intros; unfold C in |- *.
+cut (forall n:nat, fact (S n) = (S n * fact n)%nat).
+intro.
+cut ((n - i)%nat = S (n - S i)).
+intro.
+pattern (n - i)%nat at 2 in |- *; rewrite H1.
+repeat rewrite H0; unfold Rdiv in |- *; repeat rewrite mult_INR;
+ repeat rewrite Rinv_mult_distr.
+rewrite <- H1; rewrite (Rmult_comm (/ INR (n - i)));
+ repeat rewrite Rmult_assoc; rewrite (Rmult_comm (INR (n - i)));
+ repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+ring.
+apply not_O_INR; apply minus_neq_O; assumption.
+apply not_O_INR; discriminate.
+apply INR_fact_neq_0.
+apply INR_fact_neq_0.
+apply prod_neq_R0; [ apply not_O_INR; discriminate | apply INR_fact_neq_0 ].
+apply not_O_INR; discriminate.
+apply INR_fact_neq_0.
+apply prod_neq_R0; [ apply not_O_INR; discriminate | apply INR_fact_neq_0 ].
+apply INR_fact_neq_0.
+rewrite minus_Sn_m.
+simpl in |- *; reflexivity.
+apply lt_le_S; assumption.
+intro; reflexivity.
Qed.
(**********)
-Lemma pascal : (n,i:nat) (lt i n) -> ``(C n i)+(C n (S i))==(C (S n) (S i))``.
-Intros.
-Rewrite pascal_step3; [Idtac | Assumption].
-Replace ``(C n i)+(INR (minus n i))/(INR (S i))*(C n i)`` with ``(C n i)*(1+(INR (minus n i))/(INR (S i)))``; [Idtac | Ring].
-Replace ``1+(INR (minus n i))/(INR (S i))`` with ``(INR (S n))/(INR (S i))``.
-Rewrite pascal_step1.
-Rewrite Rmult_sym; Replace (S i) with (minus (S n) (minus n i)).
-Rewrite <- pascal_step2.
-Apply pascal_step1.
-Apply le_trans with n.
-Apply le_minusni_n.
-Apply lt_le_weak; Assumption.
-Apply le_n_Sn.
-Apply le_minusni_n.
-Apply lt_le_weak; Assumption.
-Rewrite <- minus_Sn_m.
-Cut (minus n (minus n i))=i.
-Intro; Rewrite H0; Reflexivity.
-Symmetry; Apply plus_minus.
-Rewrite plus_sym; Rewrite le_plus_minus_r.
-Reflexivity.
-Apply lt_le_weak; Assumption.
-Apply le_minusni_n; Apply lt_le_weak; Assumption.
-Apply lt_le_weak; Assumption.
-Unfold Rdiv.
-Repeat Rewrite S_INR.
-Rewrite minus_INR.
-Cut ``((INR i)+1)<>0``.
-Intro.
-Apply r_Rmult_mult with ``(INR i)+1``; [Idtac | Assumption].
-Rewrite Rmult_Rplus_distr.
-Rewrite Rmult_1r.
-Do 2 Rewrite (Rmult_sym ``(INR i)+1``).
-Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_l_sym; [Idtac | Assumption].
-Ring.
-Rewrite <- S_INR.
-Apply not_O_INR; Discriminate.
-Apply lt_le_weak; Assumption.
+Lemma pascal :
+ forall n i:nat, (i < n)%nat -> C n i + C n (S i) = C (S n) (S i).
+intros.
+rewrite pascal_step3; [ idtac | assumption ].
+replace (C n i + INR (n - i) / INR (S i) * C n i) with
+ (C n i * (1 + INR (n - i) / INR (S i))); [ idtac | ring ].
+replace (1 + INR (n - i) / INR (S i)) with (INR (S n) / INR (S i)).
+rewrite pascal_step1.
+rewrite Rmult_comm; replace (S i) with (S n - (n - i))%nat.
+rewrite <- pascal_step2.
+apply pascal_step1.
+apply le_trans with n.
+apply le_minusni_n.
+apply lt_le_weak; assumption.
+apply le_n_Sn.
+apply le_minusni_n.
+apply lt_le_weak; assumption.
+rewrite <- minus_Sn_m.
+cut ((n - (n - i))%nat = i).
+intro; rewrite H0; reflexivity.
+symmetry in |- *; apply plus_minus.
+rewrite plus_comm; rewrite le_plus_minus_r.
+reflexivity.
+apply lt_le_weak; assumption.
+apply le_minusni_n; apply lt_le_weak; assumption.
+apply lt_le_weak; assumption.
+unfold Rdiv in |- *.
+repeat rewrite S_INR.
+rewrite minus_INR.
+cut (INR i + 1 <> 0).
+intro.
+apply Rmult_eq_reg_l with (INR i + 1); [ idtac | assumption ].
+rewrite Rmult_plus_distr_l.
+rewrite Rmult_1_r.
+do 2 rewrite (Rmult_comm (INR i + 1)).
+repeat rewrite Rmult_assoc.
+rewrite <- Rinv_l_sym; [ idtac | assumption ].
+ring.
+rewrite <- S_INR.
+apply not_O_INR; discriminate.
+apply lt_le_weak; assumption.
Qed.
(*********************)
(*********************)
-Lemma binomial : (x,y:R;n:nat) ``(pow (x+y) n)``==(sum_f_R0 [i:nat]``(C n i)*(pow x i)*(pow y (minus n i))`` n).
-Intros; Induction n.
-Unfold C; Simpl; Unfold Rdiv; Repeat Rewrite Rmult_1r; Rewrite Rinv_R1; Ring.
-Pattern 1 (S n); Replace (S n) with (plus n (1)); [Idtac | Ring].
-Rewrite pow_add; Rewrite Hrecn.
-Replace ``(pow (x+y) (S O))`` with ``x+y``; [Idtac | Simpl; Ring].
-Rewrite tech5.
-Cut (p:nat)(C p p)==R1.
-Cut (p:nat)(C p O)==R1.
-Intros; Rewrite H0; Rewrite <- minus_n_n; Rewrite Rmult_1l.
-Replace (pow y O) with R1; [Rewrite Rmult_1r | Simpl; Reflexivity].
-Induction n.
-Simpl; Do 2 Rewrite H; Ring.
+Lemma binomial :
+ forall (x y:R) (n:nat),
+ (x + y) ^ n = sum_f_R0 (fun i:nat => C n i * x ^ i * y ^ (n - i)) n.
+intros; induction n as [| n Hrecn].
+unfold C in |- *; simpl in |- *; unfold Rdiv in |- *;
+ repeat rewrite Rmult_1_r; rewrite Rinv_1; ring.
+pattern (S n) at 1 in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ].
+rewrite pow_add; rewrite Hrecn.
+replace ((x + y) ^ 1) with (x + y); [ idtac | simpl in |- *; ring ].
+rewrite tech5.
+cut (forall p:nat, C p p = 1).
+cut (forall p:nat, C p 0 = 1).
+intros; rewrite H0; rewrite <- minus_n_n; rewrite Rmult_1_l.
+replace (y ^ 0) with 1; [ rewrite Rmult_1_r | simpl in |- *; reflexivity ].
+induction n as [| n Hrecn0].
+simpl in |- *; do 2 rewrite H; ring.
(* N >= 1 *)
-Pose N := (S n).
-Rewrite Rmult_Rplus_distr.
-Replace (Rmult (sum_f_R0 ([i:nat]``(C N i)*(pow x i)*(pow y (minus N i))``) N) x) with (sum_f_R0 [i:nat]``(C N i)*(pow x (S i))*(pow y (minus N i))`` N).
-Replace (Rmult (sum_f_R0 ([i:nat]``(C N i)*(pow x i)*(pow y (minus N i))``) N) y) with (sum_f_R0 [i:nat]``(C N i)*(pow x i)*(pow y (minus (S N) i))`` N).
-Rewrite (decomp_sum [i:nat]``(C (S N) i)*(pow x i)*(pow y (minus (S N) i))`` N).
-Rewrite H; Replace (pow x O) with R1; [Idtac | Reflexivity].
-Do 2 Rewrite Rmult_1l.
-Replace (minus (S N) O) with (S N); [Idtac | Reflexivity].
-Pose An := [i:nat]``(C N i)*(pow x (S i))*(pow y (minus N i))``.
-Pose Bn := [i:nat]``(C N (S i))*(pow x (S i))*(pow y (minus N i))``.
-Replace (pred N) with n.
-Replace (sum_f_R0 ([i:nat]``(C (S N) (S i))*(pow x (S i))*(pow y (minus (S N) (S i)))``) n) with (sum_f_R0 [i:nat]``(An i)+(Bn i)`` n).
-Rewrite plus_sum.
-Replace (pow x (S N)) with (An (S n)).
-Rewrite (Rplus_sym (sum_f_R0 An n)).
-Repeat Rewrite Rplus_assoc.
-Rewrite <- tech5.
-Fold N.
-Pose Cn := [i:nat]``(C N i)*(pow x i)*(pow y (minus (S N) i))``.
-Cut (i:nat) (lt i N)-> (Cn (S i))==(Bn i).
-Intro; Replace (sum_f_R0 Bn n) with (sum_f_R0 [i:nat](Cn (S i)) n).
-Replace (pow y (S N)) with (Cn O).
-Rewrite <- Rplus_assoc; Rewrite (decomp_sum Cn N).
-Replace (pred N) with n.
-Ring.
-Unfold N; Simpl; Reflexivity.
-Unfold N; Apply lt_O_Sn.
-Unfold Cn; Rewrite H; Simpl; Ring.
-Apply sum_eq.
-Intros; Apply H1.
-Unfold N; Apply le_lt_trans with n; [Assumption | Apply lt_n_Sn].
-Intros; Unfold Bn Cn.
-Replace (minus (S N) (S i)) with (minus N i); Reflexivity.
-Unfold An; Fold N; Rewrite <- minus_n_n; Rewrite H0; Simpl; Ring.
-Apply sum_eq.
-Intros; Unfold An Bn; Replace (minus (S N) (S i)) with (minus N i); [Idtac | Reflexivity].
-Rewrite <- pascal; [Ring | Apply le_lt_trans with n; [Assumption | Unfold N; Apply lt_n_Sn]].
-Unfold N; Reflexivity.
-Unfold N; Apply lt_O_Sn.
-Rewrite <- (Rmult_sym y); Rewrite scal_sum; Apply sum_eq.
-Intros; Replace (minus (S N) i) with (S (minus N i)).
-Replace (S (minus N i)) with (plus (minus N i) (1)); [Idtac | Ring].
-Rewrite pow_add; Replace (pow y (S O)) with y; [Idtac | Simpl; Ring]; Ring.
-Apply minus_Sn_m; Assumption.
-Rewrite <- (Rmult_sym x); Rewrite scal_sum; Apply sum_eq.
-Intros; Replace (S i) with (plus i (1)); [Idtac | Ring]; Rewrite pow_add; Replace (pow x (S O)) with x; [Idtac | Simpl; Ring]; Ring.
-Intro; Unfold C.
-Replace (INR (fact O)) with R1; [Idtac | Reflexivity].
-Replace (minus p O) with p; [Idtac | Apply minus_n_O].
-Rewrite Rmult_1l; Unfold Rdiv; Rewrite <- Rinv_r_sym; [Reflexivity | Apply INR_fact_neq_0].
-Intro; Unfold C.
-Replace (minus p p) with O; [Idtac | Apply minus_n_n].
-Replace (INR (fact O)) with R1; [Idtac | Reflexivity].
-Rewrite Rmult_1r; Unfold Rdiv; Rewrite <- Rinv_r_sym; [Reflexivity | Apply INR_fact_neq_0].
-Qed.
+pose (N := S n).
+rewrite Rmult_plus_distr_l.
+replace (sum_f_R0 (fun i:nat => C N i * x ^ i * y ^ (N - i)) N * x) with
+ (sum_f_R0 (fun i:nat => C N i * x ^ S i * y ^ (N - i)) N).
+replace (sum_f_R0 (fun i:nat => C N i * x ^ i * y ^ (N - i)) N * y) with
+ (sum_f_R0 (fun i:nat => C N i * x ^ i * y ^ (S N - i)) N).
+rewrite (decomp_sum (fun i:nat => C (S N) i * x ^ i * y ^ (S N - i)) N).
+rewrite H; replace (x ^ 0) with 1; [ idtac | reflexivity ].
+do 2 rewrite Rmult_1_l.
+replace (S N - 0)%nat with (S N); [ idtac | reflexivity ].
+pose (An := fun i:nat => C N i * x ^ S i * y ^ (N - i)).
+pose (Bn := fun i:nat => C N (S i) * x ^ S i * y ^ (N - i)).
+replace (pred N) with n.
+replace (sum_f_R0 (fun i:nat => C (S N) (S i) * x ^ S i * y ^ (S N - S i)) n)
+ with (sum_f_R0 (fun i:nat => An i + Bn i) n).
+rewrite plus_sum.
+replace (x ^ S N) with (An (S n)).
+rewrite (Rplus_comm (sum_f_R0 An n)).
+repeat rewrite Rplus_assoc.
+rewrite <- tech5.
+fold N in |- *.
+pose (Cn := fun i:nat => C N i * x ^ i * y ^ (S N - i)).
+cut (forall i:nat, (i < N)%nat -> Cn (S i) = Bn i).
+intro; replace (sum_f_R0 Bn n) with (sum_f_R0 (fun i:nat => Cn (S i)) n).
+replace (y ^ S N) with (Cn 0%nat).
+rewrite <- Rplus_assoc; rewrite (decomp_sum Cn N).
+replace (pred N) with n.
+ring.
+unfold N in |- *; simpl in |- *; reflexivity.
+unfold N in |- *; apply lt_O_Sn.
+unfold Cn in |- *; rewrite H; simpl in |- *; ring.
+apply sum_eq.
+intros; apply H1.
+unfold N in |- *; apply le_lt_trans with n; [ assumption | apply lt_n_Sn ].
+intros; unfold Bn, Cn in |- *.
+replace (S N - S i)%nat with (N - i)%nat; reflexivity.
+unfold An in |- *; fold N in |- *; rewrite <- minus_n_n; rewrite H0;
+ simpl in |- *; ring.
+apply sum_eq.
+intros; unfold An, Bn in |- *; replace (S N - S i)%nat with (N - i)%nat;
+ [ idtac | reflexivity ].
+rewrite <- pascal;
+ [ ring
+ | apply le_lt_trans with n; [ assumption | unfold N in |- *; apply lt_n_Sn ] ].
+unfold N in |- *; reflexivity.
+unfold N in |- *; apply lt_O_Sn.
+rewrite <- (Rmult_comm y); rewrite scal_sum; apply sum_eq.
+intros; replace (S N - i)%nat with (S (N - i)).
+replace (S (N - i)) with (N - i + 1)%nat; [ idtac | ring ].
+rewrite pow_add; replace (y ^ 1) with y; [ idtac | simpl in |- *; ring ];
+ ring.
+apply minus_Sn_m; assumption.
+rewrite <- (Rmult_comm x); rewrite scal_sum; apply sum_eq.
+intros; replace (S i) with (i + 1)%nat; [ idtac | ring ]; rewrite pow_add;
+ replace (x ^ 1) with x; [ idtac | simpl in |- *; ring ];
+ ring.
+intro; unfold C in |- *.
+replace (INR (fact 0)) with 1; [ idtac | reflexivity ].
+replace (p - 0)%nat with p; [ idtac | apply minus_n_O ].
+rewrite Rmult_1_l; unfold Rdiv in |- *; rewrite <- Rinv_r_sym;
+ [ reflexivity | apply INR_fact_neq_0 ].
+intro; unfold C in |- *.
+replace (p - p)%nat with 0%nat; [ idtac | apply minus_n_n ].
+replace (INR (fact 0)) with 1; [ idtac | reflexivity ].
+rewrite Rmult_1_r; unfold Rdiv in |- *; rewrite <- Rinv_r_sym;
+ [ reflexivity | apply INR_fact_neq_0 ].
+Qed. \ No newline at end of file
diff --git a/theories/Reals/Cauchy_prod.v b/theories/Reals/Cauchy_prod.v
index a76307320..6cd5fa17f 100644
--- a/theories/Reals/Cauchy_prod.v
+++ b/theories/Reals/Cauchy_prod.v
@@ -8,340 +8,451 @@
(*i $Id$ i*)
-Require Rbase.
-Require Rfunctions.
-Require Rseries.
-Require PartSum.
-V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
+Require Import Rbase.
+Require Import Rfunctions.
+Require Import Rseries.
+Require Import PartSum.
Open Local Scope R_scope.
(**********)
-Lemma sum_N_predN : (An:nat->R;N:nat) (lt O N) -> (sum_f_R0 An N)==``(sum_f_R0 An (pred N)) + (An N)``.
-Intros.
-Replace N with (S (pred N)).
-Rewrite tech5.
-Reflexivity.
-Symmetry; Apply S_pred with O; Assumption.
+Lemma sum_N_predN :
+ forall (An:nat -> R) (N:nat),
+ (0 < N)%nat -> sum_f_R0 An N = sum_f_R0 An (pred N) + An N.
+intros.
+replace N with (S (pred N)).
+rewrite tech5.
+reflexivity.
+symmetry in |- *; apply S_pred with 0%nat; assumption.
Qed.
(**********)
-Lemma sum_plus : (An,Bn:nat->R;N:nat) (sum_f_R0 [l:nat]``(An l)+(Bn l)`` N)==``(sum_f_R0 An N)+(sum_f_R0 Bn N)``.
-Intros.
-Induction N.
-Reflexivity.
-Do 3 Rewrite tech5.
-Rewrite HrecN; Ring.
+Lemma sum_plus :
+ forall (An Bn:nat -> R) (N:nat),
+ sum_f_R0 (fun l:nat => An l + Bn l) N = sum_f_R0 An N + sum_f_R0 Bn N.
+intros.
+induction N as [| N HrecN].
+reflexivity.
+do 3 rewrite tech5.
+rewrite HrecN; ring.
Qed.
(* The main result *)
-Theorem cauchy_finite : (An,Bn:nat->R;N:nat) (lt O N) -> (Rmult (sum_f_R0 An N) (sum_f_R0 Bn N)) == (Rplus (sum_f_R0 [k:nat](sum_f_R0 [p:nat]``(An p)*(Bn (minus k p))`` k) N) (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(An (S (plus l k)))*(Bn (minus N l))`` (pred (minus N k))) (pred N))).
-Intros; Induction N.
-Elim (lt_n_n ? H).
-Cut N=O\/(lt O N).
-Intro; Elim H0; Intro.
-Rewrite H1; Simpl; Ring.
-Replace (pred (S N)) with (S (pred N)).
-Do 5 Rewrite tech5.
-Rewrite Rmult_Rplus_distrl; Rewrite Rmult_Rplus_distr; Rewrite (HrecN H1).
-Repeat Rewrite Rplus_assoc; Apply Rplus_plus_r.
-Replace (pred (minus (S N) (S (pred N)))) with (O).
-Rewrite Rmult_Rplus_distr; Replace (sum_f_R0 [l:nat]``(An (S (plus l (S (pred N)))))*(Bn (minus (S N) l))`` O) with ``(An (S N))*(Bn (S N))``.
-Repeat Rewrite <- Rplus_assoc; Do 2 Rewrite <- (Rplus_sym ``(An (S N))*(Bn (S N))``); Repeat Rewrite Rplus_assoc; Apply Rplus_plus_r.
-Rewrite <- minus_n_n; Cut N=(1)\/(le (2) N).
-Intro; Elim H2; Intro.
-Rewrite H3; Simpl; Ring.
-Replace (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(An (S (plus l k)))*(Bn (minus N l))`` (pred (minus N k))) (pred N)) with (Rplus (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (pred (minus N k)))) (pred (pred N))) (sum_f_R0 [l:nat]``(An (S l))*(Bn (minus N l))`` (pred N))).
-Replace (sum_f_R0 [p:nat]``(An p)*(Bn (minus (S N) p))`` N) with (Rplus (sum_f_R0 [l:nat]``(An (S l))*(Bn (minus N l))`` (pred N)) ``(An O)*(Bn (S N))``).
-Repeat Rewrite <- Rplus_assoc; Rewrite <- (Rplus_sym (sum_f_R0 [l:nat]``(An (S l))*(Bn (minus N l))`` (pred N))); Repeat Rewrite Rplus_assoc; Apply Rplus_plus_r.
-Replace (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(An (S (plus l k)))*(Bn (minus (S N) l))`` (pred (minus (S N) k))) (pred N)) with (Rplus (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (minus N k))) (pred N)) (Rmult (Bn (S N)) (sum_f_R0 [l:nat](An (S l)) (pred N)))).
-Rewrite (decomp_sum An N H1); Rewrite Rmult_Rplus_distrl; Repeat Rewrite <- Rplus_assoc; Rewrite <- (Rplus_sym ``(An O)*(Bn (S N))``); Repeat Rewrite Rplus_assoc; Apply Rplus_plus_r.
-Repeat Rewrite <- Rplus_assoc; Rewrite <- (Rplus_sym (Rmult (sum_f_R0 [i:nat](An (S i)) (pred N)) (Bn (S N)))); Rewrite <- (Rplus_sym (Rmult (Bn (S N)) (sum_f_R0 [i:nat](An (S i)) (pred N)))); Rewrite (Rmult_sym (Bn (S N))); Repeat Rewrite Rplus_assoc; Apply Rplus_plus_r.
-Replace (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (minus N k))) (pred N)) with (Rplus (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (pred (minus N k)))) (pred (pred N))) (Rmult (An (S N)) (sum_f_R0 [l:nat](Bn (S l)) (pred N)))).
-Rewrite (decomp_sum Bn N H1); Rewrite Rmult_Rplus_distr.
-Pose Z := (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (pred (minus N k)))) (pred (pred N))); Pose Z2 := (sum_f_R0 [i:nat](Bn (S i)) (pred N)); Ring.
-Rewrite (sum_N_predN [k:nat](sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (minus N k))) (pred N)).
-Replace (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (minus N k))) (pred (pred N))) with (sum_f_R0 [k:nat](Rplus (sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (pred (minus N k)))) ``(An (S N))*(Bn (S k))``) (pred (pred N))).
-Rewrite (sum_plus [k:nat](sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (pred (minus N k)))) [k:nat]``(An (S N))*(Bn (S k))`` (pred (pred N))).
-Repeat Rewrite Rplus_assoc; Apply Rplus_plus_r.
-Replace (pred (minus N (pred N))) with O.
-Simpl; Rewrite <- minus_n_O.
-Replace (S (pred N)) with N.
-Replace (sum_f_R0 [k:nat]``(An (S N))*(Bn (S k))`` (pred (pred N))) with (sum_f_R0 [k:nat]``(Bn (S k))*(An (S N))`` (pred (pred N))).
-Rewrite <- (scal_sum [l:nat](Bn (S l)) (pred (pred N)) (An (S N))); Rewrite (sum_N_predN [l:nat](Bn (S l)) (pred N)).
-Replace (S (pred N)) with N.
-Ring.
-Apply S_pred with O; Assumption.
-Apply lt_pred; Apply lt_le_trans with (2); [Apply lt_n_Sn | Assumption].
-Apply sum_eq; Intros; Apply Rmult_sym.
-Apply S_pred with O; Assumption.
-Replace (minus N (pred N)) with (1).
-Reflexivity.
-Pattern 1 N; Replace N with (S (pred N)).
-Rewrite <- minus_Sn_m.
-Rewrite <- minus_n_n; Reflexivity.
-Apply le_n.
-Symmetry; Apply S_pred with O; Assumption.
-Apply sum_eq; Intros; Rewrite (sum_N_predN [l:nat]``(An (S (S (plus l i))))*(Bn (minus N l))`` (pred (minus N i))).
-Replace (S (S (plus (pred (minus N i)) i))) with (S N).
-Replace (minus N (pred (minus N i))) with (S i).
-Ring.
-Rewrite pred_of_minus; Apply INR_eq; Repeat Rewrite minus_INR.
-Rewrite S_INR; Ring.
-Apply le_trans with (pred (pred N)).
-Assumption.
-Apply le_trans with (pred N); Apply le_pred_n.
-Apply INR_le; Rewrite minus_INR.
-Apply Rle_anti_compatibility with ``(INR i)-1``.
-Replace ``(INR i)-1+(INR (S O))`` with (INR i); [Idtac | Ring].
-Replace ``(INR i)-1+((INR N)-(INR i))`` with ``(INR N)-(INR (S O))``; [Idtac | Ring].
-Rewrite <- minus_INR.
-Apply le_INR; Apply le_trans with (pred (pred N)).
-Assumption.
-Rewrite <- pred_of_minus; Apply le_pred_n.
-Apply le_trans with (2).
-Apply le_n_Sn.
-Assumption.
-Apply le_trans with (pred (pred N)).
-Assumption.
-Apply le_trans with (pred N); Apply le_pred_n.
-Rewrite <- pred_of_minus.
-Apply le_trans with (pred N).
-Apply le_S_n.
-Replace (S (pred N)) with N.
-Replace (S (pred (minus N i))) with (minus N i).
-Apply simpl_le_plus_l with i; Rewrite le_plus_minus_r.
-Apply le_plus_r.
-Apply le_trans with (pred (pred N)); [Assumption | Apply le_trans with (pred N); Apply le_pred_n].
-Apply S_pred with O.
-Apply simpl_lt_plus_l with i; Rewrite le_plus_minus_r.
-Replace (plus i O) with i; [Idtac | Ring].
-Apply le_lt_trans with (pred (pred N)); [Assumption | Apply lt_trans with (pred N); Apply lt_pred_n_n].
-Apply lt_S_n.
-Replace (S (pred N)) with N.
-Apply lt_le_trans with (2).
-Apply lt_n_Sn.
-Assumption.
-Apply S_pred with O; Assumption.
-Assumption.
-Apply le_trans with (pred (pred N)).
-Assumption.
-Apply le_trans with (pred N); Apply le_pred_n.
-Apply S_pred with O; Assumption.
-Apply le_pred_n.
-Apply INR_eq; Rewrite pred_of_minus; Do 3 Rewrite S_INR; Rewrite plus_INR; Repeat Rewrite minus_INR.
-Ring.
-Apply le_trans with (pred (pred N)).
-Assumption.
-Apply le_trans with (pred N); Apply le_pred_n.
-Apply INR_le.
-Rewrite minus_INR.
-Apply Rle_anti_compatibility with ``(INR i)-1``.
-Replace ``(INR i)-1+(INR (S O))`` with (INR i); [Idtac | Ring].
-Replace ``(INR i)-1+((INR N)-(INR i))`` with ``(INR N)-(INR (S O))``; [Idtac | Ring].
-Rewrite <- minus_INR.
-Apply le_INR.
-Apply le_trans with (pred (pred N)).
-Assumption.
-Rewrite <- pred_of_minus.
-Apply le_pred_n.
-Apply le_trans with (2).
-Apply le_n_Sn.
-Assumption.
-Apply le_trans with (pred (pred N)).
-Assumption.
-Apply le_trans with (pred N); Apply le_pred_n.
-Apply lt_le_trans with (1).
-Apply lt_O_Sn.
-Apply INR_le.
-Rewrite pred_of_minus.
-Repeat Rewrite minus_INR.
-Apply Rle_anti_compatibility with ``(INR i)-1``.
-Replace ``(INR i)-1+(INR (S O))`` with (INR i); [Idtac | Ring].
-Replace ``(INR i)-1+((INR N)-(INR i)-(INR (S O)))`` with ``(INR N)-(INR (S O)) -(INR (S O))``.
-Repeat Rewrite <- minus_INR.
-Apply le_INR.
-Apply le_trans with (pred (pred N)).
-Assumption.
-Do 2 Rewrite <- pred_of_minus.
-Apply le_n.
-Apply simpl_le_plus_l with (1).
-Rewrite le_plus_minus_r.
-Simpl; Assumption.
-Apply le_trans with (2); [Apply le_n_Sn | Assumption].
-Apply le_trans with (2); [Apply le_n_Sn | Assumption].
-Ring.
-Apply le_trans with (pred (pred N)).
-Assumption.
-Apply le_trans with (pred N); Apply le_pred_n.
-Apply simpl_le_plus_l with i.
-Rewrite le_plus_minus_r.
-Replace (plus i (1)) with (S i).
-Replace N with (S (pred N)).
-Apply le_n_S.
-Apply le_trans with (pred (pred N)).
-Assumption.
-Apply le_pred_n.
-Symmetry; Apply S_pred with O; Assumption.
-Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Reflexivity.
-Apply le_trans with (pred (pred N)).
-Assumption.
-Apply le_trans with (pred N); Apply le_pred_n.
-Apply lt_le_trans with (1).
-Apply lt_O_Sn.
-Apply le_S_n.
-Replace (S (pred N)) with N.
-Assumption.
-Apply S_pred with O; Assumption.
-Replace (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(An (S (plus l k)))*(Bn (minus (S N) l))`` (pred (minus (S N) k))) (pred N)) with (sum_f_R0 [k:nat](Rplus (sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (minus N k))) ``(An (S k))*(Bn (S N))``) (pred N)).
-Rewrite (sum_plus [k:nat](sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (minus N k))) [k:nat]``(An (S k))*(Bn (S N))``).
-Apply Rplus_plus_r.
-Rewrite scal_sum; Reflexivity.
-Apply sum_eq; Intros; Rewrite Rplus_sym; Rewrite (decomp_sum [l:nat]``(An (S (plus l i)))*(Bn (minus (S N) l))`` (pred (minus (S N) i))).
-Replace (plus O i) with i; [Idtac | Ring].
-Rewrite <- minus_n_O; Apply Rplus_plus_r.
-Replace (pred (pred (minus (S N) i))) with (pred (minus N i)).
-Apply sum_eq; Intros.
-Replace (minus (S N) (S i0)) with (minus N i0); [Idtac | Reflexivity].
-Replace (plus (S i0) i) with (S (plus i0 i)).
-Reflexivity.
-Apply INR_eq; Rewrite S_INR; Do 2 Rewrite plus_INR; Rewrite S_INR; Ring.
-Cut (minus N i)=(pred (minus (S N) i)).
-Intro; Rewrite H5; Reflexivity.
-Rewrite pred_of_minus.
-Apply INR_eq; Repeat Rewrite minus_INR.
-Rewrite S_INR; Ring.
-Apply le_trans with N.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply le_n_Sn.
-Apply simpl_le_plus_l with i.
-Rewrite le_plus_minus_r.
-Replace (plus i (1)) with (S i).
-Apply le_n_S.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Ring.
-Apply le_trans with N.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply le_n_Sn.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Replace (pred (minus (S N) i)) with (minus (S N) (S i)).
-Replace (minus (S N) (S i)) with (minus N i); [Idtac | Reflexivity].
-Apply simpl_lt_plus_l with i.
-Rewrite le_plus_minus_r.
-Replace (plus i O) with i; [Idtac | Ring].
-Apply le_lt_trans with (pred N).
-Assumption.
-Apply lt_pred_n_n.
-Assumption.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Rewrite pred_of_minus.
-Apply INR_eq; Repeat Rewrite minus_INR.
-Repeat Rewrite S_INR; Ring.
-Apply le_trans with N.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply le_n_Sn.
-Apply simpl_le_plus_l with i.
-Rewrite le_plus_minus_r.
-Replace (plus i (1)) with (S i).
-Apply le_n_S.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Ring.
-Apply le_trans with N.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply le_n_Sn.
-Apply le_n_S.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Rewrite Rplus_sym.
-Rewrite (decomp_sum [p:nat]``(An p)*(Bn (minus (S N) p))`` N).
-Rewrite <- minus_n_O.
-Apply Rplus_plus_r.
-Apply sum_eq; Intros.
-Reflexivity.
-Assumption.
-Rewrite Rplus_sym.
-Rewrite (decomp_sum [k:nat](sum_f_R0 [l:nat]``(An (S (plus l k)))*(Bn (minus N l))`` (pred (minus N k))) (pred N)).
-Rewrite <- minus_n_O.
-Replace (sum_f_R0 [l:nat]``(An (S (plus l O)))*(Bn (minus N l))`` (pred N)) with (sum_f_R0 [l:nat]``(An (S l))*(Bn (minus N l))`` (pred N)).
-Apply Rplus_plus_r.
-Apply sum_eq; Intros.
-Replace (pred (minus N (S i))) with (pred (pred (minus N i))).
-Apply sum_eq; Intros.
-Replace (plus i0 (S i)) with (S (plus i0 i)).
-Reflexivity.
-Apply INR_eq; Rewrite S_INR; Do 2 Rewrite plus_INR; Rewrite S_INR; Ring.
-Cut (pred (minus N i))=(minus N (S i)).
-Intro; Rewrite H5; Reflexivity.
-Rewrite pred_of_minus.
-Apply INR_eq.
-Repeat Rewrite minus_INR.
-Repeat Rewrite S_INR; Ring.
-Apply le_trans with (S (pred (pred N))).
-Apply le_n_S; Assumption.
-Replace (S (pred (pred N))) with (pred N).
-Apply le_pred_n.
-Apply S_pred with O.
-Apply lt_S_n.
-Replace (S (pred N)) with N.
-Apply lt_le_trans with (2).
-Apply lt_n_Sn.
-Assumption.
-Apply S_pred with O; Assumption.
-Apply le_trans with (pred (pred N)).
-Assumption.
-Apply le_trans with (pred N); Apply le_pred_n.
-Apply simpl_le_plus_l with i.
-Rewrite le_plus_minus_r.
-Replace (plus i (1)) with (S i).
-Replace N with (S (pred N)).
-Apply le_n_S.
-Apply le_trans with (pred (pred N)).
-Assumption.
-Apply le_pred_n.
-Symmetry; Apply S_pred with O; Assumption.
-Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Ring.
-Apply le_trans with (pred (pred N)).
-Assumption.
-Apply le_trans with (pred N); Apply le_pred_n.
-Apply sum_eq; Intros.
-Replace (plus i O) with i; [Reflexivity | Trivial].
-Apply lt_S_n.
-Replace (S (pred N)) with N.
-Apply lt_le_trans with (2); [Apply lt_n_Sn | Assumption].
-Apply S_pred with O; Assumption.
-Inversion H1.
-Left; Reflexivity.
-Right; Apply le_n_S; Assumption.
-Simpl.
-Replace (S (pred N)) with N.
-Reflexivity.
-Apply S_pred with O; Assumption.
-Simpl.
-Cut (minus N (pred N))=(1).
-Intro; Rewrite H2; Reflexivity.
-Rewrite pred_of_minus.
-Apply INR_eq; Repeat Rewrite minus_INR.
-Ring.
-Apply lt_le_S; Assumption.
-Rewrite <- pred_of_minus; Apply le_pred_n.
-Simpl; Symmetry; Apply S_pred with O; Assumption.
-Inversion H.
-Left; Reflexivity.
-Right; Apply lt_le_trans with (1); [Apply lt_n_Sn | Exact H1].
-Qed.
+Theorem cauchy_finite :
+ forall (An Bn:nat -> R) (N:nat),
+ (0 < N)%nat ->
+ sum_f_R0 An N * sum_f_R0 Bn N =
+ sum_f_R0 (fun k:nat => sum_f_R0 (fun p:nat => An p * Bn (k - p)%nat) k) N +
+ sum_f_R0
+ (fun k:nat =>
+ sum_f_R0 (fun l:nat => An (S (l + k)) * Bn (N - l)%nat)
+ (pred (N - k))) (pred N).
+intros; induction N as [| N HrecN].
+elim (lt_irrefl _ H).
+cut (N = 0%nat \/ (0 < N)%nat).
+intro; elim H0; intro.
+rewrite H1; simpl in |- *; ring.
+replace (pred (S N)) with (S (pred N)).
+do 5 rewrite tech5.
+rewrite Rmult_plus_distr_r; rewrite Rmult_plus_distr_l; rewrite (HrecN H1).
+repeat rewrite Rplus_assoc; apply Rplus_eq_compat_l.
+replace (pred (S N - S (pred N))) with 0%nat.
+rewrite Rmult_plus_distr_l;
+ replace
+ (sum_f_R0 (fun l:nat => An (S (l + S (pred N))) * Bn (S N - l)%nat) 0) with
+ (An (S N) * Bn (S N)).
+repeat rewrite <- Rplus_assoc;
+ do 2 rewrite <- (Rplus_comm (An (S N) * Bn (S N)));
+ repeat rewrite Rplus_assoc; apply Rplus_eq_compat_l.
+rewrite <- minus_n_n; cut (N = 1%nat \/ (2 <= N)%nat).
+intro; elim H2; intro.
+rewrite H3; simpl in |- *; ring.
+replace
+ (sum_f_R0
+ (fun k:nat =>
+ sum_f_R0 (fun l:nat => An (S (l + k)) * Bn (N - l)%nat) (pred (N - k)))
+ (pred N)) with
+ (sum_f_R0
+ (fun k:nat =>
+ sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat)
+ (pred (pred (N - k)))) (pred (pred N)) +
+ sum_f_R0 (fun l:nat => An (S l) * Bn (N - l)%nat) (pred N)).
+replace (sum_f_R0 (fun p:nat => An p * Bn (S N - p)%nat) N) with
+ (sum_f_R0 (fun l:nat => An (S l) * Bn (N - l)%nat) (pred N) +
+ An 0%nat * Bn (S N)).
+repeat rewrite <- Rplus_assoc;
+ rewrite <-
+ (Rplus_comm (sum_f_R0 (fun l:nat => An (S l) * Bn (N - l)%nat) (pred N)))
+ ; repeat rewrite Rplus_assoc; apply Rplus_eq_compat_l.
+replace
+ (sum_f_R0
+ (fun k:nat =>
+ sum_f_R0 (fun l:nat => An (S (l + k)) * Bn (S N - l)%nat)
+ (pred (S N - k))) (pred N)) with
+ (sum_f_R0
+ (fun k:nat =>
+ sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat)
+ (pred (N - k))) (pred N) +
+ Bn (S N) * sum_f_R0 (fun l:nat => An (S l)) (pred N)).
+rewrite (decomp_sum An N H1); rewrite Rmult_plus_distr_r;
+ repeat rewrite <- Rplus_assoc; rewrite <- (Rplus_comm (An 0%nat * Bn (S N)));
+ repeat rewrite Rplus_assoc; apply Rplus_eq_compat_l.
+repeat rewrite <- Rplus_assoc;
+ rewrite <-
+ (Rplus_comm (sum_f_R0 (fun i:nat => An (S i)) (pred N) * Bn (S N)))
+ ;
+ rewrite <-
+ (Rplus_comm (Bn (S N) * sum_f_R0 (fun i:nat => An (S i)) (pred N)))
+ ; rewrite (Rmult_comm (Bn (S N))); repeat rewrite Rplus_assoc;
+ apply Rplus_eq_compat_l.
+replace
+ (sum_f_R0
+ (fun k:nat =>
+ sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat)
+ (pred (N - k))) (pred N)) with
+ (sum_f_R0
+ (fun k:nat =>
+ sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat)
+ (pred (pred (N - k)))) (pred (pred N)) +
+ An (S N) * sum_f_R0 (fun l:nat => Bn (S l)) (pred N)).
+rewrite (decomp_sum Bn N H1); rewrite Rmult_plus_distr_l.
+pose
+ (Z :=
+ sum_f_R0
+ (fun k:nat =>
+ sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat)
+ (pred (pred (N - k)))) (pred (pred N)));
+ pose (Z2 := sum_f_R0 (fun i:nat => Bn (S i)) (pred N));
+ ring.
+rewrite
+ (sum_N_predN
+ (fun k:nat =>
+ sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat)
+ (pred (N - k))) (pred N)).
+replace
+ (sum_f_R0
+ (fun k:nat =>
+ sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat)
+ (pred (N - k))) (pred (pred N))) with
+ (sum_f_R0
+ (fun k:nat =>
+ sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat)
+ (pred (pred (N - k))) + An (S N) * Bn (S k)) (
+ pred (pred N))).
+rewrite
+ (sum_plus
+ (fun k:nat =>
+ sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat)
+ (pred (pred (N - k)))) (fun k:nat => An (S N) * Bn (S k))
+ (pred (pred N))).
+repeat rewrite Rplus_assoc; apply Rplus_eq_compat_l.
+replace (pred (N - pred N)) with 0%nat.
+simpl in |- *; rewrite <- minus_n_O.
+replace (S (pred N)) with N.
+replace (sum_f_R0 (fun k:nat => An (S N) * Bn (S k)) (pred (pred N))) with
+ (sum_f_R0 (fun k:nat => Bn (S k) * An (S N)) (pred (pred N))).
+rewrite <- (scal_sum (fun l:nat => Bn (S l)) (pred (pred N)) (An (S N)));
+ rewrite (sum_N_predN (fun l:nat => Bn (S l)) (pred N)).
+replace (S (pred N)) with N.
+ring.
+apply S_pred with 0%nat; assumption.
+apply lt_pred; apply lt_le_trans with 2%nat; [ apply lt_n_Sn | assumption ].
+apply sum_eq; intros; apply Rmult_comm.
+apply S_pred with 0%nat; assumption.
+replace (N - pred N)%nat with 1%nat.
+reflexivity.
+pattern N at 1 in |- *; replace N with (S (pred N)).
+rewrite <- minus_Sn_m.
+rewrite <- minus_n_n; reflexivity.
+apply le_n.
+symmetry in |- *; apply S_pred with 0%nat; assumption.
+apply sum_eq; intros;
+ rewrite
+ (sum_N_predN (fun l:nat => An (S (S (l + i))) * Bn (N - l)%nat)
+ (pred (N - i))).
+replace (S (S (pred (N - i) + i))) with (S N).
+replace (N - pred (N - i))%nat with (S i).
+ring.
+rewrite pred_of_minus; apply INR_eq; repeat rewrite minus_INR.
+rewrite S_INR; ring.
+apply le_trans with (pred (pred N)).
+assumption.
+apply le_trans with (pred N); apply le_pred_n.
+apply INR_le; rewrite minus_INR.
+apply Rplus_le_reg_l with (INR i - 1).
+replace (INR i - 1 + INR 1) with (INR i); [ idtac | ring ].
+replace (INR i - 1 + (INR N - INR i)) with (INR N - INR 1); [ idtac | ring ].
+rewrite <- minus_INR.
+apply le_INR; apply le_trans with (pred (pred N)).
+assumption.
+rewrite <- pred_of_minus; apply le_pred_n.
+apply le_trans with 2%nat.
+apply le_n_Sn.
+assumption.
+apply le_trans with (pred (pred N)).
+assumption.
+apply le_trans with (pred N); apply le_pred_n.
+rewrite <- pred_of_minus.
+apply le_trans with (pred N).
+apply le_S_n.
+replace (S (pred N)) with N.
+replace (S (pred (N - i))) with (N - i)%nat.
+apply (fun p n m:nat => plus_le_reg_l n m p) with i; rewrite le_plus_minus_r.
+apply le_plus_r.
+apply le_trans with (pred (pred N));
+ [ assumption | apply le_trans with (pred N); apply le_pred_n ].
+apply S_pred with 0%nat.
+apply plus_lt_reg_l with i; rewrite le_plus_minus_r.
+replace (i + 0)%nat with i; [ idtac | ring ].
+apply le_lt_trans with (pred (pred N));
+ [ assumption | apply lt_trans with (pred N); apply lt_pred_n_n ].
+apply lt_S_n.
+replace (S (pred N)) with N.
+apply lt_le_trans with 2%nat.
+apply lt_n_Sn.
+assumption.
+apply S_pred with 0%nat; assumption.
+assumption.
+apply le_trans with (pred (pred N)).
+assumption.
+apply le_trans with (pred N); apply le_pred_n.
+apply S_pred with 0%nat; assumption.
+apply le_pred_n.
+apply INR_eq; rewrite pred_of_minus; do 3 rewrite S_INR; rewrite plus_INR;
+ repeat rewrite minus_INR.
+ring.
+apply le_trans with (pred (pred N)).
+assumption.
+apply le_trans with (pred N); apply le_pred_n.
+apply INR_le.
+rewrite minus_INR.
+apply Rplus_le_reg_l with (INR i - 1).
+replace (INR i - 1 + INR 1) with (INR i); [ idtac | ring ].
+replace (INR i - 1 + (INR N - INR i)) with (INR N - INR 1); [ idtac | ring ].
+rewrite <- minus_INR.
+apply le_INR.
+apply le_trans with (pred (pred N)).
+assumption.
+rewrite <- pred_of_minus.
+apply le_pred_n.
+apply le_trans with 2%nat.
+apply le_n_Sn.
+assumption.
+apply le_trans with (pred (pred N)).
+assumption.
+apply le_trans with (pred N); apply le_pred_n.
+apply lt_le_trans with 1%nat.
+apply lt_O_Sn.
+apply INR_le.
+rewrite pred_of_minus.
+repeat rewrite minus_INR.
+apply Rplus_le_reg_l with (INR i - 1).
+replace (INR i - 1 + INR 1) with (INR i); [ idtac | ring ].
+replace (INR i - 1 + (INR N - INR i - INR 1)) with (INR N - INR 1 - INR 1).
+repeat rewrite <- minus_INR.
+apply le_INR.
+apply le_trans with (pred (pred N)).
+assumption.
+do 2 rewrite <- pred_of_minus.
+apply le_n.
+apply (fun p n m:nat => plus_le_reg_l n m p) with 1%nat.
+rewrite le_plus_minus_r.
+simpl in |- *; assumption.
+apply le_trans with 2%nat; [ apply le_n_Sn | assumption ].
+apply le_trans with 2%nat; [ apply le_n_Sn | assumption ].
+ring.
+apply le_trans with (pred (pred N)).
+assumption.
+apply le_trans with (pred N); apply le_pred_n.
+apply (fun p n m:nat => plus_le_reg_l n m p) with i.
+rewrite le_plus_minus_r.
+replace (i + 1)%nat with (S i).
+replace N with (S (pred N)).
+apply le_n_S.
+apply le_trans with (pred (pred N)).
+assumption.
+apply le_pred_n.
+symmetry in |- *; apply S_pred with 0%nat; assumption.
+apply INR_eq; rewrite S_INR; rewrite plus_INR; reflexivity.
+apply le_trans with (pred (pred N)).
+assumption.
+apply le_trans with (pred N); apply le_pred_n.
+apply lt_le_trans with 1%nat.
+apply lt_O_Sn.
+apply le_S_n.
+replace (S (pred N)) with N.
+assumption.
+apply S_pred with 0%nat; assumption.
+replace
+ (sum_f_R0
+ (fun k:nat =>
+ sum_f_R0 (fun l:nat => An (S (l + k)) * Bn (S N - l)%nat)
+ (pred (S N - k))) (pred N)) with
+ (sum_f_R0
+ (fun k:nat =>
+ sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat)
+ (pred (N - k)) + An (S k) * Bn (S N)) (pred N)).
+rewrite
+ (sum_plus
+ (fun k:nat =>
+ sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat)
+ (pred (N - k))) (fun k:nat => An (S k) * Bn (S N)))
+ .
+apply Rplus_eq_compat_l.
+rewrite scal_sum; reflexivity.
+apply sum_eq; intros; rewrite Rplus_comm;
+ rewrite
+ (decomp_sum (fun l:nat => An (S (l + i)) * Bn (S N - l)%nat)
+ (pred (S N - i))).
+replace (0 + i)%nat with i; [ idtac | ring ].
+rewrite <- minus_n_O; apply Rplus_eq_compat_l.
+replace (pred (pred (S N - i))) with (pred (N - i)).
+apply sum_eq; intros.
+replace (S N - S i0)%nat with (N - i0)%nat; [ idtac | reflexivity ].
+replace (S i0 + i)%nat with (S (i0 + i)).
+reflexivity.
+apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; rewrite S_INR; ring.
+cut ((N - i)%nat = pred (S N - i)).
+intro; rewrite H5; reflexivity.
+rewrite pred_of_minus.
+apply INR_eq; repeat rewrite minus_INR.
+rewrite S_INR; ring.
+apply le_trans with N.
+apply le_trans with (pred N).
+assumption.
+apply le_pred_n.
+apply le_n_Sn.
+apply (fun p n m:nat => plus_le_reg_l n m p) with i.
+rewrite le_plus_minus_r.
+replace (i + 1)%nat with (S i).
+apply le_n_S.
+apply le_trans with (pred N).
+assumption.
+apply le_pred_n.
+apply INR_eq; rewrite S_INR; rewrite plus_INR; ring.
+apply le_trans with N.
+apply le_trans with (pred N).
+assumption.
+apply le_pred_n.
+apply le_n_Sn.
+apply le_trans with (pred N).
+assumption.
+apply le_pred_n.
+replace (pred (S N - i)) with (S N - S i)%nat.
+replace (S N - S i)%nat with (N - i)%nat; [ idtac | reflexivity ].
+apply plus_lt_reg_l with i.
+rewrite le_plus_minus_r.
+replace (i + 0)%nat with i; [ idtac | ring ].
+apply le_lt_trans with (pred N).
+assumption.
+apply lt_pred_n_n.
+assumption.
+apply le_trans with (pred N).
+assumption.
+apply le_pred_n.
+rewrite pred_of_minus.
+apply INR_eq; repeat rewrite minus_INR.
+repeat rewrite S_INR; ring.
+apply le_trans with N.
+apply le_trans with (pred N).
+assumption.
+apply le_pred_n.
+apply le_n_Sn.
+apply (fun p n m:nat => plus_le_reg_l n m p) with i.
+rewrite le_plus_minus_r.
+replace (i + 1)%nat with (S i).
+apply le_n_S.
+apply le_trans with (pred N).
+assumption.
+apply le_pred_n.
+apply INR_eq; rewrite S_INR; rewrite plus_INR; ring.
+apply le_trans with N.
+apply le_trans with (pred N).
+assumption.
+apply le_pred_n.
+apply le_n_Sn.
+apply le_n_S.
+apply le_trans with (pred N).
+assumption.
+apply le_pred_n.
+rewrite Rplus_comm.
+rewrite (decomp_sum (fun p:nat => An p * Bn (S N - p)%nat) N).
+rewrite <- minus_n_O.
+apply Rplus_eq_compat_l.
+apply sum_eq; intros.
+reflexivity.
+assumption.
+rewrite Rplus_comm.
+rewrite
+ (decomp_sum
+ (fun k:nat =>
+ sum_f_R0 (fun l:nat => An (S (l + k)) * Bn (N - l)%nat) (pred (N - k)))
+ (pred N)).
+rewrite <- minus_n_O.
+replace (sum_f_R0 (fun l:nat => An (S (l + 0)) * Bn (N - l)%nat) (pred N))
+ with (sum_f_R0 (fun l:nat => An (S l) * Bn (N - l)%nat) (pred N)).
+apply Rplus_eq_compat_l.
+apply sum_eq; intros.
+replace (pred (N - S i)) with (pred (pred (N - i))).
+apply sum_eq; intros.
+replace (i0 + S i)%nat with (S (i0 + i)).
+reflexivity.
+apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; rewrite S_INR; ring.
+cut (pred (N - i) = (N - S i)%nat).
+intro; rewrite H5; reflexivity.
+rewrite pred_of_minus.
+apply INR_eq.
+repeat rewrite minus_INR.
+repeat rewrite S_INR; ring.
+apply le_trans with (S (pred (pred N))).
+apply le_n_S; assumption.
+replace (S (pred (pred N))) with (pred N).
+apply le_pred_n.
+apply S_pred with 0%nat.
+apply lt_S_n.
+replace (S (pred N)) with N.
+apply lt_le_trans with 2%nat.
+apply lt_n_Sn.
+assumption.
+apply S_pred with 0%nat; assumption.
+apply le_trans with (pred (pred N)).
+assumption.
+apply le_trans with (pred N); apply le_pred_n.
+apply (fun p n m:nat => plus_le_reg_l n m p) with i.
+rewrite le_plus_minus_r.
+replace (i + 1)%nat with (S i).
+replace N with (S (pred N)).
+apply le_n_S.
+apply le_trans with (pred (pred N)).
+assumption.
+apply le_pred_n.
+symmetry in |- *; apply S_pred with 0%nat; assumption.
+apply INR_eq; rewrite S_INR; rewrite plus_INR; ring.
+apply le_trans with (pred (pred N)).
+assumption.
+apply le_trans with (pred N); apply le_pred_n.
+apply sum_eq; intros.
+replace (i + 0)%nat with i; [ reflexivity | trivial ].
+apply lt_S_n.
+replace (S (pred N)) with N.
+apply lt_le_trans with 2%nat; [ apply lt_n_Sn | assumption ].
+apply S_pred with 0%nat; assumption.
+inversion H1.
+left; reflexivity.
+right; apply le_n_S; assumption.
+simpl in |- *.
+replace (S (pred N)) with N.
+reflexivity.
+apply S_pred with 0%nat; assumption.
+simpl in |- *.
+cut ((N - pred N)%nat = 1%nat).
+intro; rewrite H2; reflexivity.
+rewrite pred_of_minus.
+apply INR_eq; repeat rewrite minus_INR.
+ring.
+apply lt_le_S; assumption.
+rewrite <- pred_of_minus; apply le_pred_n.
+simpl in |- *; symmetry in |- *; apply S_pred with 0%nat; assumption.
+inversion H.
+left; reflexivity.
+right; apply lt_le_trans with 1%nat; [ apply lt_n_Sn | exact H1 ].
+Qed. \ No newline at end of file
diff --git a/theories/Reals/Cos_plus.v b/theories/Reals/Cos_plus.v
index 41815fc20..d29193ad7 100644
--- a/theories/Reals/Cos_plus.v
+++ b/theories/Reals/Cos_plus.v
@@ -8,1010 +8,1054 @@
(*i $Id$ i*)
-Require Rbase.
-Require Rfunctions.
-Require SeqSeries.
-Require Rtrigo_def.
-Require Cos_rel.
-Require Max.
-V7only [Import nat_scope.]. Open Local Scope nat_scope.
-V7only [Import R_scope.]. Open Local Scope R_scope.
+Require Import Rbase.
+Require Import Rfunctions.
+Require Import SeqSeries.
+Require Import Rtrigo_def.
+Require Import Cos_rel.
+Require Import Max. Open Local Scope nat_scope. Open Local Scope R_scope.
-Definition Majxy [x,y:R] : nat->R := [n:nat](Rdiv (pow (Rmax R1 (Rmax (Rabsolu x) (Rabsolu y))) (mult (4) (S n))) (INR (fact n))).
+Definition Majxy (x y:R) (n:nat) : R :=
+ Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (4 * S n) / INR (fact n).
-Lemma Majxy_cv_R0 : (x,y:R) (Un_cv (Majxy x y) R0).
-Intros.
-Pose C := (Rmax R1 (Rmax (Rabsolu x) (Rabsolu y))).
-Pose C0 := (pow C (4)).
-Cut ``0<C``.
-Intro.
-Cut ``0<C0``.
-Intro.
-Assert H1 := (cv_speed_pow_fact C0).
-Unfold Un_cv in H1; Unfold R_dist in H1.
-Unfold Un_cv; Unfold R_dist; Intros.
-Cut ``0<eps/C0``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Assumption]].
-Elim (H1 ``eps/C0`` H3); Intros N0 H4.
-Exists N0; Intros.
-Replace (Majxy x y n) with ``(pow C0 (S n))/(INR (fact n))``.
-Simpl.
-Apply Rlt_monotony_contra with ``(Rabsolu (/C0))``.
-Apply Rabsolu_pos_lt.
-Apply Rinv_neq_R0.
-Red; Intro; Rewrite H6 in H0; Elim (Rlt_antirefl ? H0).
-Rewrite <- Rabsolu_mult.
-Unfold Rminus; Rewrite Rmult_Rplus_distr.
-Rewrite Ropp_O; Rewrite Rmult_Or.
-Unfold Rdiv; Repeat Rewrite <- Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l.
-Rewrite (Rabsolu_right ``/C0``).
-Rewrite <- (Rmult_sym eps).
-Replace ``(pow C0 n)*/(INR (fact n))+0`` with ``(pow C0 n)*/(INR (fact n))-0``; [Idtac | Ring].
-Unfold Rdiv in H4; Apply H4; Assumption.
-Apply Rle_sym1; Left; Apply Rlt_Rinv; Assumption.
-Red; Intro; Rewrite H6 in H0; Elim (Rlt_antirefl ? H0).
-Unfold Majxy.
-Unfold C0.
-Rewrite pow_mult.
-Unfold C; Reflexivity.
-Unfold C0; Apply pow_lt; Assumption.
-Apply Rlt_le_trans with R1.
-Apply Rlt_R0_R1.
-Unfold C.
-Apply RmaxLess1.
+Lemma Majxy_cv_R0 : forall x y:R, Un_cv (Majxy x y) 0.
+intros.
+pose (C := Rmax 1 (Rmax (Rabs x) (Rabs y))).
+pose (C0 := C ^ 4).
+cut (0 < C).
+intro.
+cut (0 < C0).
+intro.
+assert (H1 := cv_speed_pow_fact C0).
+unfold Un_cv in H1; unfold R_dist in H1.
+unfold Un_cv in |- *; unfold R_dist in |- *; intros.
+cut (0 < eps / C0);
+ [ intro
+ | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ assumption | apply Rinv_0_lt_compat; assumption ] ].
+elim (H1 (eps / C0) H3); intros N0 H4.
+exists N0; intros.
+replace (Majxy x y n) with (C0 ^ S n / INR (fact n)).
+simpl in |- *.
+apply Rmult_lt_reg_l with (Rabs (/ C0)).
+apply Rabs_pos_lt.
+apply Rinv_neq_0_compat.
+red in |- *; intro; rewrite H6 in H0; elim (Rlt_irrefl _ H0).
+rewrite <- Rabs_mult.
+unfold Rminus in |- *; rewrite Rmult_plus_distr_l.
+rewrite Ropp_0; rewrite Rmult_0_r.
+unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc.
+rewrite <- Rinv_l_sym.
+rewrite Rmult_1_l.
+rewrite (Rabs_right (/ C0)).
+rewrite <- (Rmult_comm eps).
+replace (C0 ^ n * / INR (fact n) + 0) with (C0 ^ n * / INR (fact n) - 0);
+ [ idtac | ring ].
+unfold Rdiv in H4; apply H4; assumption.
+apply Rle_ge; left; apply Rinv_0_lt_compat; assumption.
+red in |- *; intro; rewrite H6 in H0; elim (Rlt_irrefl _ H0).
+unfold Majxy in |- *.
+unfold C0 in |- *.
+rewrite pow_mult.
+unfold C in |- *; reflexivity.
+unfold C0 in |- *; apply pow_lt; assumption.
+apply Rlt_le_trans with 1.
+apply Rlt_0_1.
+unfold C in |- *.
+apply RmaxLess1.
Qed.
-Lemma reste1_maj : (x,y:R;N:nat) (lt O N) -> ``(Rabsolu (Reste1 x y N))<=(Majxy x y (pred N))``.
-Intros.
-Pose C := (Rmax R1 (Rmax (Rabsolu x) (Rabsolu y))).
-Unfold Reste1.
-Apply Rle_trans with (sum_f_R0
- [k:nat]
- (Rabsolu (sum_f_R0
- [l:nat]
- ``(pow ( -1) (S (plus l k)))/
- (INR (fact (mult (S (S O)) (S (plus l k)))))*
- (pow x (mult (S (S O)) (S (plus l k))))*
- (pow ( -1) (minus N l))/
- (INR (fact (mult (S (S O)) (minus N l))))*
- (pow y (mult (S (S O)) (minus N l)))`` (pred (minus N k))))
- (pred N)).
-Apply (sum_Rabsolu [k:nat]
- (sum_f_R0
- [l:nat]
- ``(pow ( -1) (S (plus l k)))/
- (INR (fact (mult (S (S O)) (S (plus l k)))))*
- (pow x (mult (S (S O)) (S (plus l k))))*
- (pow ( -1) (minus N l))/
- (INR (fact (mult (S (S O)) (minus N l))))*
- (pow y (mult (S (S O)) (minus N l)))`` (pred (minus N k))) (pred N)).
-Apply Rle_trans with (sum_f_R0
- [k:nat]
- (sum_f_R0
- [l:nat]
- (Rabsolu (``(pow ( -1) (S (plus l k)))/
- (INR (fact (mult (S (S O)) (S (plus l k)))))*
- (pow x (mult (S (S O)) (S (plus l k))))*
- (pow ( -1) (minus N l))/
- (INR (fact (mult (S (S O)) (minus N l))))*
- (pow y (mult (S (S O)) (minus N l)))``)) (pred (minus N k)))
- (pred N)).
-Apply sum_Rle.
-Intros.
-Apply (sum_Rabsolu [l:nat]
- ``(pow ( -1) (S (plus l n)))/
- (INR (fact (mult (S (S O)) (S (plus l n)))))*
- (pow x (mult (S (S O)) (S (plus l n))))*
- (pow ( -1) (minus N l))/
- (INR (fact (mult (S (S O)) (minus N l))))*
- (pow y (mult (S (S O)) (minus N l)))`` (pred (minus N n))).
-Apply Rle_trans with (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``/(INR (mult (fact (mult (S (S O)) (S (plus l k)))) (fact (mult (S (S O)) (minus N l)))))*(pow C (mult (S (S O)) (S (plus N k))))`` (pred (minus N k))) (pred N)).
-Apply sum_Rle; Intros.
-Apply sum_Rle; Intros.
-Unfold Rdiv; Repeat Rewrite Rabsolu_mult.
-Do 2 Rewrite pow_1_abs.
-Do 2 Rewrite Rmult_1l.
-Rewrite (Rabsolu_right ``/(INR (fact (mult (S (S O)) (S (plus n0 n)))))``).
-Rewrite (Rabsolu_right ``/(INR (fact (mult (S (S O)) (minus N n0))))``).
-Rewrite mult_INR.
-Rewrite Rinv_Rmult.
-Repeat Rewrite Rmult_assoc.
-Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Rewrite <- Rmult_assoc.
-Rewrite <- (Rmult_sym ``/(INR (fact (mult (S (S O)) (minus N n0))))``).
-Rewrite Rmult_assoc.
-Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Do 2 Rewrite <- Pow_Rabsolu.
-Apply Rle_trans with ``(pow (Rabsolu x) (mult (S (S O)) (S (plus n0 n))))*(pow C (mult (S (S O)) (minus N n0)))``.
-Apply Rle_monotony.
-Apply pow_le; Apply Rabsolu_pos.
-Apply pow_incr.
-Split.
-Apply Rabsolu_pos.
-Unfold C.
-Apply Rle_trans with (Rmax (Rabsolu x) (Rabsolu y)); Apply RmaxLess2.
-Apply Rle_trans with ``(pow C (mult (S (S O)) (S (plus n0 n))))*(pow C (mult (S (S O)) (minus N n0)))``.
-Do 2 Rewrite <- (Rmult_sym ``(pow C (mult (S (S O)) (minus N n0)))``).
-Apply Rle_monotony.
-Apply pow_le.
-Apply Rle_trans with R1.
-Left; Apply Rlt_R0_R1.
-Unfold C; Apply RmaxLess1.
-Apply pow_incr.
-Split.
-Apply Rabsolu_pos.
-Unfold C; Apply Rle_trans with (Rmax (Rabsolu x) (Rabsolu y)).
-Apply RmaxLess1.
-Apply RmaxLess2.
-Right.
-Replace (mult (2) (S (plus N n))) with (plus (mult (2) (minus N n0)) (mult (2) (S (plus n0 n)))).
-Rewrite pow_add.
-Apply Rmult_sym.
-Apply INR_eq; Rewrite plus_INR; Do 3 Rewrite mult_INR.
-Rewrite minus_INR.
-Repeat Rewrite S_INR; Do 2 Rewrite plus_INR; Ring.
-Apply le_trans with (pred (minus N n)).
-Exact H1.
-Apply le_S_n.
-Replace (S (pred (minus N n))) with (minus N n).
-Apply le_trans with N.
-Apply simpl_le_plus_l with n.
-Rewrite <- le_plus_minus.
-Apply le_plus_r.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply le_n_Sn.
-Apply S_pred with O.
-Apply simpl_lt_plus_l with n.
-Rewrite <- le_plus_minus.
-Replace (plus n O) with n; [Idtac | Ring].
-Apply le_lt_trans with (pred N).
-Assumption.
-Apply lt_pred_n_n; Assumption.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply Rle_sym1; Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Apply Rle_sym1; Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Apply Rle_trans with (sum_f_R0
- [k:nat]
- (sum_f_R0
- [l:nat]
- ``/(INR
- (mult (fact (mult (S (S O)) (S (plus l k))))
- (fact (mult (S (S O)) (minus N l)))))*
- (pow C (mult (S (S (S (S O)))) N))`` (pred (minus N k)))
- (pred N)).
-Apply sum_Rle; Intros.
-Apply sum_Rle; Intros.
-Apply Rle_monotony.
-Left; Apply Rlt_Rinv.
-Rewrite mult_INR; Apply Rmult_lt_pos; Apply INR_fact_lt_0.
-Apply Rle_pow.
-Unfold C; Apply RmaxLess1.
-Replace (mult (4) N) with (mult (2) (mult (2) N)); [Idtac | Ring].
-Apply mult_le.
-Replace (mult (2) N) with (S (plus N (pred N))).
-Apply le_n_S.
-Apply le_reg_l; Assumption.
-Rewrite pred_of_minus.
-Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Rewrite mult_INR; Rewrite minus_INR.
-Repeat Rewrite S_INR; Ring.
-Apply lt_le_S; Assumption.
-Apply Rle_trans with (sum_f_R0
- [k:nat]
- (sum_f_R0
- [l:nat]
- ``(pow C (mult (S (S (S (S O)))) N))*(Rsqr (/(INR (fact (S (plus N k))))))`` (pred (minus N k)))
- (pred N)).
-Apply sum_Rle; Intros.
-Apply sum_Rle; Intros.
-Rewrite <- (Rmult_sym ``(pow C (mult (S (S (S (S O)))) N))``).
-Apply Rle_monotony.
-Apply pow_le.
-Left; Apply Rlt_le_trans with R1.
-Apply Rlt_R0_R1.
-Unfold C; Apply RmaxLess1.
-Replace ``/(INR
- (mult (fact (mult (S (S O)) (S (plus n0 n))))
- (fact (mult (S (S O)) (minus N n0)))))`` with ``(Binomial.C (mult (S (S O)) (S (plus N n))) (mult (S (S O)) (S (plus n0 n))))/(INR (fact (mult (S (S O)) (S (plus N n)))))``.
-Apply Rle_trans with ``(Binomial.C (mult (S (S O)) (S (plus N n))) (S (plus N n)))/(INR (fact (mult (S (S O)) (S (plus N n)))))``.
-Unfold Rdiv; Do 2 Rewrite <- (Rmult_sym ``/(INR (fact (mult (S (S O)) (S (plus N n)))))``).
-Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Apply C_maj.
-Apply mult_le.
-Apply le_n_S.
-Apply le_reg_r.
-Apply le_trans with (pred (minus N n)).
-Assumption.
-Apply le_S_n.
-Replace (S (pred (minus N n))) with (minus N n).
-Apply le_trans with N.
-Apply simpl_le_plus_l with n.
-Rewrite <- le_plus_minus.
-Apply le_plus_r.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply le_n_Sn.
-Apply S_pred with O.
-Apply simpl_lt_plus_l with n.
-Rewrite <- le_plus_minus.
-Replace (plus n O) with n; [Idtac | Ring].
-Apply le_lt_trans with (pred N).
-Assumption.
-Apply lt_pred_n_n; Assumption.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Right.
-Unfold Rdiv; Rewrite Rmult_sym.
-Unfold Binomial.C.
-Unfold Rdiv; Repeat Rewrite <- Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l.
-Replace (minus (mult (2) (S (plus N n))) (S (plus N n))) with (S (plus N n)).
-Rewrite Rinv_Rmult.
-Unfold Rsqr; Reflexivity.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply INR_eq; Rewrite S_INR; Rewrite minus_INR.
-Rewrite mult_INR; Repeat Rewrite S_INR; Rewrite plus_INR; Ring.
-Apply le_n_2n.
-Apply INR_fact_neq_0.
-Unfold Rdiv; Rewrite Rmult_sym.
-Unfold Binomial.C.
-Unfold Rdiv; Repeat Rewrite <- Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l.
-Replace (minus (mult (2) (S (plus N n))) (mult (2) (S (plus n0 n)))) with (mult (2) (minus N n0)).
-Rewrite mult_INR.
-Reflexivity.
-Apply INR_eq; Rewrite minus_INR.
-Do 3 Rewrite mult_INR; Repeat Rewrite S_INR; Do 2 Rewrite plus_INR; Rewrite minus_INR.
-Ring.
-Apply le_trans with (pred (minus N n)).
-Assumption.
-Apply le_S_n.
-Replace (S (pred (minus N n))) with (minus N n).
-Apply le_trans with N.
-Apply simpl_le_plus_l with n.
-Rewrite <- le_plus_minus.
-Apply le_plus_r.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply le_n_Sn.
-Apply S_pred with O.
-Apply simpl_lt_plus_l with n.
-Rewrite <- le_plus_minus.
-Replace (plus n O) with n; [Idtac | Ring].
-Apply le_lt_trans with (pred N).
-Assumption.
-Apply lt_pred_n_n; Assumption.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply mult_le.
-Apply le_n_S.
-Apply le_reg_r.
-Apply le_trans with (pred (minus N n)).
-Assumption.
-Apply le_S_n.
-Replace (S (pred (minus N n))) with (minus N n).
-Apply le_trans with N.
-Apply simpl_le_plus_l with n.
-Rewrite <- le_plus_minus.
-Apply le_plus_r.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply le_n_Sn.
-Apply S_pred with O.
-Apply simpl_lt_plus_l with n.
-Rewrite <- le_plus_minus.
-Replace (plus n O) with n; [Idtac | Ring].
-Apply le_lt_trans with (pred N).
-Assumption.
-Apply lt_pred_n_n; Assumption.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply INR_fact_neq_0.
-Apply Rle_trans with (sum_f_R0 [k:nat]``(INR N)/(INR (fact (S N)))*(pow C (mult (S (S (S (S O)))) N))`` (pred N)).
-Apply sum_Rle; Intros.
-Rewrite <- (scal_sum [_:nat]``(pow C (mult (S (S (S (S O)))) N))`` (pred (minus N n)) ``(Rsqr (/(INR (fact (S (plus N n))))))``).
-Rewrite sum_cte.
-Rewrite <- Rmult_assoc.
-Do 2 Rewrite <- (Rmult_sym ``(pow C (mult (S (S (S (S O)))) N))``).
-Rewrite Rmult_assoc.
-Apply Rle_monotony.
-Apply pow_le.
-Left; Apply Rlt_le_trans with R1.
-Apply Rlt_R0_R1.
-Unfold C; Apply RmaxLess1.
-Apply Rle_trans with ``(Rsqr (/(INR (fact (S (plus N n))))))*(INR N)``.
-Apply Rle_monotony.
-Apply pos_Rsqr.
-Replace (S (pred (minus N n))) with (minus N n).
-Apply le_INR.
-Apply simpl_le_plus_l with n.
-Rewrite <- le_plus_minus.
-Apply le_plus_r.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply S_pred with O.
-Apply simpl_lt_plus_l with n.
-Rewrite <- le_plus_minus.
-Replace (plus n O) with n; [Idtac | Ring].
-Apply le_lt_trans with (pred N).
-Assumption.
-Apply lt_pred_n_n; Assumption.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Rewrite Rmult_sym; Unfold Rdiv; Apply Rle_monotony.
-Apply pos_INR.
-Apply Rle_trans with ``/(INR (fact (S (plus N n))))``.
-Pattern 2 ``/(INR (fact (S (plus N n))))``; Rewrite <- Rmult_1r.
-Unfold Rsqr.
-Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Apply Rle_monotony_contra with ``(INR (fact (S (plus N n))))``.
-Apply INR_fact_lt_0.
-Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r.
-Replace R1 with (INR (S O)).
-Apply le_INR.
-Apply lt_le_S.
-Apply INR_lt; Apply INR_fact_lt_0.
-Reflexivity.
-Apply INR_fact_neq_0.
-Apply Rle_monotony_contra with ``(INR (fact (S (plus N n))))``.
-Apply INR_fact_lt_0.
-Rewrite <- Rinv_r_sym.
-Apply Rle_monotony_contra with ``(INR (fact (S N)))``.
-Apply INR_fact_lt_0.
-Rewrite Rmult_1r.
-Rewrite (Rmult_sym (INR (fact (S N)))).
-Rewrite Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Apply le_INR.
-Apply fact_growing.
-Apply le_n_S.
-Apply le_plus_l.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Rewrite sum_cte.
-Apply Rle_trans with ``(pow C (mult (S (S (S (S O)))) N))/(INR (fact (pred N)))``.
-Rewrite <- (Rmult_sym ``(pow C (mult (S (S (S (S O)))) N))``).
-Unfold Rdiv; Rewrite Rmult_assoc; Apply Rle_monotony.
-Apply pow_le.
-Left; Apply Rlt_le_trans with R1.
-Apply Rlt_R0_R1.
-Unfold C; Apply RmaxLess1.
-Cut (S (pred N)) = N.
-Intro; Rewrite H0.
-Pattern 2 N; Rewrite <- H0.
-Do 2 Rewrite fact_simpl.
-Rewrite H0.
-Repeat Rewrite mult_INR.
-Repeat Rewrite Rinv_Rmult.
-Rewrite (Rmult_sym ``/(INR (S N))``).
-Repeat Rewrite <- Rmult_assoc.
-Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1l.
-Pattern 2 ``/(INR (fact (pred N)))``; Rewrite <- Rmult_1r.
-Rewrite Rmult_assoc.
-Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Apply Rle_monotony_contra with (INR (S N)).
-Apply lt_INR_0; Apply lt_O_Sn.
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Rewrite Rmult_1l.
-Apply le_INR; Apply le_n_Sn.
-Apply not_O_INR; Discriminate.
-Apply not_O_INR.
-Red; Intro; Rewrite H1 in H; Elim (lt_n_n ? H).
-Apply not_O_INR.
-Red; Intro; Rewrite H1 in H; Elim (lt_n_n ? H).
-Apply INR_fact_neq_0.
-Apply not_O_INR; Discriminate.
-Apply prod_neq_R0.
-Apply not_O_INR.
-Red; Intro; Rewrite H1 in H; Elim (lt_n_n ? H).
-Apply INR_fact_neq_0.
-Symmetry; Apply S_pred with O; Assumption.
-Right.
-Unfold Majxy.
-Unfold C.
-Replace (S (pred N)) with N.
-Reflexivity.
-Apply S_pred with O; Assumption.
+Lemma reste1_maj :
+ forall (x y:R) (N:nat),
+ (0 < N)%nat -> Rabs (Reste1 x y N) <= Majxy x y (pred N).
+intros.
+pose (C := Rmax 1 (Rmax (Rabs x) (Rabs y))).
+unfold Reste1 in |- *.
+apply Rle_trans with
+ (sum_f_R0
+ (fun k:nat =>
+ Rabs
+ (sum_f_R0
+ (fun l:nat =>
+ (-1) ^ S (l + k) / INR (fact (2 * S (l + k))) *
+ x ^ (2 * S (l + k)) *
+ ((-1) ^ (N - l) / INR (fact (2 * (N - l)))) *
+ y ^ (2 * (N - l))) (pred (N - k)))) (
+ pred N)).
+apply
+ (Rsum_abs
+ (fun k:nat =>
+ sum_f_R0
+ (fun l:nat =>
+ (-1) ^ S (l + k) / INR (fact (2 * S (l + k))) *
+ x ^ (2 * S (l + k)) * ((-1) ^ (N - l) / INR (fact (2 * (N - l)))) *
+ y ^ (2 * (N - l))) (pred (N - k))) (pred N)).
+apply Rle_trans with
+ (sum_f_R0
+ (fun k:nat =>
+ sum_f_R0
+ (fun l:nat =>
+ Rabs
+ ((-1) ^ S (l + k) / INR (fact (2 * S (l + k))) *
+ x ^ (2 * S (l + k)) *
+ ((-1) ^ (N - l) / INR (fact (2 * (N - l)))) *
+ y ^ (2 * (N - l)))) (pred (N - k))) (
+ pred N)).
+apply sum_Rle.
+intros.
+apply
+ (Rsum_abs
+ (fun l:nat =>
+ (-1) ^ S (l + n) / INR (fact (2 * S (l + n))) * x ^ (2 * S (l + n)) *
+ ((-1) ^ (N - l) / INR (fact (2 * (N - l)))) *
+ y ^ (2 * (N - l))) (pred (N - n))).
+apply Rle_trans with
+ (sum_f_R0
+ (fun k:nat =>
+ sum_f_R0
+ (fun l:nat =>
+ / INR (fact (2 * S (l + k)) * fact (2 * (N - l))) *
+ C ^ (2 * S (N + k))) (pred (N - k))) (pred N)).
+apply sum_Rle; intros.
+apply sum_Rle; intros.
+unfold Rdiv in |- *; repeat rewrite Rabs_mult.
+do 2 rewrite pow_1_abs.
+do 2 rewrite Rmult_1_l.
+rewrite (Rabs_right (/ INR (fact (2 * S (n0 + n))))).
+rewrite (Rabs_right (/ INR (fact (2 * (N - n0))))).
+rewrite mult_INR.
+rewrite Rinv_mult_distr.
+repeat rewrite Rmult_assoc.
+apply Rmult_le_compat_l.
+left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+rewrite <- Rmult_assoc.
+rewrite <- (Rmult_comm (/ INR (fact (2 * (N - n0))))).
+rewrite Rmult_assoc.
+apply Rmult_le_compat_l.
+left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+do 2 rewrite <- RPow_abs.
+apply Rle_trans with (Rabs x ^ (2 * S (n0 + n)) * C ^ (2 * (N - n0))).
+apply Rmult_le_compat_l.
+apply pow_le; apply Rabs_pos.
+apply pow_incr.
+split.
+apply Rabs_pos.
+unfold C in |- *.
+apply Rle_trans with (Rmax (Rabs x) (Rabs y)); apply RmaxLess2.
+apply Rle_trans with (C ^ (2 * S (n0 + n)) * C ^ (2 * (N - n0))).
+do 2 rewrite <- (Rmult_comm (C ^ (2 * (N - n0)))).
+apply Rmult_le_compat_l.
+apply pow_le.
+apply Rle_trans with 1.
+left; apply Rlt_0_1.
+unfold C in |- *; apply RmaxLess1.
+apply pow_incr.
+split.
+apply Rabs_pos.
+unfold C in |- *; apply Rle_trans with (Rmax (Rabs x) (Rabs y)).
+apply RmaxLess1.
+apply RmaxLess2.
+right.
+replace (2 * S (N + n))%nat with (2 * (N - n0) + 2 * S (n0 + n))%nat.
+rewrite pow_add.
+apply Rmult_comm.
+apply INR_eq; rewrite plus_INR; do 3 rewrite mult_INR.
+rewrite minus_INR.
+repeat rewrite S_INR; do 2 rewrite plus_INR; ring.
+apply le_trans with (pred (N - n)).
+exact H1.
+apply le_S_n.
+replace (S (pred (N - n))) with (N - n)%nat.
+apply le_trans with N.
+apply (fun p n m:nat => plus_le_reg_l n m p) with n.
+rewrite <- le_plus_minus.
+apply le_plus_r.
+apply le_trans with (pred N).
+assumption.
+apply le_pred_n.
+apply le_n_Sn.
+apply S_pred with 0%nat.
+apply plus_lt_reg_l with n.
+rewrite <- le_plus_minus.
+replace (n + 0)%nat with n; [ idtac | ring ].
+apply le_lt_trans with (pred N).
+assumption.
+apply lt_pred_n_n; assumption.
+apply le_trans with (pred N).
+assumption.
+apply le_pred_n.
+apply INR_fact_neq_0.
+apply INR_fact_neq_0.
+apply Rle_ge; left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+apply Rle_ge; left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+apply Rle_trans with
+ (sum_f_R0
+ (fun k:nat =>
+ sum_f_R0
+ (fun l:nat =>
+ / INR (fact (2 * S (l + k)) * fact (2 * (N - l))) * C ^ (4 * N))
+ (pred (N - k))) (pred N)).
+apply sum_Rle; intros.
+apply sum_Rle; intros.
+apply Rmult_le_compat_l.
+left; apply Rinv_0_lt_compat.
+rewrite mult_INR; apply Rmult_lt_0_compat; apply INR_fact_lt_0.
+apply Rle_pow.
+unfold C in |- *; apply RmaxLess1.
+replace (4 * N)%nat with (2 * (2 * N))%nat; [ idtac | ring ].
+apply (fun m n p:nat => mult_le_compat_l p n m).
+replace (2 * N)%nat with (S (N + pred N)).
+apply le_n_S.
+apply plus_le_compat_l; assumption.
+rewrite pred_of_minus.
+apply INR_eq; rewrite S_INR; rewrite plus_INR; rewrite mult_INR;
+ rewrite minus_INR.
+repeat rewrite S_INR; ring.
+apply lt_le_S; assumption.
+apply Rle_trans with
+ (sum_f_R0
+ (fun k:nat =>
+ sum_f_R0 (fun l:nat => C ^ (4 * N) * Rsqr (/ INR (fact (S (N + k)))))
+ (pred (N - k))) (pred N)).
+apply sum_Rle; intros.
+apply sum_Rle; intros.
+rewrite <- (Rmult_comm (C ^ (4 * N))).
+apply Rmult_le_compat_l.
+apply pow_le.
+left; apply Rlt_le_trans with 1.
+apply Rlt_0_1.
+unfold C in |- *; apply RmaxLess1.
+replace (/ INR (fact (2 * S (n0 + n)) * fact (2 * (N - n0)))) with
+ (Binomial.C (2 * S (N + n)) (2 * S (n0 + n)) / INR (fact (2 * S (N + n)))).
+apply Rle_trans with
+ (Binomial.C (2 * S (N + n)) (S (N + n)) / INR (fact (2 * S (N + n)))).
+unfold Rdiv in |- *;
+ do 2 rewrite <- (Rmult_comm (/ INR (fact (2 * S (N + n))))).
+apply Rmult_le_compat_l.
+left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+apply C_maj.
+apply (fun m n p:nat => mult_le_compat_l p n m).
+apply le_n_S.
+apply plus_le_compat_r.
+apply le_trans with (pred (N - n)).
+assumption.
+apply le_S_n.
+replace (S (pred (N - n))) with (N - n)%nat.
+apply le_trans with N.
+apply (fun p n m:nat => plus_le_reg_l n m p) with n.
+rewrite <- le_plus_minus.
+apply le_plus_r.
+apply le_trans with (pred N).
+assumption.
+apply le_pred_n.
+apply le_n_Sn.
+apply S_pred with 0%nat.
+apply plus_lt_reg_l with n.
+rewrite <- le_plus_minus.
+replace (n + 0)%nat with n; [ idtac | ring ].
+apply le_lt_trans with (pred N).
+assumption.
+apply lt_pred_n_n; assumption.
+apply le_trans with (pred N).
+assumption.
+apply le_pred_n.
+right.
+unfold Rdiv in |- *; rewrite Rmult_comm.
+unfold Binomial.C in |- *.
+unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc.
+rewrite <- Rinv_l_sym.
+rewrite Rmult_1_l.
+replace (2 * S (N + n) - S (N + n))%nat with (S (N + n)).
+rewrite Rinv_mult_distr.
+unfold Rsqr in |- *; reflexivity.
+apply INR_fact_neq_0.
+apply INR_fact_neq_0.
+apply INR_eq; rewrite S_INR; rewrite minus_INR.
+rewrite mult_INR; repeat rewrite S_INR; rewrite plus_INR; ring.
+apply le_n_2n.
+apply INR_fact_neq_0.
+unfold Rdiv in |- *; rewrite Rmult_comm.
+unfold Binomial.C in |- *.
+unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc.
+rewrite <- Rinv_l_sym.
+rewrite Rmult_1_l.
+replace (2 * S (N + n) - 2 * S (n0 + n))%nat with (2 * (N - n0))%nat.
+rewrite mult_INR.
+reflexivity.
+apply INR_eq; rewrite minus_INR.
+do 3 rewrite mult_INR; repeat rewrite S_INR; do 2 rewrite plus_INR;
+ rewrite minus_INR.
+ring.
+apply le_trans with (pred (N - n)).
+assumption.
+apply le_S_n.
+replace (S (pred (N - n))) with (N - n)%nat.
+apply le_trans with N.
+apply (fun p n m:nat => plus_le_reg_l n m p) with n.
+rewrite <- le_plus_minus.
+apply le_plus_r.
+apply le_trans with (pred N).
+assumption.
+apply le_pred_n.
+apply le_n_Sn.
+apply S_pred with 0%nat.
+apply plus_lt_reg_l with n.
+rewrite <- le_plus_minus.
+replace (n + 0)%nat with n; [ idtac | ring ].
+apply le_lt_trans with (pred N).
+assumption.
+apply lt_pred_n_n; assumption.
+apply le_trans with (pred N).
+assumption.
+apply le_pred_n.
+apply (fun m n p:nat => mult_le_compat_l p n m).
+apply le_n_S.
+apply plus_le_compat_r.
+apply le_trans with (pred (N - n)).
+assumption.
+apply le_S_n.
+replace (S (pred (N - n))) with (N - n)%nat.
+apply le_trans with N.
+apply (fun p n m:nat => plus_le_reg_l n m p) with n.
+rewrite <- le_plus_minus.
+apply le_plus_r.
+apply le_trans with (pred N).
+assumption.
+apply le_pred_n.
+apply le_n_Sn.
+apply S_pred with 0%nat.
+apply plus_lt_reg_l with n.
+rewrite <- le_plus_minus.
+replace (n + 0)%nat with n; [ idtac | ring ].
+apply le_lt_trans with (pred N).
+assumption.
+apply lt_pred_n_n; assumption.
+apply le_trans with (pred N).
+assumption.
+apply le_pred_n.
+apply INR_fact_neq_0.
+apply Rle_trans with
+ (sum_f_R0 (fun k:nat => INR N / INR (fact (S N)) * C ^ (4 * N)) (pred N)).
+apply sum_Rle; intros.
+rewrite <-
+ (scal_sum (fun _:nat => C ^ (4 * N)) (pred (N - n))
+ (Rsqr (/ INR (fact (S (N + n)))))).
+rewrite sum_cte.
+rewrite <- Rmult_assoc.
+do 2 rewrite <- (Rmult_comm (C ^ (4 * N))).
+rewrite Rmult_assoc.
+apply Rmult_le_compat_l.
+apply pow_le.
+left; apply Rlt_le_trans with 1.
+apply Rlt_0_1.
+unfold C in |- *; apply RmaxLess1.
+apply Rle_trans with (Rsqr (/ INR (fact (S (N + n)))) * INR N).
+apply Rmult_le_compat_l.
+apply Rle_0_sqr.
+replace (S (pred (N - n))) with (N - n)%nat.
+apply le_INR.
+apply (fun p n m:nat => plus_le_reg_l n m p) with n.
+rewrite <- le_plus_minus.
+apply le_plus_r.
+apply le_trans with (pred N).
+assumption.
+apply le_pred_n.
+apply S_pred with 0%nat.
+apply plus_lt_reg_l with n.
+rewrite <- le_plus_minus.
+replace (n + 0)%nat with n; [ idtac | ring ].
+apply le_lt_trans with (pred N).
+assumption.
+apply lt_pred_n_n; assumption.
+apply le_trans with (pred N).
+assumption.
+apply le_pred_n.
+rewrite Rmult_comm; unfold Rdiv in |- *; apply Rmult_le_compat_l.
+apply pos_INR.
+apply Rle_trans with (/ INR (fact (S (N + n)))).
+pattern (/ INR (fact (S (N + n)))) at 2 in |- *; rewrite <- Rmult_1_r.
+unfold Rsqr in |- *.
+apply Rmult_le_compat_l.
+left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+apply Rmult_le_reg_l with (INR (fact (S (N + n)))).
+apply INR_fact_lt_0.
+rewrite <- Rinv_r_sym.
+rewrite Rmult_1_r.
+replace 1 with (INR 1).
+apply le_INR.
+apply lt_le_S.
+apply INR_lt; apply INR_fact_lt_0.
+reflexivity.
+apply INR_fact_neq_0.
+apply Rmult_le_reg_l with (INR (fact (S (N + n)))).
+apply INR_fact_lt_0.
+rewrite <- Rinv_r_sym.
+apply Rmult_le_reg_l with (INR (fact (S N))).
+apply INR_fact_lt_0.
+rewrite Rmult_1_r.
+rewrite (Rmult_comm (INR (fact (S N)))).
+rewrite Rmult_assoc.
+rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r.
+apply le_INR.
+apply fact_le.
+apply le_n_S.
+apply le_plus_l.
+apply INR_fact_neq_0.
+apply INR_fact_neq_0.
+rewrite sum_cte.
+apply Rle_trans with (C ^ (4 * N) / INR (fact (pred N))).
+rewrite <- (Rmult_comm (C ^ (4 * N))).
+unfold Rdiv in |- *; rewrite Rmult_assoc; apply Rmult_le_compat_l.
+apply pow_le.
+left; apply Rlt_le_trans with 1.
+apply Rlt_0_1.
+unfold C in |- *; apply RmaxLess1.
+cut (S (pred N) = N).
+intro; rewrite H0.
+pattern N at 2 in |- *; rewrite <- H0.
+do 2 rewrite fact_simpl.
+rewrite H0.
+repeat rewrite mult_INR.
+repeat rewrite Rinv_mult_distr.
+rewrite (Rmult_comm (/ INR (S N))).
+repeat rewrite <- Rmult_assoc.
+rewrite <- Rinv_r_sym.
+rewrite Rmult_1_l.
+pattern (/ INR (fact (pred N))) at 2 in |- *; rewrite <- Rmult_1_r.
+rewrite Rmult_assoc.
+apply Rmult_le_compat_l.
+left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+apply Rmult_le_reg_l with (INR (S N)).
+apply lt_INR_0; apply lt_O_Sn.
+rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym.
+rewrite Rmult_1_r; rewrite Rmult_1_l.
+apply le_INR; apply le_n_Sn.
+apply not_O_INR; discriminate.
+apply not_O_INR.
+red in |- *; intro; rewrite H1 in H; elim (lt_irrefl _ H).
+apply not_O_INR.
+red in |- *; intro; rewrite H1 in H; elim (lt_irrefl _ H).
+apply INR_fact_neq_0.
+apply not_O_INR; discriminate.
+apply prod_neq_R0.
+apply not_O_INR.
+red in |- *; intro; rewrite H1 in H; elim (lt_irrefl _ H).
+apply INR_fact_neq_0.
+symmetry in |- *; apply S_pred with 0%nat; assumption.
+right.
+unfold Majxy in |- *.
+unfold C in |- *.
+replace (S (pred N)) with N.
+reflexivity.
+apply S_pred with 0%nat; assumption.
Qed.
-Lemma reste2_maj : (x,y:R;N:nat) (lt O N) -> ``(Rabsolu (Reste2 x y N))<=(Majxy x y N)``.
-Intros.
-Pose C := (Rmax R1 (Rmax (Rabsolu x) (Rabsolu y))).
-Unfold Reste2.
-Apply Rle_trans with (sum_f_R0
- [k:nat]
- (Rabsolu (sum_f_R0
- [l:nat]
- ``(pow ( -1) (S (plus l k)))/
- (INR (fact (plus (mult (S (S O)) (S (plus l k))) (S O))))*
- (pow x (plus (mult (S (S O)) (S (plus l k))) (S O)))*
- (pow ( -1) (minus N l))/
- (INR (fact (plus (mult (S (S O)) (minus N l)) (S O))))*
- (pow y (plus (mult (S (S O)) (minus N l)) (S O)))`` (pred (minus N k))))
- (pred N)).
-Apply (sum_Rabsolu [k:nat]
- (sum_f_R0
- [l:nat]
- ``(pow ( -1) (S (plus l k)))/
- (INR (fact (plus (mult (S (S O)) (S (plus l k))) (S O))))*
- (pow x (plus (mult (S (S O)) (S (plus l k))) (S O)))*
- (pow ( -1) (minus N l))/
- (INR (fact (plus (mult (S (S O)) (minus N l)) (S O))))*
- (pow y (plus (mult (S (S O)) (minus N l)) (S O)))`` (pred (minus N k))) (pred N)).
-Apply Rle_trans with (sum_f_R0
- [k:nat]
- (sum_f_R0
- [l:nat]
- (Rabsolu (``(pow ( -1) (S (plus l k)))/
- (INR (fact (plus (mult (S (S O)) (S (plus l k))) (S O))))*
- (pow x (plus (mult (S (S O)) (S (plus l k))) (S O)))*
- (pow ( -1) (minus N l))/
- (INR (fact (plus (mult (S (S O)) (minus N l)) (S O))))*
- (pow y (plus (mult (S (S O)) (minus N l)) (S O)))``)) (pred (minus N k)))
- (pred N)).
-Apply sum_Rle.
-Intros.
-Apply (sum_Rabsolu [l:nat]
- ``(pow ( -1) (S (plus l n)))/
- (INR (fact (plus (mult (S (S O)) (S (plus l n))) (S O))))*
- (pow x (plus (mult (S (S O)) (S (plus l n))) (S O)))*
- (pow ( -1) (minus N l))/
- (INR (fact (plus (mult (S (S O)) (minus N l)) (S O))))*
- (pow y (plus (mult (S (S O)) (minus N l)) (S O)))`` (pred (minus N n))).
-Apply Rle_trans with (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``/(INR (mult (fact (plus (mult (S (S O)) (S (plus l k))) (S O))) (fact (plus (mult (S (S O)) (minus N l)) (S O)))))*(pow C (mult (S (S O)) (S (S (plus N k)))))`` (pred (minus N k))) (pred N)).
-Apply sum_Rle; Intros.
-Apply sum_Rle; Intros.
-Unfold Rdiv; Repeat Rewrite Rabsolu_mult.
-Do 2 Rewrite pow_1_abs.
-Do 2 Rewrite Rmult_1l.
-Rewrite (Rabsolu_right ``/(INR (fact (plus (mult (S (S O)) (S (plus n0 n))) (S O))))``).
-Rewrite (Rabsolu_right ``/(INR (fact (plus (mult (S (S O)) (minus N n0)) (S O))))``).
-Rewrite mult_INR.
-Rewrite Rinv_Rmult.
-Repeat Rewrite Rmult_assoc.
-Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Rewrite <- Rmult_assoc.
-Rewrite <- (Rmult_sym ``/(INR (fact (plus (mult (S (S O)) (minus N n0)) (S O))))``).
-Rewrite Rmult_assoc.
-Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Do 2 Rewrite <- Pow_Rabsolu.
-Apply Rle_trans with ``(pow (Rabsolu x) (plus (mult (S (S O)) (S (plus n0 n))) (S O)))*(pow C (plus (mult (S (S O)) (minus N n0)) (S O)))``.
-Apply Rle_monotony.
-Apply pow_le; Apply Rabsolu_pos.
-Apply pow_incr.
-Split.
-Apply Rabsolu_pos.
-Unfold C.
-Apply Rle_trans with (Rmax (Rabsolu x) (Rabsolu y)); Apply RmaxLess2.
-Apply Rle_trans with ``(pow C (plus (mult (S (S O)) (S (plus n0 n))) (S O)))*(pow C (plus (mult (S (S O)) (minus N n0)) (S O)))``.
-Do 2 Rewrite <- (Rmult_sym ``(pow C (plus (mult (S (S O)) (minus N n0)) (S O)))``).
-Apply Rle_monotony.
-Apply pow_le.
-Apply Rle_trans with R1.
-Left; Apply Rlt_R0_R1.
-Unfold C; Apply RmaxLess1.
-Apply pow_incr.
-Split.
-Apply Rabsolu_pos.
-Unfold C; Apply Rle_trans with (Rmax (Rabsolu x) (Rabsolu y)).
-Apply RmaxLess1.
-Apply RmaxLess2.
-Right.
-Replace (mult (2) (S (S (plus N n)))) with (plus (plus (mult (2) (minus N n0)) (S O)) (plus (mult (2) (S (plus n0 n))) (S O))).
-Repeat Rewrite pow_add.
-Ring.
-Apply INR_eq; Repeat Rewrite plus_INR; Do 3 Rewrite mult_INR.
-Rewrite minus_INR.
-Repeat Rewrite S_INR; Do 2 Rewrite plus_INR; Ring.
-Apply le_trans with (pred (minus N n)).
-Exact H1.
-Apply le_S_n.
-Replace (S (pred (minus N n))) with (minus N n).
-Apply le_trans with N.
-Apply simpl_le_plus_l with n.
-Rewrite <- le_plus_minus.
-Apply le_plus_r.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply le_n_Sn.
-Apply S_pred with O.
-Apply simpl_lt_plus_l with n.
-Rewrite <- le_plus_minus.
-Replace (plus n O) with n; [Idtac | Ring].
-Apply le_lt_trans with (pred N).
-Assumption.
-Apply lt_pred_n_n; Assumption.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply Rle_sym1; Left; Apply Rlt_Rinv.
-Apply INR_fact_lt_0.
-Apply Rle_sym1; Left; Apply Rlt_Rinv.
-Apply INR_fact_lt_0.
-Apply Rle_trans with (sum_f_R0
- [k:nat]
- (sum_f_R0
- [l:nat]
- ``/(INR
- (mult (fact (plus (mult (S (S O)) (S (plus l k))) (S O)))
- (fact (plus (mult (S (S O)) (minus N l)) (S O)))))*
- (pow C (mult (S (S (S (S O)))) (S N)))`` (pred (minus N k)))
- (pred N)).
-Apply sum_Rle; Intros.
-Apply sum_Rle; Intros.
-Apply Rle_monotony.
-Left; Apply Rlt_Rinv.
-Rewrite mult_INR; Apply Rmult_lt_pos; Apply INR_fact_lt_0.
-Apply Rle_pow.
-Unfold C; Apply RmaxLess1.
-Replace (mult (4) (S N)) with (mult (2) (mult (2) (S N))); [Idtac | Ring].
-Apply mult_le.
-Replace (mult (2) (S N)) with (S (S (plus N N))).
-Repeat Apply le_n_S.
-Apply le_reg_l.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply INR_eq; Do 2Rewrite S_INR; Rewrite plus_INR; Rewrite mult_INR.
-Repeat Rewrite S_INR; Ring.
-Apply Rle_trans with (sum_f_R0
- [k:nat]
- (sum_f_R0
- [l:nat]
- ``(pow C (mult (S (S (S (S O)))) (S N)))*(Rsqr (/(INR (fact (S (S (plus N k)))))))`` (pred (minus N k)))
- (pred N)).
-Apply sum_Rle; Intros.
-Apply sum_Rle; Intros.
-Rewrite <- (Rmult_sym ``(pow C (mult (S (S (S (S O)))) (S N)))``).
-Apply Rle_monotony.
-Apply pow_le.
-Left; Apply Rlt_le_trans with R1.
-Apply Rlt_R0_R1.
-Unfold C; Apply RmaxLess1.
-Replace ``/(INR
- (mult (fact (plus (mult (S (S O)) (S (plus n0 n))) (S O)))
- (fact (plus (mult (S (S O)) (minus N n0)) (S O)))))`` with ``(Binomial.C (mult (S (S O)) (S (S (plus N n)))) (plus (mult (S (S O)) (S (plus n0 n))) (S O)))/(INR (fact (mult (S (S O)) (S (S (plus N n))))))``.
-Apply Rle_trans with ``(Binomial.C (mult (S (S O)) (S (S (plus N n)))) (S (S (plus N n))))/(INR (fact (mult (S (S O)) (S (S (plus N n))))))``.
-Unfold Rdiv; Do 2 Rewrite <- (Rmult_sym ``/(INR (fact (mult (S (S O)) (S (S (plus N n))))))``).
-Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Apply C_maj.
-Apply le_trans with (mult (2) (S (S (plus n0 n)))).
-Replace (mult (2) (S (S (plus n0 n)))) with (S (plus (mult (2) (S (plus n0 n))) (1))).
-Apply le_n_Sn.
-Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Rewrite plus_INR; Ring.
-Apply mult_le.
-Repeat Apply le_n_S.
-Apply le_reg_r.
-Apply le_trans with (pred (minus N n)).
-Assumption.
-Apply le_S_n.
-Replace (S (pred (minus N n))) with (minus N n).
-Apply le_trans with N.
-Apply simpl_le_plus_l with n.
-Rewrite <- le_plus_minus.
-Apply le_plus_r.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply le_n_Sn.
-Apply S_pred with O.
-Apply simpl_lt_plus_l with n.
-Rewrite <- le_plus_minus.
-Replace (plus n O) with n; [Idtac | Ring].
-Apply le_lt_trans with (pred N).
-Assumption.
-Apply lt_pred_n_n; Assumption.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Right.
-Unfold Rdiv; Rewrite Rmult_sym.
-Unfold Binomial.C.
-Unfold Rdiv; Repeat Rewrite <- Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l.
-Replace (minus (mult (2) (S (S (plus N n)))) (S (S (plus N n)))) with (S (S (plus N n))).
-Rewrite Rinv_Rmult.
-Unfold Rsqr; Reflexivity.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply INR_eq; Do 2 Rewrite S_INR; Rewrite minus_INR.
-Rewrite mult_INR; Repeat Rewrite S_INR; Rewrite plus_INR; Ring.
-Apply le_n_2n.
-Apply INR_fact_neq_0.
-Unfold Rdiv; Rewrite Rmult_sym.
-Unfold Binomial.C.
-Unfold Rdiv; Repeat Rewrite <- Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l.
-Replace (minus (mult (2) (S (S (plus N n)))) (plus (mult (2) (S (plus n0 n))) (S O))) with (plus (mult (2) (minus N n0)) (S O)).
-Rewrite mult_INR.
-Reflexivity.
-Apply INR_eq; Rewrite minus_INR.
-Do 2 Rewrite plus_INR; Do 3 Rewrite mult_INR; Repeat Rewrite S_INR; Do 2 Rewrite plus_INR; Rewrite minus_INR.
-Ring.
-Apply le_trans with (pred (minus N n)).
-Assumption.
-Apply le_S_n.
-Replace (S (pred (minus N n))) with (minus N n).
-Apply le_trans with N.
-Apply simpl_le_plus_l with n.
-Rewrite <- le_plus_minus.
-Apply le_plus_r.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply le_n_Sn.
-Apply S_pred with O.
-Apply simpl_lt_plus_l with n.
-Rewrite <- le_plus_minus.
-Replace (plus n O) with n; [Idtac | Ring].
-Apply le_lt_trans with (pred N).
-Assumption.
-Apply lt_pred_n_n; Assumption.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply le_trans with (mult (2) (S (S (plus n0 n)))).
-Replace (mult (2) (S (S (plus n0 n)))) with (S (plus (mult (2) (S (plus n0 n))) (1))).
-Apply le_n_Sn.
-Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Rewrite plus_INR; Ring.
-Apply mult_le.
-Repeat Apply le_n_S.
-Apply le_reg_r.
-Apply le_trans with (pred (minus N n)).
-Assumption.
-Apply le_S_n.
-Replace (S (pred (minus N n))) with (minus N n).
-Apply le_trans with N.
-Apply simpl_le_plus_l with n.
-Rewrite <- le_plus_minus.
-Apply le_plus_r.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply le_n_Sn.
-Apply S_pred with O.
-Apply simpl_lt_plus_l with n.
-Rewrite <- le_plus_minus.
-Replace (plus n O) with n; [Idtac | Ring].
-Apply le_lt_trans with (pred N).
-Assumption.
-Apply lt_pred_n_n; Assumption.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply INR_fact_neq_0.
-Apply Rle_trans with (sum_f_R0 [k:nat]``(INR N)/(INR (fact (S (S N))))*(pow C (mult (S (S (S (S O)))) (S N)))`` (pred N)).
-Apply sum_Rle; Intros.
-Rewrite <- (scal_sum [_:nat]``(pow C (mult (S (S (S (S O)))) (S N)))`` (pred (minus N n)) ``(Rsqr (/(INR (fact (S (S (plus N n)))))))``).
-Rewrite sum_cte.
-Rewrite <- Rmult_assoc.
-Do 2 Rewrite <- (Rmult_sym ``(pow C (mult (S (S (S (S O)))) (S N)))``).
-Rewrite Rmult_assoc.
-Apply Rle_monotony.
-Apply pow_le.
-Left; Apply Rlt_le_trans with R1.
-Apply Rlt_R0_R1.
-Unfold C; Apply RmaxLess1.
-Apply Rle_trans with ``(Rsqr (/(INR (fact (S (S (plus N n)))))))*(INR N)``.
-Apply Rle_monotony.
-Apply pos_Rsqr.
-Replace (S (pred (minus N n))) with (minus N n).
-Apply le_INR.
-Apply simpl_le_plus_l with n.
-Rewrite <- le_plus_minus.
-Apply le_plus_r.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply S_pred with O.
-Apply simpl_lt_plus_l with n.
-Rewrite <- le_plus_minus.
-Replace (plus n O) with n; [Idtac | Ring].
-Apply le_lt_trans with (pred N).
-Assumption.
-Apply lt_pred_n_n; Assumption.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Rewrite Rmult_sym; Unfold Rdiv; Apply Rle_monotony.
-Apply pos_INR.
-Apply Rle_trans with ``/(INR (fact (S (S (plus N n)))))``.
-Pattern 2 ``/(INR (fact (S (S (plus N n)))))``; Rewrite <- Rmult_1r.
-Unfold Rsqr.
-Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Apply Rle_monotony_contra with ``(INR (fact (S (S (plus N n)))))``.
-Apply INR_fact_lt_0.
-Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r.
-Replace R1 with (INR (S O)).
-Apply le_INR.
-Apply lt_le_S.
-Apply INR_lt; Apply INR_fact_lt_0.
-Reflexivity.
-Apply INR_fact_neq_0.
-Apply Rle_monotony_contra with ``(INR (fact (S (S (plus N n)))))``.
-Apply INR_fact_lt_0.
-Rewrite <- Rinv_r_sym.
-Apply Rle_monotony_contra with ``(INR (fact (S (S N))))``.
-Apply INR_fact_lt_0.
-Rewrite Rmult_1r.
-Rewrite (Rmult_sym (INR (fact (S (S N))))).
-Rewrite Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Apply le_INR.
-Apply fact_growing.
-Repeat Apply le_n_S.
-Apply le_plus_l.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Rewrite sum_cte.
-Apply Rle_trans with ``(pow C (mult (S (S (S (S O)))) (S N)))/(INR (fact N))``.
-Rewrite <- (Rmult_sym ``(pow C (mult (S (S (S (S O)))) (S N)))``).
-Unfold Rdiv; Rewrite Rmult_assoc; Apply Rle_monotony.
-Apply pow_le.
-Left; Apply Rlt_le_trans with R1.
-Apply Rlt_R0_R1.
-Unfold C; Apply RmaxLess1.
-Cut (S (pred N)) = N.
-Intro; Rewrite H0.
-Do 2 Rewrite fact_simpl.
-Repeat Rewrite mult_INR.
-Repeat Rewrite Rinv_Rmult.
-Apply Rle_trans with ``(INR (S (S N)))*(/(INR (S (S N)))*(/(INR (S N))*/(INR (fact N))))*
- (INR N)``.
-Repeat Rewrite Rmult_assoc.
-Rewrite (Rmult_sym (INR N)).
-Rewrite (Rmult_sym (INR (S (S N)))).
-Apply Rle_monotony.
-Repeat Apply Rmult_le_pos.
-Left; Apply Rlt_Rinv; Apply lt_INR_0; Apply lt_O_Sn.
-Left; Apply Rlt_Rinv; Apply lt_INR_0; Apply lt_O_Sn.
-Left; Apply Rlt_Rinv.
-Apply INR_fact_lt_0.
-Apply pos_INR.
-Apply le_INR.
-Apply le_trans with (S N); Apply le_n_Sn.
-Repeat Rewrite <- Rmult_assoc.
-Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1l.
-Apply Rle_trans with ``/(INR (S N))*/(INR (fact N))*(INR (S N))``.
-Repeat Rewrite Rmult_assoc.
-Repeat Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Apply lt_INR_0; Apply lt_O_Sn.
-Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Apply le_INR; Apply le_n_Sn.
-Rewrite (Rmult_sym ``/(INR (S N))``).
-Rewrite Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Right; Reflexivity.
-Apply not_O_INR; Discriminate.
-Apply not_O_INR; Discriminate.
-Apply not_O_INR; Discriminate.
-Apply INR_fact_neq_0.
-Apply not_O_INR; Discriminate.
-Apply prod_neq_R0; [Apply not_O_INR; Discriminate | Apply INR_fact_neq_0].
-Symmetry; Apply S_pred with O; Assumption.
-Right.
-Unfold Majxy.
-Unfold C.
-Reflexivity.
+Lemma reste2_maj :
+ forall (x y:R) (N:nat), (0 < N)%nat -> Rabs (Reste2 x y N) <= Majxy x y N.
+intros.
+pose (C := Rmax 1 (Rmax (Rabs x) (Rabs y))).
+unfold Reste2 in |- *.
+apply Rle_trans with
+ (sum_f_R0
+ (fun k:nat =>
+ Rabs
+ (sum_f_R0
+ (fun l:nat =>
+ (-1) ^ S (l + k) / INR (fact (2 * S (l + k) + 1)) *
+ x ^ (2 * S (l + k) + 1) *
+ ((-1) ^ (N - l) / INR (fact (2 * (N - l) + 1))) *
+ y ^ (2 * (N - l) + 1)) (pred (N - k)))) (
+ pred N)).
+apply
+ (Rsum_abs
+ (fun k:nat =>
+ sum_f_R0
+ (fun l:nat =>
+ (-1) ^ S (l + k) / INR (fact (2 * S (l + k) + 1)) *
+ x ^ (2 * S (l + k) + 1) *
+ ((-1) ^ (N - l) / INR (fact (2 * (N - l) + 1))) *
+ y ^ (2 * (N - l) + 1)) (pred (N - k))) (
+ pred N)).
+apply Rle_trans with
+ (sum_f_R0
+ (fun k:nat =>
+ sum_f_R0
+ (fun l:nat =>
+ Rabs
+ ((-1) ^ S (l + k) / INR (fact (2 * S (l + k) + 1)) *
+ x ^ (2 * S (l + k) + 1) *
+ ((-1) ^ (N - l) / INR (fact (2 * (N - l) + 1))) *
+ y ^ (2 * (N - l) + 1))) (pred (N - k))) (
+ pred N)).
+apply sum_Rle.
+intros.
+apply
+ (Rsum_abs
+ (fun l:nat =>
+ (-1) ^ S (l + n) / INR (fact (2 * S (l + n) + 1)) *
+ x ^ (2 * S (l + n) + 1) *
+ ((-1) ^ (N - l) / INR (fact (2 * (N - l) + 1))) *
+ y ^ (2 * (N - l) + 1)) (pred (N - n))).
+apply Rle_trans with
+ (sum_f_R0
+ (fun k:nat =>
+ sum_f_R0
+ (fun l:nat =>
+ / INR (fact (2 * S (l + k) + 1) * fact (2 * (N - l) + 1)) *
+ C ^ (2 * S (S (N + k)))) (pred (N - k))) (
+ pred N)).
+apply sum_Rle; intros.
+apply sum_Rle; intros.
+unfold Rdiv in |- *; repeat rewrite Rabs_mult.
+do 2 rewrite pow_1_abs.
+do 2 rewrite Rmult_1_l.
+rewrite (Rabs_right (/ INR (fact (2 * S (n0 + n) + 1)))).
+rewrite (Rabs_right (/ INR (fact (2 * (N - n0) + 1)))).
+rewrite mult_INR.
+rewrite Rinv_mult_distr.
+repeat rewrite Rmult_assoc.
+apply Rmult_le_compat_l.
+left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+rewrite <- Rmult_assoc.
+rewrite <- (Rmult_comm (/ INR (fact (2 * (N - n0) + 1)))).
+rewrite Rmult_assoc.
+apply Rmult_le_compat_l.
+left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+do 2 rewrite <- RPow_abs.
+apply Rle_trans with (Rabs x ^ (2 * S (n0 + n) + 1) * C ^ (2 * (N - n0) + 1)).
+apply Rmult_le_compat_l.
+apply pow_le; apply Rabs_pos.
+apply pow_incr.
+split.
+apply Rabs_pos.
+unfold C in |- *.
+apply Rle_trans with (Rmax (Rabs x) (Rabs y)); apply RmaxLess2.
+apply Rle_trans with (C ^ (2 * S (n0 + n) + 1) * C ^ (2 * (N - n0) + 1)).
+do 2 rewrite <- (Rmult_comm (C ^ (2 * (N - n0) + 1))).
+apply Rmult_le_compat_l.
+apply pow_le.
+apply Rle_trans with 1.
+left; apply Rlt_0_1.
+unfold C in |- *; apply RmaxLess1.
+apply pow_incr.
+split.
+apply Rabs_pos.
+unfold C in |- *; apply Rle_trans with (Rmax (Rabs x) (Rabs y)).
+apply RmaxLess1.
+apply RmaxLess2.
+right.
+replace (2 * S (S (N + n)))%nat with
+ (2 * (N - n0) + 1 + (2 * S (n0 + n) + 1))%nat.
+repeat rewrite pow_add.
+ring.
+apply INR_eq; repeat rewrite plus_INR; do 3 rewrite mult_INR.
+rewrite minus_INR.
+repeat rewrite S_INR; do 2 rewrite plus_INR; ring.
+apply le_trans with (pred (N - n)).
+exact H1.
+apply le_S_n.
+replace (S (pred (N - n))) with (N - n)%nat.
+apply le_trans with N.
+apply (fun p n m:nat => plus_le_reg_l n m p) with n.
+rewrite <- le_plus_minus.
+apply le_plus_r.
+apply le_trans with (pred N).
+assumption.
+apply le_pred_n.
+apply le_n_Sn.
+apply S_pred with 0%nat.
+apply plus_lt_reg_l with n.
+rewrite <- le_plus_minus.
+replace (n + 0)%nat with n; [ idtac | ring ].
+apply le_lt_trans with (pred N).
+assumption.
+apply lt_pred_n_n; assumption.
+apply le_trans with (pred N).
+assumption.
+apply le_pred_n.
+apply INR_fact_neq_0.
+apply INR_fact_neq_0.
+apply Rle_ge; left; apply Rinv_0_lt_compat.
+apply INR_fact_lt_0.
+apply Rle_ge; left; apply Rinv_0_lt_compat.
+apply INR_fact_lt_0.
+apply Rle_trans with
+ (sum_f_R0
+ (fun k:nat =>
+ sum_f_R0
+ (fun l:nat =>
+ / INR (fact (2 * S (l + k) + 1) * fact (2 * (N - l) + 1)) *
+ C ^ (4 * S N)) (pred (N - k))) (pred N)).
+apply sum_Rle; intros.
+apply sum_Rle; intros.
+apply Rmult_le_compat_l.
+left; apply Rinv_0_lt_compat.
+rewrite mult_INR; apply Rmult_lt_0_compat; apply INR_fact_lt_0.
+apply Rle_pow.
+unfold C in |- *; apply RmaxLess1.
+replace (4 * S N)%nat with (2 * (2 * S N))%nat; [ idtac | ring ].
+apply (fun m n p:nat => mult_le_compat_l p n m).
+replace (2 * S N)%nat with (S (S (N + N))).
+repeat apply le_n_S.
+apply plus_le_compat_l.
+apply le_trans with (pred N).
+assumption.
+apply le_pred_n.
+apply INR_eq; do 2 rewrite S_INR; rewrite plus_INR; rewrite mult_INR.
+repeat rewrite S_INR; ring.
+apply Rle_trans with
+ (sum_f_R0
+ (fun k:nat =>
+ sum_f_R0
+ (fun l:nat => C ^ (4 * S N) * Rsqr (/ INR (fact (S (S (N + k))))))
+ (pred (N - k))) (pred N)).
+apply sum_Rle; intros.
+apply sum_Rle; intros.
+rewrite <- (Rmult_comm (C ^ (4 * S N))).
+apply Rmult_le_compat_l.
+apply pow_le.
+left; apply Rlt_le_trans with 1.
+apply Rlt_0_1.
+unfold C in |- *; apply RmaxLess1.
+replace (/ INR (fact (2 * S (n0 + n) + 1) * fact (2 * (N - n0) + 1))) with
+ (Binomial.C (2 * S (S (N + n))) (2 * S (n0 + n) + 1) /
+ INR (fact (2 * S (S (N + n))))).
+apply Rle_trans with
+ (Binomial.C (2 * S (S (N + n))) (S (S (N + n))) /
+ INR (fact (2 * S (S (N + n))))).
+unfold Rdiv in |- *;
+ do 2 rewrite <- (Rmult_comm (/ INR (fact (2 * S (S (N + n)))))).
+apply Rmult_le_compat_l.
+left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+apply C_maj.
+apply le_trans with (2 * S (S (n0 + n)))%nat.
+replace (2 * S (S (n0 + n)))%nat with (S (2 * S (n0 + n) + 1)).
+apply le_n_Sn.
+apply INR_eq; rewrite S_INR; rewrite plus_INR; do 2 rewrite mult_INR;
+ repeat rewrite S_INR; rewrite plus_INR; ring.
+apply (fun m n p:nat => mult_le_compat_l p n m).
+repeat apply le_n_S.
+apply plus_le_compat_r.
+apply le_trans with (pred (N - n)).
+assumption.
+apply le_S_n.
+replace (S (pred (N - n))) with (N - n)%nat.
+apply le_trans with N.
+apply (fun p n m:nat => plus_le_reg_l n m p) with n.
+rewrite <- le_plus_minus.
+apply le_plus_r.
+apply le_trans with (pred N).
+assumption.
+apply le_pred_n.
+apply le_n_Sn.
+apply S_pred with 0%nat.
+apply plus_lt_reg_l with n.
+rewrite <- le_plus_minus.
+replace (n + 0)%nat with n; [ idtac | ring ].
+apply le_lt_trans with (pred N).
+assumption.
+apply lt_pred_n_n; assumption.
+apply le_trans with (pred N).
+assumption.
+apply le_pred_n.
+right.
+unfold Rdiv in |- *; rewrite Rmult_comm.
+unfold Binomial.C in |- *.
+unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc.
+rewrite <- Rinv_l_sym.
+rewrite Rmult_1_l.
+replace (2 * S (S (N + n)) - S (S (N + n)))%nat with (S (S (N + n))).
+rewrite Rinv_mult_distr.
+unfold Rsqr in |- *; reflexivity.
+apply INR_fact_neq_0.
+apply INR_fact_neq_0.
+apply INR_eq; do 2 rewrite S_INR; rewrite minus_INR.
+rewrite mult_INR; repeat rewrite S_INR; rewrite plus_INR; ring.
+apply le_n_2n.
+apply INR_fact_neq_0.
+unfold Rdiv in |- *; rewrite Rmult_comm.
+unfold Binomial.C in |- *.
+unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc.
+rewrite <- Rinv_l_sym.
+rewrite Rmult_1_l.
+replace (2 * S (S (N + n)) - (2 * S (n0 + n) + 1))%nat with
+ (2 * (N - n0) + 1)%nat.
+rewrite mult_INR.
+reflexivity.
+apply INR_eq; rewrite minus_INR.
+do 2 rewrite plus_INR; do 3 rewrite mult_INR; repeat rewrite S_INR;
+ do 2 rewrite plus_INR; rewrite minus_INR.
+ring.
+apply le_trans with (pred (N - n)).
+assumption.
+apply le_S_n.
+replace (S (pred (N - n))) with (N - n)%nat.
+apply le_trans with N.
+apply (fun p n m:nat => plus_le_reg_l n m p) with n.
+rewrite <- le_plus_minus.
+apply le_plus_r.
+apply le_trans with (pred N).
+assumption.
+apply le_pred_n.
+apply le_n_Sn.
+apply S_pred with 0%nat.
+apply plus_lt_reg_l with n.
+rewrite <- le_plus_minus.
+replace (n + 0)%nat with n; [ idtac | ring ].
+apply le_lt_trans with (pred N).
+assumption.
+apply lt_pred_n_n; assumption.
+apply le_trans with (pred N).
+assumption.
+apply le_pred_n.
+apply le_trans with (2 * S (S (n0 + n)))%nat.
+replace (2 * S (S (n0 + n)))%nat with (S (2 * S (n0 + n) + 1)).
+apply le_n_Sn.
+apply INR_eq; rewrite S_INR; rewrite plus_INR; do 2 rewrite mult_INR;
+ repeat rewrite S_INR; rewrite plus_INR; ring.
+apply (fun m n p:nat => mult_le_compat_l p n m).
+repeat apply le_n_S.
+apply plus_le_compat_r.
+apply le_trans with (pred (N - n)).
+assumption.
+apply le_S_n.
+replace (S (pred (N - n))) with (N - n)%nat.
+apply le_trans with N.
+apply (fun p n m:nat => plus_le_reg_l n m p) with n.
+rewrite <- le_plus_minus.
+apply le_plus_r.
+apply le_trans with (pred N).
+assumption.
+apply le_pred_n.
+apply le_n_Sn.
+apply S_pred with 0%nat.
+apply plus_lt_reg_l with n.
+rewrite <- le_plus_minus.
+replace (n + 0)%nat with n; [ idtac | ring ].
+apply le_lt_trans with (pred N).
+assumption.
+apply lt_pred_n_n; assumption.
+apply le_trans with (pred N).
+assumption.
+apply le_pred_n.
+apply INR_fact_neq_0.
+apply Rle_trans with
+ (sum_f_R0 (fun k:nat => INR N / INR (fact (S (S N))) * C ^ (4 * S N))
+ (pred N)).
+apply sum_Rle; intros.
+rewrite <-
+ (scal_sum (fun _:nat => C ^ (4 * S N)) (pred (N - n))
+ (Rsqr (/ INR (fact (S (S (N + n))))))).
+rewrite sum_cte.
+rewrite <- Rmult_assoc.
+do 2 rewrite <- (Rmult_comm (C ^ (4 * S N))).
+rewrite Rmult_assoc.
+apply Rmult_le_compat_l.
+apply pow_le.
+left; apply Rlt_le_trans with 1.
+apply Rlt_0_1.
+unfold C in |- *; apply RmaxLess1.
+apply Rle_trans with (Rsqr (/ INR (fact (S (S (N + n))))) * INR N).
+apply Rmult_le_compat_l.
+apply Rle_0_sqr.
+replace (S (pred (N - n))) with (N - n)%nat.
+apply le_INR.
+apply (fun p n m:nat => plus_le_reg_l n m p) with n.
+rewrite <- le_plus_minus.
+apply le_plus_r.
+apply le_trans with (pred N).
+assumption.
+apply le_pred_n.
+apply S_pred with 0%nat.
+apply plus_lt_reg_l with n.
+rewrite <- le_plus_minus.
+replace (n + 0)%nat with n; [ idtac | ring ].
+apply le_lt_trans with (pred N).
+assumption.
+apply lt_pred_n_n; assumption.
+apply le_trans with (pred N).
+assumption.
+apply le_pred_n.
+rewrite Rmult_comm; unfold Rdiv in |- *; apply Rmult_le_compat_l.
+apply pos_INR.
+apply Rle_trans with (/ INR (fact (S (S (N + n))))).
+pattern (/ INR (fact (S (S (N + n))))) at 2 in |- *; rewrite <- Rmult_1_r.
+unfold Rsqr in |- *.
+apply Rmult_le_compat_l.
+left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+apply Rmult_le_reg_l with (INR (fact (S (S (N + n))))).
+apply INR_fact_lt_0.
+rewrite <- Rinv_r_sym.
+rewrite Rmult_1_r.
+replace 1 with (INR 1).
+apply le_INR.
+apply lt_le_S.
+apply INR_lt; apply INR_fact_lt_0.
+reflexivity.
+apply INR_fact_neq_0.
+apply Rmult_le_reg_l with (INR (fact (S (S (N + n))))).
+apply INR_fact_lt_0.
+rewrite <- Rinv_r_sym.
+apply Rmult_le_reg_l with (INR (fact (S (S N)))).
+apply INR_fact_lt_0.
+rewrite Rmult_1_r.
+rewrite (Rmult_comm (INR (fact (S (S N))))).
+rewrite Rmult_assoc.
+rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r.
+apply le_INR.
+apply fact_le.
+repeat apply le_n_S.
+apply le_plus_l.
+apply INR_fact_neq_0.
+apply INR_fact_neq_0.
+rewrite sum_cte.
+apply Rle_trans with (C ^ (4 * S N) / INR (fact N)).
+rewrite <- (Rmult_comm (C ^ (4 * S N))).
+unfold Rdiv in |- *; rewrite Rmult_assoc; apply Rmult_le_compat_l.
+apply pow_le.
+left; apply Rlt_le_trans with 1.
+apply Rlt_0_1.
+unfold C in |- *; apply RmaxLess1.
+cut (S (pred N) = N).
+intro; rewrite H0.
+do 2 rewrite fact_simpl.
+repeat rewrite mult_INR.
+repeat rewrite Rinv_mult_distr.
+apply Rle_trans with
+ (INR (S (S N)) * (/ INR (S (S N)) * (/ INR (S N) * / INR (fact N))) * INR N).
+repeat rewrite Rmult_assoc.
+rewrite (Rmult_comm (INR N)).
+rewrite (Rmult_comm (INR (S (S N)))).
+apply Rmult_le_compat_l.
+repeat apply Rmult_le_pos.
+left; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn.
+left; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn.
+left; apply Rinv_0_lt_compat.
+apply INR_fact_lt_0.
+apply pos_INR.
+apply le_INR.
+apply le_trans with (S N); apply le_n_Sn.
+repeat rewrite <- Rmult_assoc.
+rewrite <- Rinv_r_sym.
+rewrite Rmult_1_l.
+apply Rle_trans with (/ INR (S N) * / INR (fact N) * INR (S N)).
+repeat rewrite Rmult_assoc.
+repeat apply Rmult_le_compat_l.
+left; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn.
+left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+apply le_INR; apply le_n_Sn.
+rewrite (Rmult_comm (/ INR (S N))).
+rewrite Rmult_assoc.
+rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r; right; reflexivity.
+apply not_O_INR; discriminate.
+apply not_O_INR; discriminate.
+apply not_O_INR; discriminate.
+apply INR_fact_neq_0.
+apply not_O_INR; discriminate.
+apply prod_neq_R0; [ apply not_O_INR; discriminate | apply INR_fact_neq_0 ].
+symmetry in |- *; apply S_pred with 0%nat; assumption.
+right.
+unfold Majxy in |- *.
+unfold C in |- *.
+reflexivity.
Qed.
-Lemma reste1_cv_R0 : (x,y:R) (Un_cv (Reste1 x y) R0).
-Intros.
-Assert H := (Majxy_cv_R0 x y).
-Unfold Un_cv in H; Unfold R_dist in H.
-Unfold Un_cv; Unfold R_dist; Intros.
-Elim (H eps H0); Intros N0 H1.
-Exists (S N0); Intros.
-Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or.
-Apply Rle_lt_trans with (Rabsolu (Majxy x y (pred n))).
-Rewrite (Rabsolu_right (Majxy x y (pred n))).
-Apply reste1_maj.
-Apply lt_le_trans with (S N0).
-Apply lt_O_Sn.
-Assumption.
-Apply Rle_sym1.
-Unfold Majxy.
-Unfold Rdiv; Apply Rmult_le_pos.
-Apply pow_le.
-Apply Rle_trans with R1.
-Left; Apply Rlt_R0_R1.
-Apply RmaxLess1.
-Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Replace (Majxy x y (pred n)) with ``(Majxy x y (pred n))-0``; [Idtac | Ring].
-Apply H1.
-Unfold ge; Apply le_S_n.
-Replace (S (pred n)) with n.
-Assumption.
-Apply S_pred with O.
-Apply lt_le_trans with (S N0); [Apply lt_O_Sn | Assumption].
+Lemma reste1_cv_R0 : forall x y:R, Un_cv (Reste1 x y) 0.
+intros.
+assert (H := Majxy_cv_R0 x y).
+unfold Un_cv in H; unfold R_dist in H.
+unfold Un_cv in |- *; unfold R_dist in |- *; intros.
+elim (H eps H0); intros N0 H1.
+exists (S N0); intros.
+unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r.
+apply Rle_lt_trans with (Rabs (Majxy x y (pred n))).
+rewrite (Rabs_right (Majxy x y (pred n))).
+apply reste1_maj.
+apply lt_le_trans with (S N0).
+apply lt_O_Sn.
+assumption.
+apply Rle_ge.
+unfold Majxy in |- *.
+unfold Rdiv in |- *; apply Rmult_le_pos.
+apply pow_le.
+apply Rle_trans with 1.
+left; apply Rlt_0_1.
+apply RmaxLess1.
+left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+replace (Majxy x y (pred n)) with (Majxy x y (pred n) - 0); [ idtac | ring ].
+apply H1.
+unfold ge in |- *; apply le_S_n.
+replace (S (pred n)) with n.
+assumption.
+apply S_pred with 0%nat.
+apply lt_le_trans with (S N0); [ apply lt_O_Sn | assumption ].
Qed.
-Lemma reste2_cv_R0 : (x,y:R) (Un_cv (Reste2 x y) R0).
-Intros.
-Assert H := (Majxy_cv_R0 x y).
-Unfold Un_cv in H; Unfold R_dist in H.
-Unfold Un_cv; Unfold R_dist; Intros.
-Elim (H eps H0); Intros N0 H1.
-Exists (S N0); Intros.
-Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or.
-Apply Rle_lt_trans with (Rabsolu (Majxy x y n)).
-Rewrite (Rabsolu_right (Majxy x y n)).
-Apply reste2_maj.
-Apply lt_le_trans with (S N0).
-Apply lt_O_Sn.
-Assumption.
-Apply Rle_sym1.
-Unfold Majxy.
-Unfold Rdiv; Apply Rmult_le_pos.
-Apply pow_le.
-Apply Rle_trans with R1.
-Left; Apply Rlt_R0_R1.
-Apply RmaxLess1.
-Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Replace (Majxy x y n) with ``(Majxy x y n)-0``; [Idtac | Ring].
-Apply H1.
-Unfold ge; Apply le_trans with (S N0).
-Apply le_n_Sn.
-Exact H2.
+Lemma reste2_cv_R0 : forall x y:R, Un_cv (Reste2 x y) 0.
+intros.
+assert (H := Majxy_cv_R0 x y).
+unfold Un_cv in H; unfold R_dist in H.
+unfold Un_cv in |- *; unfold R_dist in |- *; intros.
+elim (H eps H0); intros N0 H1.
+exists (S N0); intros.
+unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r.
+apply Rle_lt_trans with (Rabs (Majxy x y n)).
+rewrite (Rabs_right (Majxy x y n)).
+apply reste2_maj.
+apply lt_le_trans with (S N0).
+apply lt_O_Sn.
+assumption.
+apply Rle_ge.
+unfold Majxy in |- *.
+unfold Rdiv in |- *; apply Rmult_le_pos.
+apply pow_le.
+apply Rle_trans with 1.
+left; apply Rlt_0_1.
+apply RmaxLess1.
+left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+replace (Majxy x y n) with (Majxy x y n - 0); [ idtac | ring ].
+apply H1.
+unfold ge in |- *; apply le_trans with (S N0).
+apply le_n_Sn.
+exact H2.
Qed.
-Lemma reste_cv_R0 : (x,y:R) (Un_cv (Reste x y) R0).
-Intros.
-Unfold Reste.
-Pose An := [n:nat](Reste2 x y n).
-Pose Bn := [n:nat](Reste1 x y (S n)).
-Cut (Un_cv [n:nat]``(An n)-(Bn n)`` ``0-0``) -> (Un_cv [N:nat]``(Reste2 x y N)-(Reste1 x y (S N))`` ``0``).
-Intro.
-Apply H.
-Apply CV_minus.
-Unfold An.
-Replace [n:nat](Reste2 x y n) with (Reste2 x y).
-Apply reste2_cv_R0.
-Reflexivity.
-Unfold Bn.
-Assert H0 := (reste1_cv_R0 x y).
-Unfold Un_cv in H0; Unfold R_dist in H0.
-Unfold Un_cv; Unfold R_dist; Intros.
-Elim (H0 eps H1); Intros N0 H2.
-Exists N0; Intros.
-Apply H2.
-Unfold ge; Apply le_trans with (S N0).
-Apply le_n_Sn.
-Apply le_n_S; Assumption.
-Unfold An Bn.
-Intro.
-Replace R0 with ``0-0``; [Idtac | Ring].
-Exact H.
+Lemma reste_cv_R0 : forall x y:R, Un_cv (Reste x y) 0.
+intros.
+unfold Reste in |- *.
+pose (An := fun n:nat => Reste2 x y n).
+pose (Bn := fun n:nat => Reste1 x y (S n)).
+cut
+ (Un_cv (fun n:nat => An n - Bn n) (0 - 0) ->
+ Un_cv (fun N:nat => Reste2 x y N - Reste1 x y (S N)) 0).
+intro.
+apply H.
+apply CV_minus.
+unfold An in |- *.
+replace (fun n:nat => Reste2 x y n) with (Reste2 x y).
+apply reste2_cv_R0.
+reflexivity.
+unfold Bn in |- *.
+assert (H0 := reste1_cv_R0 x y).
+unfold Un_cv in H0; unfold R_dist in H0.
+unfold Un_cv in |- *; unfold R_dist in |- *; intros.
+elim (H0 eps H1); intros N0 H2.
+exists N0; intros.
+apply H2.
+unfold ge in |- *; apply le_trans with (S N0).
+apply le_n_Sn.
+apply le_n_S; assumption.
+unfold An, Bn in |- *.
+intro.
+replace 0 with (0 - 0); [ idtac | ring ].
+exact H.
Qed.
-Theorem cos_plus : (x,y:R) ``(cos (x+y))==(cos x)*(cos y)-(sin x)*(sin y)``.
-Intros.
-Cut (Un_cv (C1 x y) ``(cos x)*(cos y)-(sin x)*(sin y)``).
-Cut (Un_cv (C1 x y) ``(cos (x+y))``).
-Intros.
-Apply UL_sequence with (C1 x y); Assumption.
-Apply C1_cvg.
-Unfold Un_cv; Unfold R_dist.
-Intros.
-Assert H0 := (A1_cvg x).
-Assert H1 := (A1_cvg y).
-Assert H2 := (B1_cvg x).
-Assert H3 := (B1_cvg y).
-Assert H4 := (CV_mult ? ? ? ? H0 H1).
-Assert H5 := (CV_mult ? ? ? ? H2 H3).
-Assert H6 := (reste_cv_R0 x y).
-Unfold Un_cv in H4; Unfold Un_cv in H5; Unfold Un_cv in H6.
-Unfold R_dist in H4; Unfold R_dist in H5; Unfold R_dist in H6.
-Cut ``0<eps/3``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]].
-Elim (H4 ``eps/3`` H7); Intros N1 H8.
-Elim (H5 ``eps/3`` H7); Intros N2 H9.
-Elim (H6 ``eps/3`` H7); Intros N3 H10.
-Pose N := (S (S (max (max N1 N2) N3))).
-Exists N.
-Intros.
-Cut n = (S (pred n)).
-Intro; Rewrite H12.
-Rewrite <- cos_plus_form.
-Rewrite <- H12.
-Apply Rle_lt_trans with ``(Rabsolu ((A1 x n)*(A1 y n)-(cos x)*(cos y)))+(Rabsolu ((sin x)*(sin y)-(B1 x (pred n))*(B1 y (pred n))+(Reste x y (pred n))))``.
-Replace ``(A1 x n)*(A1 y n)-(B1 x (pred n))*(B1 y (pred n))+
- (Reste x y (pred n))-((cos x)*(cos y)-(sin x)*(sin y))`` with ``((A1 x n)*(A1 y n)-(cos x)*(cos y))+((sin x)*(sin y)-(B1 x (pred n))*(B1 y (pred n))+(Reste x y (pred n)))``; [Apply Rabsolu_triang | Ring].
-Replace ``eps`` with ``eps/3+(eps/3+eps/3)``.
-Apply Rplus_lt.
-Apply H8.
-Unfold ge; Apply le_trans with N.
-Unfold N.
-Apply le_trans with (max N1 N2).
-Apply le_max_l.
-Apply le_trans with (max (max N1 N2) N3).
-Apply le_max_l.
-Apply le_trans with (S (max (max N1 N2) N3)); Apply le_n_Sn.
-Assumption.
-Apply Rle_lt_trans with ``(Rabsolu ((sin x)*(sin y)-(B1 x (pred n))*(B1 y (pred n))))+(Rabsolu (Reste x y (pred n)))``.
-Apply Rabsolu_triang.
-Apply Rplus_lt.
-Rewrite <- Rabsolu_Ropp.
-Rewrite Ropp_distr2.
-Apply H9.
-Unfold ge; Apply le_trans with (max N1 N2).
-Apply le_max_r.
-Apply le_S_n.
-Rewrite <- H12.
-Apply le_trans with N.
-Unfold N.
-Apply le_n_S.
-Apply le_trans with (max (max N1 N2) N3).
-Apply le_max_l.
-Apply le_n_Sn.
-Assumption.
-Replace (Reste x y (pred n)) with ``(Reste x y (pred n))-0``.
-Apply H10.
-Unfold ge.
-Apply le_S_n.
-Rewrite <- H12.
-Apply le_trans with N.
-Unfold N.
-Apply le_n_S.
-Apply le_trans with (max (max N1 N2) N3).
-Apply le_max_r.
-Apply le_n_Sn.
-Assumption.
-Ring.
-Pattern 4 eps; Replace eps with ``3*eps/3``.
-Ring.
-Unfold Rdiv.
-Rewrite <- Rmult_assoc.
-Apply Rinv_r_simpl_m.
-DiscrR.
-Apply lt_le_trans with (pred N).
-Unfold N; Simpl; Apply lt_O_Sn.
-Apply le_S_n.
-Rewrite <- H12.
-Replace (S (pred N)) with N.
-Assumption.
-Unfold N; Simpl; Reflexivity.
-Cut (lt O N).
-Intro.
-Cut (lt O n).
-Intro.
-Apply S_pred with O; Assumption.
-Apply lt_le_trans with N; Assumption.
-Unfold N; Apply lt_O_Sn.
-Qed.
+Theorem cos_plus : forall x y:R, cos (x + y) = cos x * cos y - sin x * sin y.
+intros.
+cut (Un_cv (C1 x y) (cos x * cos y - sin x * sin y)).
+cut (Un_cv (C1 x y) (cos (x + y))).
+intros.
+apply UL_sequence with (C1 x y); assumption.
+apply C1_cvg.
+unfold Un_cv in |- *; unfold R_dist in |- *.
+intros.
+assert (H0 := A1_cvg x).
+assert (H1 := A1_cvg y).
+assert (H2 := B1_cvg x).
+assert (H3 := B1_cvg y).
+assert (H4 := CV_mult _ _ _ _ H0 H1).
+assert (H5 := CV_mult _ _ _ _ H2 H3).
+assert (H6 := reste_cv_R0 x y).
+unfold Un_cv in H4; unfold Un_cv in H5; unfold Un_cv in H6.
+unfold R_dist in H4; unfold R_dist in H5; unfold R_dist in H6.
+cut (0 < eps / 3);
+ [ intro
+ | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ].
+elim (H4 (eps / 3) H7); intros N1 H8.
+elim (H5 (eps / 3) H7); intros N2 H9.
+elim (H6 (eps / 3) H7); intros N3 H10.
+pose (N := S (S (max (max N1 N2) N3))).
+exists N.
+intros.
+cut (n = S (pred n)).
+intro; rewrite H12.
+rewrite <- cos_plus_form.
+rewrite <- H12.
+apply Rle_lt_trans with
+ (Rabs (A1 x n * A1 y n - cos x * cos y) +
+ Rabs (sin x * sin y - B1 x (pred n) * B1 y (pred n) + Reste x y (pred n))).
+replace
+ (A1 x n * A1 y n - B1 x (pred n) * B1 y (pred n) + Reste x y (pred n) -
+ (cos x * cos y - sin x * sin y)) with
+ (A1 x n * A1 y n - cos x * cos y +
+ (sin x * sin y - B1 x (pred n) * B1 y (pred n) + Reste x y (pred n)));
+ [ apply Rabs_triang | ring ].
+replace eps with (eps / 3 + (eps / 3 + eps / 3)).
+apply Rplus_lt_compat.
+apply H8.
+unfold ge in |- *; apply le_trans with N.
+unfold N in |- *.
+apply le_trans with (max N1 N2).
+apply le_max_l.
+apply le_trans with (max (max N1 N2) N3).
+apply le_max_l.
+apply le_trans with (S (max (max N1 N2) N3)); apply le_n_Sn.
+assumption.
+apply Rle_lt_trans with
+ (Rabs (sin x * sin y - B1 x (pred n) * B1 y (pred n)) +
+ Rabs (Reste x y (pred n))).
+apply Rabs_triang.
+apply Rplus_lt_compat.
+rewrite <- Rabs_Ropp.
+rewrite Ropp_minus_distr.
+apply H9.
+unfold ge in |- *; apply le_trans with (max N1 N2).
+apply le_max_r.
+apply le_S_n.
+rewrite <- H12.
+apply le_trans with N.
+unfold N in |- *.
+apply le_n_S.
+apply le_trans with (max (max N1 N2) N3).
+apply le_max_l.
+apply le_n_Sn.
+assumption.
+replace (Reste x y (pred n)) with (Reste x y (pred n) - 0).
+apply H10.
+unfold ge in |- *.
+apply le_S_n.
+rewrite <- H12.
+apply le_trans with N.
+unfold N in |- *.
+apply le_n_S.
+apply le_trans with (max (max N1 N2) N3).
+apply le_max_r.
+apply le_n_Sn.
+assumption.
+ring.
+pattern eps at 4 in |- *; replace eps with (3 * (eps / 3)).
+ring.
+unfold Rdiv in |- *.
+rewrite <- Rmult_assoc.
+apply Rinv_r_simpl_m.
+discrR.
+apply lt_le_trans with (pred N).
+unfold N in |- *; simpl in |- *; apply lt_O_Sn.
+apply le_S_n.
+rewrite <- H12.
+replace (S (pred N)) with N.
+assumption.
+unfold N in |- *; simpl in |- *; reflexivity.
+cut (0 < N)%nat.
+intro.
+cut (0 < n)%nat.
+intro.
+apply S_pred with 0%nat; assumption.
+apply lt_le_trans with N; assumption.
+unfold N in |- *; apply lt_O_Sn.
+Qed. \ No newline at end of file
diff --git a/theories/Reals/Cos_rel.v b/theories/Reals/Cos_rel.v
index 0bc58169c..5e9d26001 100644
--- a/theories/Reals/Cos_rel.v
+++ b/theories/Reals/Cos_rel.v
@@ -8,353 +8,413 @@
(*i $Id$ i*)
-Require Rbase.
-Require Rfunctions.
-Require SeqSeries.
-Require Rtrigo_def.
-V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
+Require Import Rbase.
+Require Import Rfunctions.
+Require Import SeqSeries.
+Require Import Rtrigo_def.
Open Local Scope R_scope.
-Definition A1 [x:R] : nat->R := [N:nat](sum_f_R0 [k:nat]``(pow (-1) k)/(INR (fact (mult (S (S O)) k)))*(pow x (mult (S (S O)) k))`` N).
+Definition A1 (x:R) (N:nat) : R :=
+ sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k)) * x ^ (2 * k)) N.
-Definition B1 [x:R] : nat->R := [N:nat](sum_f_R0 [k:nat]``(pow (-1) k)/(INR (fact (plus (mult (S (S O)) k) (S O))))*(pow x (plus (mult (S (S O)) k) (S O)))`` N).
+Definition B1 (x:R) (N:nat) : R :=
+ sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * x ^ (2 * k + 1))
+ N.
-Definition C1 [x,y:R] : nat -> R := [N:nat](sum_f_R0 [k:nat]``(pow (-1) k)/(INR (fact (mult (S (S O)) k)))*(pow (x+y) (mult (S (S O)) k))`` N).
+Definition C1 (x y:R) (N:nat) : R :=
+ sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k)) * (x + y) ^ (2 * k)) N.
-Definition Reste1 [x,y:R] : nat -> R := [N:nat](sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(pow (-1) (S (plus l k)))/(INR (fact (mult (S (S O)) (S (plus l k)))))*(pow x (mult (S (S O)) (S (plus l k))))*(pow (-1) (minus N l))/(INR (fact (mult (S (S O)) (minus N l))))*(pow y (mult (S (S O)) (minus N l)))`` (pred (minus N k))) (pred N)).
+Definition Reste1 (x y:R) (N:nat) : R :=
+ sum_f_R0
+ (fun k:nat =>
+ sum_f_R0
+ (fun l:nat =>
+ (-1) ^ S (l + k) / INR (fact (2 * S (l + k))) *
+ x ^ (2 * S (l + k)) * ((-1) ^ (N - l) / INR (fact (2 * (N - l)))) *
+ y ^ (2 * (N - l))) (pred (N - k))) (pred N).
-Definition Reste2 [x,y:R] : nat -> R := [N:nat](sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(pow (-1) (S (plus l k)))/(INR (fact (plus (mult (S (S O)) (S (plus l k))) (S O))))*(pow x (plus (mult (S (S O)) (S (plus l k))) (S O)))*(pow (-1) (minus N l))/(INR (fact (plus (mult (S (S O)) (minus N l)) (S O))))*(pow y (plus (mult (S (S O)) (minus N l)) (S O)))`` (pred (minus N k))) (pred N)).
+Definition Reste2 (x y:R) (N:nat) : R :=
+ sum_f_R0
+ (fun k:nat =>
+ sum_f_R0
+ (fun l:nat =>
+ (-1) ^ S (l + k) / INR (fact (2 * S (l + k) + 1)) *
+ x ^ (2 * S (l + k) + 1) *
+ ((-1) ^ (N - l) / INR (fact (2 * (N - l) + 1))) *
+ y ^ (2 * (N - l) + 1)) (pred (N - k))) (
+ pred N).
-Definition Reste [x,y:R] : nat -> R := [N:nat]``(Reste2 x y N)-(Reste1 x y (S N))``.
+Definition Reste (x y:R) (N:nat) : R := Reste2 x y N - Reste1 x y (S N).
(* Here is the main result that will be used to prove that (cos (x+y))=(cos x)(cos y)-(sin x)(sin y) *)
-Theorem cos_plus_form : (x,y:R;n:nat) (lt O n) -> ``(A1 x (S n))*(A1 y (S n))-(B1 x n)*(B1 y n)+(Reste x y n)``==(C1 x y (S n)).
-Intros.
-Unfold A1 B1.
-Rewrite (cauchy_finite [k:nat]
- ``(pow ( -1) k)/(INR (fact (mult (S (S O)) k)))*
- (pow x (mult (S (S O)) k))`` [k:nat]
- ``(pow ( -1) k)/(INR (fact (mult (S (S O)) k)))*
- (pow y (mult (S (S O)) k))`` (S n)).
-Rewrite (cauchy_finite [k:nat]
- ``(pow ( -1) k)/(INR (fact (plus (mult (S (S O)) k) (S O))))*
- (pow x (plus (mult (S (S O)) k) (S O)))`` [k:nat]
- ``(pow ( -1) k)/(INR (fact (plus (mult (S (S O)) k) (S O))))*
- (pow y (plus (mult (S (S O)) k) (S O)))`` n H).
-Unfold Reste.
-Replace (sum_f_R0
- [k:nat]
- (sum_f_R0
- [l:nat]
- ``(pow ( -1) (S (plus l k)))/
- (INR (fact (mult (S (S O)) (S (plus l k)))))*
- (pow x (mult (S (S O)) (S (plus l k))))*
- ((pow ( -1) (minus (S n) l))/
- (INR (fact (mult (S (S O)) (minus (S n) l))))*
- (pow y (mult (S (S O)) (minus (S n) l))))``
- (pred (minus (S n) k))) (pred (S n))) with (Reste1 x y (S n)).
-Replace (sum_f_R0
- [k:nat]
- (sum_f_R0
- [l:nat]
- ``(pow ( -1) (S (plus l k)))/
- (INR (fact (plus (mult (S (S O)) (S (plus l k))) (S O))))*
- (pow x (plus (mult (S (S O)) (S (plus l k))) (S O)))*
- ((pow ( -1) (minus n l))/
- (INR (fact (plus (mult (S (S O)) (minus n l)) (S O))))*
- (pow y (plus (mult (S (S O)) (minus n l)) (S O))))``
- (pred (minus n k))) (pred n)) with (Reste2 x y n).
-Ring.
-Replace (sum_f_R0
- [k:nat]
- (sum_f_R0
- [p:nat]
- ``(pow ( -1) p)/(INR (fact (mult (S (S O)) p)))*
- (pow x (mult (S (S O)) p))*((pow ( -1) (minus k p))/
- (INR (fact (mult (S (S O)) (minus k p))))*
- (pow y (mult (S (S O)) (minus k p))))`` k) (S n)) with (sum_f_R0 [k:nat](Rmult ``(pow (-1) k)/(INR (fact (mult (S (S O)) k)))`` (sum_f_R0 [l:nat]``(C (mult (S (S O)) k) (mult (S (S O)) l))*(pow x (mult (S (S O)) l))*(pow y (mult (S (S O)) (minus k l)))`` k)) (S n)).
-Pose sin_nnn := [n:nat]Cases n of O => R0 | (S p) => (Rmult ``(pow (-1) (S p))/(INR (fact (mult (S (S O)) (S p))))`` (sum_f_R0 [l:nat]``(C (mult (S (S O)) (S p)) (S (mult (S (S O)) l)))*(pow x (S (mult (S (S O)) l)))*(pow y (S (mult (S (S O)) (minus p l))))`` p)) end.
-Replace (Ropp (sum_f_R0
- [k:nat]
- (sum_f_R0
- [p:nat]
- ``(pow ( -1) p)/
- (INR (fact (plus (mult (S (S O)) p) (S O))))*
- (pow x (plus (mult (S (S O)) p) (S O)))*
- ((pow ( -1) (minus k p))/
- (INR (fact (plus (mult (S (S O)) (minus k p)) (S O))))*
- (pow y (plus (mult (S (S O)) (minus k p)) (S O))))`` k)
- n)) with (sum_f_R0 sin_nnn (S n)).
-Rewrite <- sum_plus.
-Unfold C1.
-Apply sum_eq; Intros.
-Induction i.
-Simpl.
-Rewrite Rplus_Ol.
-Replace (C O O) with R1.
-Unfold Rdiv; Rewrite Rinv_R1.
-Ring.
-Unfold C.
-Rewrite <- minus_n_n.
-Simpl.
-Unfold Rdiv; Rewrite Rmult_1r; Rewrite Rinv_R1; Ring.
-Unfold sin_nnn.
-Rewrite <- Rmult_Rplus_distr.
-Apply Rmult_mult_r.
-Rewrite binomial.
-Pose Wn := [i0:nat]``(C (mult (S (S O)) (S i)) i0)*(pow x i0)*
- (pow y (minus (mult (S (S O)) (S i)) i0))``.
-Replace (sum_f_R0
- [l:nat]
- ``(C (mult (S (S O)) (S i)) (mult (S (S O)) l))*
- (pow x (mult (S (S O)) l))*
- (pow y (mult (S (S O)) (minus (S i) l)))`` (S i)) with (sum_f_R0 [l:nat](Wn (mult (2) l)) (S i)).
-Replace (sum_f_R0
- [l:nat]
- ``(C (mult (S (S O)) (S i)) (S (mult (S (S O)) l)))*
- (pow x (S (mult (S (S O)) l)))*
- (pow y (S (mult (S (S O)) (minus i l))))`` i) with (sum_f_R0 [l:nat](Wn (S (mult (2) l))) i).
-Rewrite Rplus_sym.
-Apply sum_decomposition.
-Apply sum_eq; Intros.
-Unfold Wn.
-Apply Rmult_mult_r.
-Replace (minus (mult (2) (S i)) (S (mult (2) i0))) with (S (mult (2) (minus i i0))).
-Reflexivity.
-Apply INR_eq.
-Rewrite S_INR; Rewrite mult_INR.
-Repeat Rewrite minus_INR.
-Rewrite mult_INR; Repeat Rewrite S_INR.
-Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Replace (mult (2) (S i)) with (S (S (mult (2) i))).
-Apply le_n_S.
-Apply le_trans with (mult (2) i).
-Apply mult_le; Assumption.
-Apply le_n_Sn.
-Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Assumption.
-Apply sum_eq; Intros.
-Unfold Wn.
-Apply Rmult_mult_r.
-Replace (minus (mult (2) (S i)) (mult (2) i0)) with (mult (2) (minus (S i) i0)).
-Reflexivity.
-Apply INR_eq.
-Rewrite mult_INR.
-Repeat Rewrite minus_INR.
-Rewrite mult_INR; Repeat Rewrite S_INR.
-Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Apply mult_le; Assumption.
-Assumption.
-Rewrite <- (Ropp_Ropp (sum_f_R0 sin_nnn (S n))).
-Apply eq_Ropp.
-Replace ``-(sum_f_R0 sin_nnn (S n))`` with ``-1*(sum_f_R0 sin_nnn (S n))``; [Idtac | Ring].
-Rewrite scal_sum.
-Rewrite decomp_sum.
-Replace (sin_nnn O) with R0.
-Rewrite Rmult_Ol; Rewrite Rplus_Ol.
-Replace (pred (S n)) with n; [Idtac | Reflexivity].
-Apply sum_eq; Intros.
-Rewrite Rmult_sym.
-Unfold sin_nnn.
-Rewrite scal_sum.
-Rewrite scal_sum.
-Apply sum_eq; Intros.
-Unfold Rdiv.
-Repeat Rewrite Rmult_assoc.
-Rewrite (Rmult_sym ``/(INR (fact (mult (S (S O)) (S i))))``).
-Repeat Rewrite <- Rmult_assoc.
-Rewrite <- (Rmult_sym ``/(INR (fact (mult (S (S O)) (S i))))``).
-Repeat Rewrite <- Rmult_assoc.
-Replace ``/(INR (fact (mult (S (S O)) (S i))))*
- (C (mult (S (S O)) (S i)) (S (mult (S (S O)) i0)))`` with ``/(INR (fact (plus (mult (S (S O)) i0) (S O))))*/(INR (fact (plus (mult (S (S O)) (minus i i0)) (S O))))``.
-Replace (S (mult (2) i0)) with (plus (mult (2) i0) (1)); [Idtac | Ring].
-Replace (S (mult (2) (minus i i0))) with (plus (mult (2) (minus i i0)) (1)); [Idtac | Ring].
-Replace ``(pow (-1) (S i))`` with ``-1*(pow (-1) i0)*(pow (-1) (minus i i0))``.
-Ring.
-Simpl.
-Pattern 2 i; Replace i with (plus i0 (minus i i0)).
-Rewrite pow_add.
-Ring.
-Symmetry; Apply le_plus_minus; Assumption.
-Unfold C.
-Unfold Rdiv; Repeat Rewrite <- Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l.
-Rewrite Rinv_Rmult.
-Replace (S (mult (S (S O)) i0)) with (plus (mult (2) i0) (1)); [Apply Rmult_mult_r | Ring].
-Replace (minus (mult (2) (S i)) (plus (mult (2) i0) (1))) with (plus (mult (2) (minus i i0)) (1)).
-Reflexivity.
-Apply INR_eq.
-Rewrite plus_INR; Rewrite mult_INR; Repeat Rewrite minus_INR.
-Rewrite plus_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Replace (plus (mult (2) i0) (1)) with (S (mult (2) i0)).
-Replace (mult (2) (S i)) with (S (S (mult (2) i))).
-Apply le_n_S.
-Apply le_trans with (mult (2) i).
-Apply mult_le; Assumption.
-Apply le_n_Sn.
-Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Assumption.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Reflexivity.
-Apply lt_O_Sn.
-Apply sum_eq; Intros.
-Rewrite scal_sum.
-Apply sum_eq; Intros.
-Unfold Rdiv.
-Repeat Rewrite <- Rmult_assoc.
-Rewrite <- (Rmult_sym ``/(INR (fact (mult (S (S O)) i)))``).
-Repeat Rewrite <- Rmult_assoc.
-Replace ``/(INR (fact (mult (S (S O)) i)))*
- (C (mult (S (S O)) i) (mult (S (S O)) i0))`` with ``/(INR (fact (mult (S (S O)) i0)))*/(INR (fact (mult (S (S O)) (minus i i0))))``.
-Replace ``(pow (-1) i)`` with ``(pow (-1) i0)*(pow (-1) (minus i i0))``.
-Ring.
-Pattern 2 i; Replace i with (plus i0 (minus i i0)).
-Rewrite pow_add.
-Ring.
-Symmetry; Apply le_plus_minus; Assumption.
-Unfold C.
-Unfold Rdiv; Repeat Rewrite <- Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l.
-Rewrite Rinv_Rmult.
-Replace (minus (mult (2) i) (mult (2) i0)) with (mult (2) (minus i i0)).
-Reflexivity.
-Apply INR_eq.
-Rewrite mult_INR; Repeat Rewrite minus_INR.
-Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Apply mult_le; Assumption.
-Assumption.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Unfold Reste2; Apply sum_eq; Intros.
-Apply sum_eq; Intros.
-Unfold Rdiv; Ring.
-Unfold Reste1; Apply sum_eq; Intros.
-Apply sum_eq; Intros.
-Unfold Rdiv; Ring.
-Apply lt_O_Sn.
+Theorem cos_plus_form :
+ forall (x y:R) (n:nat),
+ (0 < n)%nat ->
+ A1 x (S n) * A1 y (S n) - B1 x n * B1 y n + Reste x y n = C1 x y (S n).
+intros.
+unfold A1, B1 in |- *.
+rewrite
+ (cauchy_finite (fun k:nat => (-1) ^ k / INR (fact (2 * k)) * x ^ (2 * k))
+ (fun k:nat => (-1) ^ k / INR (fact (2 * k)) * y ^ (2 * k)) (
+ S n)).
+rewrite
+ (cauchy_finite
+ (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * x ^ (2 * k + 1))
+ (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * y ^ (2 * k + 1)) n H)
+ .
+unfold Reste in |- *.
+replace
+ (sum_f_R0
+ (fun k:nat =>
+ sum_f_R0
+ (fun l:nat =>
+ (-1) ^ S (l + k) / INR (fact (2 * S (l + k))) *
+ x ^ (2 * S (l + k)) *
+ ((-1) ^ (S n - l) / INR (fact (2 * (S n - l))) *
+ y ^ (2 * (S n - l)))) (pred (S n - k))) (
+ pred (S n))) with (Reste1 x y (S n)).
+replace
+ (sum_f_R0
+ (fun k:nat =>
+ sum_f_R0
+ (fun l:nat =>
+ (-1) ^ S (l + k) / INR (fact (2 * S (l + k) + 1)) *
+ x ^ (2 * S (l + k) + 1) *
+ ((-1) ^ (n - l) / INR (fact (2 * (n - l) + 1)) *
+ y ^ (2 * (n - l) + 1))) (pred (n - k))) (
+ pred n)) with (Reste2 x y n).
+ring.
+replace
+ (sum_f_R0
+ (fun k:nat =>
+ sum_f_R0
+ (fun p:nat =>
+ (-1) ^ p / INR (fact (2 * p)) * x ^ (2 * p) *
+ ((-1) ^ (k - p) / INR (fact (2 * (k - p))) * y ^ (2 * (k - p))))
+ k) (S n)) with
+ (sum_f_R0
+ (fun k:nat =>
+ (-1) ^ k / INR (fact (2 * k)) *
+ sum_f_R0
+ (fun l:nat => C (2 * k) (2 * l) * x ^ (2 * l) * y ^ (2 * (k - l))) k)
+ (S n)).
+pose
+ (sin_nnn :=
+ fun n:nat =>
+ match n with
+ | O => 0
+ | S p =>
+ (-1) ^ S p / INR (fact (2 * S p)) *
+ sum_f_R0
+ (fun l:nat =>
+ C (2 * S p) (S (2 * l)) * x ^ S (2 * l) * y ^ S (2 * (p - l))) p
+ end).
+replace
+ (-
+ sum_f_R0
+ (fun k:nat =>
+ sum_f_R0
+ (fun p:nat =>
+ (-1) ^ p / INR (fact (2 * p + 1)) * x ^ (2 * p + 1) *
+ ((-1) ^ (k - p) / INR (fact (2 * (k - p) + 1)) *
+ y ^ (2 * (k - p) + 1))) k) n) with (sum_f_R0 sin_nnn (S n)).
+rewrite <- sum_plus.
+unfold C1 in |- *.
+apply sum_eq; intros.
+induction i as [| i Hreci].
+simpl in |- *.
+rewrite Rplus_0_l.
+replace (C 0 0) with 1.
+unfold Rdiv in |- *; rewrite Rinv_1.
+ring.
+unfold C in |- *.
+rewrite <- minus_n_n.
+simpl in |- *.
+unfold Rdiv in |- *; rewrite Rmult_1_r; rewrite Rinv_1; ring.
+unfold sin_nnn in |- *.
+rewrite <- Rmult_plus_distr_l.
+apply Rmult_eq_compat_l.
+rewrite binomial.
+pose (Wn := fun i0:nat => C (2 * S i) i0 * x ^ i0 * y ^ (2 * S i - i0)).
+replace
+ (sum_f_R0
+ (fun l:nat => C (2 * S i) (2 * l) * x ^ (2 * l) * y ^ (2 * (S i - l)))
+ (S i)) with (sum_f_R0 (fun l:nat => Wn (2 * l)%nat) (S i)).
+replace
+ (sum_f_R0
+ (fun l:nat =>
+ C (2 * S i) (S (2 * l)) * x ^ S (2 * l) * y ^ S (2 * (i - l))) i) with
+ (sum_f_R0 (fun l:nat => Wn (S (2 * l))) i).
+rewrite Rplus_comm.
+apply sum_decomposition.
+apply sum_eq; intros.
+unfold Wn in |- *.
+apply Rmult_eq_compat_l.
+replace (2 * S i - S (2 * i0))%nat with (S (2 * (i - i0))).
+reflexivity.
+apply INR_eq.
+rewrite S_INR; rewrite mult_INR.
+repeat rewrite minus_INR.
+rewrite mult_INR; repeat rewrite S_INR.
+rewrite mult_INR; repeat rewrite S_INR; ring.
+replace (2 * S i)%nat with (S (S (2 * i))).
+apply le_n_S.
+apply le_trans with (2 * i)%nat.
+apply (fun m n p:nat => mult_le_compat_l p n m); assumption.
+apply le_n_Sn.
+apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR;
+ ring.
+assumption.
+apply sum_eq; intros.
+unfold Wn in |- *.
+apply Rmult_eq_compat_l.
+replace (2 * S i - 2 * i0)%nat with (2 * (S i - i0))%nat.
+reflexivity.
+apply INR_eq.
+rewrite mult_INR.
+repeat rewrite minus_INR.
+rewrite mult_INR; repeat rewrite S_INR.
+rewrite mult_INR; repeat rewrite S_INR; ring.
+apply (fun m n p:nat => mult_le_compat_l p n m); assumption.
+assumption.
+rewrite <- (Ropp_involutive (sum_f_R0 sin_nnn (S n))).
+apply Ropp_eq_compat.
+replace (- sum_f_R0 sin_nnn (S n)) with (-1 * sum_f_R0 sin_nnn (S n));
+ [ idtac | ring ].
+rewrite scal_sum.
+rewrite decomp_sum.
+replace (sin_nnn 0%nat) with 0.
+rewrite Rmult_0_l; rewrite Rplus_0_l.
+replace (pred (S n)) with n; [ idtac | reflexivity ].
+apply sum_eq; intros.
+rewrite Rmult_comm.
+unfold sin_nnn in |- *.
+rewrite scal_sum.
+rewrite scal_sum.
+apply sum_eq; intros.
+unfold Rdiv in |- *.
+repeat rewrite Rmult_assoc.
+rewrite (Rmult_comm (/ INR (fact (2 * S i)))).
+repeat rewrite <- Rmult_assoc.
+rewrite <- (Rmult_comm (/ INR (fact (2 * S i)))).
+repeat rewrite <- Rmult_assoc.
+replace (/ INR (fact (2 * S i)) * C (2 * S i) (S (2 * i0))) with
+ (/ INR (fact (2 * i0 + 1)) * / INR (fact (2 * (i - i0) + 1))).
+replace (S (2 * i0)) with (2 * i0 + 1)%nat; [ idtac | ring ].
+replace (S (2 * (i - i0))) with (2 * (i - i0) + 1)%nat; [ idtac | ring ].
+replace ((-1) ^ S i) with (-1 * (-1) ^ i0 * (-1) ^ (i - i0)).
+ring.
+simpl in |- *.
+pattern i at 2 in |- *; replace i with (i0 + (i - i0))%nat.
+rewrite pow_add.
+ring.
+symmetry in |- *; apply le_plus_minus; assumption.
+unfold C in |- *.
+unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc.
+rewrite <- Rinv_l_sym.
+rewrite Rmult_1_l.
+rewrite Rinv_mult_distr.
+replace (S (2 * i0)) with (2 * i0 + 1)%nat;
+ [ apply Rmult_eq_compat_l | ring ].
+replace (2 * S i - (2 * i0 + 1))%nat with (2 * (i - i0) + 1)%nat.
+reflexivity.
+apply INR_eq.
+rewrite plus_INR; rewrite mult_INR; repeat rewrite minus_INR.
+rewrite plus_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; ring.
+replace (2 * i0 + 1)%nat with (S (2 * i0)).
+replace (2 * S i)%nat with (S (S (2 * i))).
+apply le_n_S.
+apply le_trans with (2 * i)%nat.
+apply (fun m n p:nat => mult_le_compat_l p n m); assumption.
+apply le_n_Sn.
+apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR;
+ ring.
+apply INR_eq; rewrite S_INR; rewrite plus_INR; rewrite mult_INR;
+ repeat rewrite S_INR; ring.
+assumption.
+apply INR_fact_neq_0.
+apply INR_fact_neq_0.
+apply INR_fact_neq_0.
+reflexivity.
+apply lt_O_Sn.
+apply sum_eq; intros.
+rewrite scal_sum.
+apply sum_eq; intros.
+unfold Rdiv in |- *.
+repeat rewrite <- Rmult_assoc.
+rewrite <- (Rmult_comm (/ INR (fact (2 * i)))).
+repeat rewrite <- Rmult_assoc.
+replace (/ INR (fact (2 * i)) * C (2 * i) (2 * i0)) with
+ (/ INR (fact (2 * i0)) * / INR (fact (2 * (i - i0)))).
+replace ((-1) ^ i) with ((-1) ^ i0 * (-1) ^ (i - i0)).
+ring.
+pattern i at 2 in |- *; replace i with (i0 + (i - i0))%nat.
+rewrite pow_add.
+ring.
+symmetry in |- *; apply le_plus_minus; assumption.
+unfold C in |- *.
+unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc.
+rewrite <- Rinv_l_sym.
+rewrite Rmult_1_l.
+rewrite Rinv_mult_distr.
+replace (2 * i - 2 * i0)%nat with (2 * (i - i0))%nat.
+reflexivity.
+apply INR_eq.
+rewrite mult_INR; repeat rewrite minus_INR.
+do 2 rewrite mult_INR; repeat rewrite S_INR; ring.
+apply (fun m n p:nat => mult_le_compat_l p n m); assumption.
+assumption.
+apply INR_fact_neq_0.
+apply INR_fact_neq_0.
+apply INR_fact_neq_0.
+unfold Reste2 in |- *; apply sum_eq; intros.
+apply sum_eq; intros.
+unfold Rdiv in |- *; ring.
+unfold Reste1 in |- *; apply sum_eq; intros.
+apply sum_eq; intros.
+unfold Rdiv in |- *; ring.
+apply lt_O_Sn.
Qed.
-Lemma pow_sqr : (x:R;i:nat) (pow x (mult (2) i))==(pow ``x*x`` i).
-Intros.
-Assert H := (pow_Rsqr x i).
-Unfold Rsqr in H; Exact H.
+Lemma pow_sqr : forall (x:R) (i:nat), x ^ (2 * i) = (x * x) ^ i.
+intros.
+assert (H := pow_Rsqr x i).
+unfold Rsqr in H; exact H.
Qed.
-Lemma A1_cvg : (x:R) (Un_cv (A1 x) (cos x)).
-Intro.
-Assert H := (exist_cos ``x*x``).
-Elim H; Intros.
-Assert p_i := p.
-Unfold cos_in in p.
-Unfold cos_n infinit_sum in p.
-Unfold R_dist in p.
-Cut ``(cos x)==x0``.
-Intro.
-Rewrite H0.
-Unfold Un_cv; Unfold R_dist; Intros.
-Elim (p eps H1); Intros.
-Exists x1; Intros.
-Unfold A1.
-Replace (sum_f_R0 ([k:nat]``(pow ( -1) k)/(INR (fact (mult (S (S O)) k)))*(pow x (mult (S (S O)) k))``) n) with (sum_f_R0 ([i:nat]``(pow ( -1) i)/(INR (fact (mult (S (S O)) i)))*(pow (x*x) i)``) n).
-Apply H2; Assumption.
-Apply sum_eq.
-Intros.
-Replace ``(pow (x*x) i)`` with ``(pow x (mult (S (S O)) i))``.
-Reflexivity.
-Apply pow_sqr.
-Unfold cos.
-Case (exist_cos (Rsqr x)).
-Unfold Rsqr; Intros.
-Unfold cos_in in p_i.
-Unfold cos_in in c.
-Apply unicity_sum with [i:nat]``(cos_n i)*(pow (x*x) i)``; Assumption.
+Lemma A1_cvg : forall x:R, Un_cv (A1 x) (cos x).
+intro.
+assert (H := exist_cos (x * x)).
+elim H; intros.
+assert (p_i := p).
+unfold cos_in in p.
+unfold cos_n, infinit_sum in p.
+unfold R_dist in p.
+cut (cos x = x0).
+intro.
+rewrite H0.
+unfold Un_cv in |- *; unfold R_dist in |- *; intros.
+elim (p eps H1); intros.
+exists x1; intros.
+unfold A1 in |- *.
+replace
+ (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k)) * x ^ (2 * k)) n) with
+ (sum_f_R0 (fun i:nat => (-1) ^ i / INR (fact (2 * i)) * (x * x) ^ i) n).
+apply H2; assumption.
+apply sum_eq.
+intros.
+replace ((x * x) ^ i) with (x ^ (2 * i)).
+reflexivity.
+apply pow_sqr.
+unfold cos in |- *.
+case (exist_cos (Rsqr x)).
+unfold Rsqr in |- *; intros.
+unfold cos_in in p_i.
+unfold cos_in in c.
+apply uniqueness_sum with (fun i:nat => cos_n i * (x * x) ^ i); assumption.
Qed.
-Lemma C1_cvg : (x,y:R) (Un_cv (C1 x y) (cos (Rplus x y))).
-Intros.
-Assert H := (exist_cos ``(x+y)*(x+y)``).
-Elim H; Intros.
-Assert p_i := p.
-Unfold cos_in in p.
-Unfold cos_n infinit_sum in p.
-Unfold R_dist in p.
-Cut ``(cos (x+y))==x0``.
-Intro.
-Rewrite H0.
-Unfold Un_cv; Unfold R_dist; Intros.
-Elim (p eps H1); Intros.
-Exists x1; Intros.
-Unfold C1.
-Replace (sum_f_R0 ([k:nat]``(pow ( -1) k)/(INR (fact (mult (S (S O)) k)))*(pow (x+y) (mult (S (S O)) k))``) n) with (sum_f_R0 ([i:nat]``(pow ( -1) i)/(INR (fact (mult (S (S O)) i)))*(pow ((x+y)*(x+y)) i)``) n).
-Apply H2; Assumption.
-Apply sum_eq.
-Intros.
-Replace ``(pow ((x+y)*(x+y)) i)`` with ``(pow (x+y) (mult (S (S O)) i))``.
-Reflexivity.
-Apply pow_sqr.
-Unfold cos.
-Case (exist_cos (Rsqr ``x+y``)).
-Unfold Rsqr; Intros.
-Unfold cos_in in p_i.
-Unfold cos_in in c.
-Apply unicity_sum with [i:nat]``(cos_n i)*(pow ((x+y)*(x+y)) i)``; Assumption.
+Lemma C1_cvg : forall x y:R, Un_cv (C1 x y) (cos (x + y)).
+intros.
+assert (H := exist_cos ((x + y) * (x + y))).
+elim H; intros.
+assert (p_i := p).
+unfold cos_in in p.
+unfold cos_n, infinit_sum in p.
+unfold R_dist in p.
+cut (cos (x + y) = x0).
+intro.
+rewrite H0.
+unfold Un_cv in |- *; unfold R_dist in |- *; intros.
+elim (p eps H1); intros.
+exists x1; intros.
+unfold C1 in |- *.
+replace
+ (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k)) * (x + y) ^ (2 * k)) n)
+ with
+ (sum_f_R0
+ (fun i:nat => (-1) ^ i / INR (fact (2 * i)) * ((x + y) * (x + y)) ^ i) n).
+apply H2; assumption.
+apply sum_eq.
+intros.
+replace (((x + y) * (x + y)) ^ i) with ((x + y) ^ (2 * i)).
+reflexivity.
+apply pow_sqr.
+unfold cos in |- *.
+case (exist_cos (Rsqr (x + y))).
+unfold Rsqr in |- *; intros.
+unfold cos_in in p_i.
+unfold cos_in in c.
+apply uniqueness_sum with (fun i:nat => cos_n i * ((x + y) * (x + y)) ^ i);
+ assumption.
Qed.
-Lemma B1_cvg : (x:R) (Un_cv (B1 x) (sin x)).
-Intro.
-Case (Req_EM x R0); Intro.
-Rewrite H.
-Rewrite sin_0.
-Unfold B1.
-Unfold Un_cv; Unfold R_dist; Intros; Exists O; Intros.
-Replace (sum_f_R0 ([k:nat]``(pow ( -1) k)/(INR (fact (plus (mult (S (S O)) k) (S O))))*(pow 0 (plus (mult (S (S O)) k) (S O)))``) n) with R0.
-Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption.
-Induction n.
-Simpl; Ring.
-Rewrite tech5; Rewrite <- Hrecn.
-Simpl; Ring.
-Unfold ge; Apply le_O_n.
-Assert H0 := (exist_sin ``x*x``).
-Elim H0; Intros.
-Assert p_i := p.
-Unfold sin_in in p.
-Unfold sin_n infinit_sum in p.
-Unfold R_dist in p.
-Cut ``(sin x)==x*x0``.
-Intro.
-Rewrite H1.
-Unfold Un_cv; Unfold R_dist; Intros.
-Cut ``0<eps/(Rabsolu x)``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption]].
-Elim (p ``eps/(Rabsolu x)`` H3); Intros.
-Exists x1; Intros.
-Unfold B1.
-Replace (sum_f_R0 ([k:nat]``(pow ( -1) k)/(INR (fact (plus (mult (S (S O)) k) (S O))))*(pow x (plus (mult (S (S O)) k) (S O)))``) n) with (Rmult x (sum_f_R0 ([i:nat]``(pow ( -1) i)/(INR (fact (plus (mult (S (S O)) i) (S O))))*(pow (x*x) i)``) n)).
-Replace (Rminus (Rmult x (sum_f_R0 ([i:nat]``(pow ( -1) i)/(INR (fact (plus (mult (S (S O)) i) (S O))))*(pow (x*x) i)``) n)) (Rmult x x0)) with (Rmult x (Rminus (sum_f_R0 ([i:nat]``(pow ( -1) i)/(INR (fact (plus (mult (S (S O)) i) (S O))))*(pow (x*x) i)``) n) x0)); [Idtac | Ring].
-Rewrite Rabsolu_mult.
-Apply Rlt_monotony_contra with ``/(Rabsolu x)``.
-Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption.
-Rewrite <- Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l; Rewrite <- (Rmult_sym eps); Unfold Rdiv in H4; Apply H4; Assumption.
-Apply Rabsolu_no_R0; Assumption.
-Rewrite scal_sum.
-Apply sum_eq.
-Intros.
-Rewrite pow_add.
-Rewrite pow_sqr.
-Simpl.
-Ring.
-Unfold sin.
-Case (exist_sin (Rsqr x)).
-Unfold Rsqr; Intros.
-Unfold sin_in in p_i.
-Unfold sin_in in s.
-Assert H1 := (unicity_sum [i:nat]``(sin_n i)*(pow (x*x) i)`` x0 x1 p_i s).
-Rewrite H1; Reflexivity.
-Qed.
+Lemma B1_cvg : forall x:R, Un_cv (B1 x) (sin x).
+intro.
+case (Req_dec x 0); intro.
+rewrite H.
+rewrite sin_0.
+unfold B1 in |- *.
+unfold Un_cv in |- *; unfold R_dist in |- *; intros; exists 0%nat; intros.
+replace
+ (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * 0 ^ (2 * k + 1))
+ n) with 0.
+unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption.
+induction n as [| n Hrecn].
+simpl in |- *; ring.
+rewrite tech5; rewrite <- Hrecn.
+simpl in |- *; ring.
+unfold ge in |- *; apply le_O_n.
+assert (H0 := exist_sin (x * x)).
+elim H0; intros.
+assert (p_i := p).
+unfold sin_in in p.
+unfold sin_n, infinit_sum in p.
+unfold R_dist in p.
+cut (sin x = x * x0).
+intro.
+rewrite H1.
+unfold Un_cv in |- *; unfold R_dist in |- *; intros.
+cut (0 < eps / Rabs x);
+ [ intro
+ | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ assumption | apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption ] ].
+elim (p (eps / Rabs x) H3); intros.
+exists x1; intros.
+unfold B1 in |- *.
+replace
+ (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * x ^ (2 * k + 1))
+ n) with
+ (x *
+ sum_f_R0 (fun i:nat => (-1) ^ i / INR (fact (2 * i + 1)) * (x * x) ^ i) n).
+replace
+ (x *
+ sum_f_R0 (fun i:nat => (-1) ^ i / INR (fact (2 * i + 1)) * (x * x) ^ i) n -
+ x * x0) with
+ (x *
+ (sum_f_R0 (fun i:nat => (-1) ^ i / INR (fact (2 * i + 1)) * (x * x) ^ i) n -
+ x0)); [ idtac | ring ].
+rewrite Rabs_mult.
+apply Rmult_lt_reg_l with (/ Rabs x).
+apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption.
+rewrite <- Rmult_assoc.
+rewrite <- Rinv_l_sym.
+rewrite Rmult_1_l; rewrite <- (Rmult_comm eps); unfold Rdiv in H4; apply H4;
+ assumption.
+apply Rabs_no_R0; assumption.
+rewrite scal_sum.
+apply sum_eq.
+intros.
+rewrite pow_add.
+rewrite pow_sqr.
+simpl in |- *.
+ring.
+unfold sin in |- *.
+case (exist_sin (Rsqr x)).
+unfold Rsqr in |- *; intros.
+unfold sin_in in p_i.
+unfold sin_in in s.
+assert
+ (H1 := uniqueness_sum (fun i:nat => sin_n i * (x * x) ^ i) x0 x1 p_i s).
+rewrite H1; reflexivity.
+Qed. \ No newline at end of file
diff --git a/theories/Reals/DiscrR.v b/theories/Reals/DiscrR.v
index 3f0986480..474451903 100644
--- a/theories/Reals/DiscrR.v
+++ b/theories/Reals/DiscrR.v
@@ -8,51 +8,90 @@
(*i $Id$ i*)
-Require RIneq.
-Require Omega.
-V7only [Import R_scope.]. Open Local Scope R_scope.
+Require Import RIneq.
+Require Import Omega. Open Local Scope R_scope.
-Lemma Rlt_R0_R2 : ``0<2``.
-Replace ``2`` with (INR (2)); [Apply lt_INR_0; Apply lt_O_Sn | Reflexivity].
+Lemma Rlt_R0_R2 : 0 < 2.
+replace 2 with (INR 2); [ apply lt_INR_0; apply lt_O_Sn | reflexivity ].
Qed.
-Lemma Rplus_lt_pos : (x,y:R) ``0<x`` -> ``0<y`` -> ``0<x+y``.
-Intros.
-Apply Rlt_trans with x.
-Assumption.
-Pattern 1 x; Rewrite <- Rplus_Or.
-Apply Rlt_compatibility.
-Assumption.
+Lemma Rplus_lt_pos : forall x y:R, 0 < x -> 0 < y -> 0 < x + y.
+intros.
+apply Rlt_trans with x.
+assumption.
+pattern x at 1 in |- *; rewrite <- Rplus_0_r.
+apply Rplus_lt_compat_l.
+assumption.
Qed.
-Lemma IZR_eq : (z1,z2:Z) z1=z2 -> (IZR z1)==(IZR z2).
-Intros; Rewrite H; Reflexivity.
+Lemma IZR_eq : forall z1 z2:Z, z1 = z2 -> IZR z1 = IZR z2.
+intros; rewrite H; reflexivity.
Qed.
-Lemma IZR_neq : (z1,z2:Z) `z1<>z2` -> ``(IZR z1)<>(IZR z2)``.
-Intros; Red; Intro; Elim H; Apply eq_IZR; Assumption.
+Lemma IZR_neq : forall z1 z2:Z, z1 <> z2 -> IZR z1 <> IZR z2.
+intros; red in |- *; intro; elim H; apply eq_IZR; assumption.
Qed.
-Tactic Definition DiscrR :=
- Try Match Context With
- | [ |- ~(?1==?2) ] -> Replace ``2`` with (IZR `2`); [Replace R1 with (IZR `1`); [Replace R0 with (IZR `0`); [Repeat Rewrite <- plus_IZR Orelse Rewrite <- mult_IZR Orelse Rewrite <- Ropp_Ropp_IZR Orelse Rewrite Z_R_minus; Apply IZR_neq; Try Discriminate | Reflexivity] | Reflexivity] | Reflexivity].
+Ltac discrR :=
+ try
+ match goal with
+ | |- (?X1 <> ?X2) =>
+ replace 2 with (IZR 2);
+ [ replace 1 with (IZR 1);
+ [ replace 0 with (IZR 0);
+ [ repeat
+ rewrite <- plus_IZR ||
+ rewrite <- mult_IZR ||
+ rewrite <- Ropp_Ropp_IZR || rewrite Z_R_minus;
+ apply IZR_neq; try discriminate
+ | reflexivity ]
+ | reflexivity ]
+ | reflexivity ]
+ end.
-Recursive Tactic Definition Sup0 :=
- Match Context With
- | [ |- ``0<1`` ] -> Apply Rlt_R0_R1
- | [ |- ``0<?1`` ] -> Repeat (Apply Rmult_lt_pos Orelse Apply Rplus_lt_pos; Try Apply Rlt_R0_R1 Orelse Apply Rlt_R0_R2)
- | [ |- ``?1>0`` ] -> Change ``0<?1``; Sup0.
+Ltac prove_sup0 :=
+ match goal with
+ | |- (0 < 1) => apply Rlt_0_1
+ | |- (0 < ?X1) =>
+ repeat
+ (apply Rmult_lt_0_compat || apply Rplus_lt_pos;
+ try apply Rlt_0_1 || apply Rlt_R0_R2)
+ | |- (?X1 > 0) => change (0 < X1) in |- *; prove_sup0
+ end.
-Tactic Definition SupOmega := Replace ``2`` with (IZR `2`); [Replace R1 with (IZR `1`); [Replace R0 with (IZR `0`); [Repeat Rewrite <- plus_IZR Orelse Rewrite <- mult_IZR Orelse Rewrite <- Ropp_Ropp_IZR Orelse Rewrite Z_R_minus; Apply IZR_lt; Omega | Reflexivity] | Reflexivity] | Reflexivity].
+Ltac omega_sup :=
+ replace 2 with (IZR 2);
+ [ replace 1 with (IZR 1);
+ [ replace 0 with (IZR 0);
+ [ repeat
+ rewrite <- plus_IZR ||
+ rewrite <- mult_IZR ||
+ rewrite <- Ropp_Ropp_IZR || rewrite Z_R_minus;
+ apply IZR_lt; omega
+ | reflexivity ]
+ | reflexivity ]
+ | reflexivity ].
-Recursive Tactic Definition Sup :=
- Match Context With
- | [ |- (Rgt ?1 ?2) ] -> Change ``?2<?1``; Sup
- | [ |- ``0<?1`` ] -> Sup0
- | [ |- (Rlt (Ropp ?1) R0) ] -> Rewrite <- Ropp_O; Sup
- | [ |- (Rlt (Ropp ?1) (Ropp ?2)) ] -> Apply Rlt_Ropp; Sup
- | [ |- (Rlt (Ropp ?1) ?2) ] -> Apply Rlt_trans with ``0``; Sup
- | [ |- (Rlt ?1 ?2) ] -> SupOmega
- | _ -> Idtac.
-
-Tactic Definition RCompute := Replace ``2`` with (IZR `2`); [Replace R1 with (IZR `1`); [Replace R0 with (IZR `0`); [Repeat Rewrite <- plus_IZR Orelse Rewrite <- mult_IZR Orelse Rewrite <- Ropp_Ropp_IZR Orelse Rewrite Z_R_minus; Apply IZR_eq; Try Reflexivity | Reflexivity] | Reflexivity] | Reflexivity].
+Ltac prove_sup :=
+ match goal with
+ | |- (?X1 > ?X2) => change (X2 < X1) in |- *; prove_sup
+ | |- (0 < ?X1) => prove_sup0
+ | |- (- ?X1 < 0) => rewrite <- Ropp_0; prove_sup
+ | |- (- ?X1 < - ?X2) => apply Ropp_lt_gt_contravar; prove_sup
+ | |- (- ?X1 < ?X2) => apply Rlt_trans with 0; prove_sup
+ | |- (?X1 < ?X2) => omega_sup
+ | _ => idtac
+ end.
+
+Ltac Rcompute :=
+ replace 2 with (IZR 2);
+ [ replace 1 with (IZR 1);
+ [ replace 0 with (IZR 0);
+ [ repeat
+ rewrite <- plus_IZR ||
+ rewrite <- mult_IZR ||
+ rewrite <- Ropp_Ropp_IZR || rewrite Z_R_minus;
+ apply IZR_eq; try reflexivity
+ | reflexivity ]
+ | reflexivity ]
+ | reflexivity ]. \ No newline at end of file
diff --git a/theories/Reals/Exp_prop.v b/theories/Reals/Exp_prop.v
index 5c06af34a..c424b9e14 100644
--- a/theories/Reals/Exp_prop.v
+++ b/theories/Reals/Exp_prop.v
@@ -8,883 +8,1004 @@
(*i $Id$ i*)
-Require Rbase.
-Require Rfunctions.
-Require SeqSeries.
-Require Rtrigo.
-Require Ranalysis1.
-Require PSeries_reg.
-Require Div2.
-Require Even.
-Require Max.
-V7only [Import R_scope.].
+Require Import Rbase.
+Require Import Rfunctions.
+Require Import SeqSeries.
+Require Import Rtrigo.
+Require Import Ranalysis1.
+Require Import PSeries_reg.
+Require Import Div2.
+Require Import Even.
+Require Import Max.
Open Local Scope nat_scope.
-V7only [Import nat_scope.].
Open Local Scope R_scope.
-Definition E1 [x:R] : nat->R := [N:nat](sum_f_R0 [k:nat]``/(INR (fact k))*(pow x k)`` N).
+Definition E1 (x:R) (N:nat) : R :=
+ sum_f_R0 (fun k:nat => / INR (fact k) * x ^ k) N.
-Lemma E1_cvg : (x:R) (Un_cv (E1 x) (exp x)).
-Intro; Unfold exp; Unfold projT1.
-Case (exist_exp x); Intro.
-Unfold exp_in Un_cv; Unfold infinit_sum E1; Trivial.
+Lemma E1_cvg : forall x:R, Un_cv (E1 x) (exp x).
+intro; unfold exp in |- *; unfold projT1 in |- *.
+case (exist_exp x); intro.
+unfold exp_in, Un_cv in |- *; unfold infinit_sum, E1 in |- *; trivial.
Qed.
-Definition Reste_E [x,y:R] : nat->R := [N:nat](sum_f_R0 [k:nat](sum_f_R0 [l:nat]``/(INR (fact (S (plus l k))))*(pow x (S (plus l k)))*(/(INR (fact (minus N l)))*(pow y (minus N l)))`` (pred (minus N k))) (pred N)).
+Definition Reste_E (x y:R) (N:nat) : R :=
+ sum_f_R0
+ (fun k:nat =>
+ sum_f_R0
+ (fun l:nat =>
+ / INR (fact (S (l + k))) * x ^ S (l + k) *
+ (/ INR (fact (N - l)) * y ^ (N - l))) (
+ pred (N - k))) (pred N).
-Lemma exp_form : (x,y:R;n:nat) (lt O n) -> ``(E1 x n)*(E1 y n)-(Reste_E x y n)==(E1 (x+y) n)``.
-Intros; Unfold E1.
-Rewrite cauchy_finite.
-Unfold Reste_E; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or; Apply sum_eq; Intros.
-Rewrite binomial.
-Rewrite scal_sum; Apply sum_eq; Intros.
-Unfold C; Unfold Rdiv; Repeat Rewrite Rmult_assoc; Rewrite (Rmult_sym (INR (fact i))); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Rewrite Rinv_Rmult.
-Ring.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply H.
+Lemma exp_form :
+ forall (x y:R) (n:nat),
+ (0 < n)%nat -> E1 x n * E1 y n - Reste_E x y n = E1 (x + y) n.
+intros; unfold E1 in |- *.
+rewrite cauchy_finite.
+unfold Reste_E in |- *; unfold Rminus in |- *; rewrite Rplus_assoc;
+ rewrite Rplus_opp_r; rewrite Rplus_0_r; apply sum_eq;
+ intros.
+rewrite binomial.
+rewrite scal_sum; apply sum_eq; intros.
+unfold C in |- *; unfold Rdiv in |- *; repeat rewrite Rmult_assoc;
+ rewrite (Rmult_comm (INR (fact i))); repeat rewrite Rmult_assoc;
+ rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r; rewrite Rinv_mult_distr.
+ring.
+apply INR_fact_neq_0.
+apply INR_fact_neq_0.
+apply INR_fact_neq_0.
+apply H.
Qed.
-Definition maj_Reste_E [x,y:R] : nat->R := [N:nat]``4*(pow (Rmax R1 (Rmax (Rabsolu x) (Rabsolu y))) (mult (S (S O)) N))/(Rsqr (INR (fact (div2 (pred N)))))``.
+Definition maj_Reste_E (x y:R) (N:nat) : R :=
+ 4 *
+ (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (2 * N) /
+ Rsqr (INR (fact (div2 (pred N))))).
-Lemma Rle_Rinv : (x,y:R) ``0<x`` -> ``0<y`` -> ``x<=y`` -> ``/y<=/x``.
-Intros; Apply Rle_monotony_contra with x.
-Apply H.
-Rewrite <- Rinv_r_sym.
-Apply Rle_monotony_contra with y.
-Apply H0.
-Rewrite Rmult_1r; Rewrite Rmult_sym; Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Apply H1.
-Red; Intro; Rewrite H2 in H0; Elim (Rlt_antirefl ? H0).
-Red; Intro; Rewrite H2 in H; Elim (Rlt_antirefl ? H).
+Lemma Rle_Rinv : forall x y:R, 0 < x -> 0 < y -> x <= y -> / y <= / x.
+intros; apply Rmult_le_reg_l with x.
+apply H.
+rewrite <- Rinv_r_sym.
+apply Rmult_le_reg_l with y.
+apply H0.
+rewrite Rmult_1_r; rewrite Rmult_comm; rewrite Rmult_assoc;
+ rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r; apply H1.
+red in |- *; intro; rewrite H2 in H0; elim (Rlt_irrefl _ H0).
+red in |- *; intro; rewrite H2 in H; elim (Rlt_irrefl _ H).
Qed.
(**********)
-Lemma div2_double : (N:nat) (div2 (mult (2) N))=N.
-Intro; Induction N.
-Reflexivity.
-Replace (mult (2) (S N)) with (S (S (mult (2) N))).
-Simpl; Simpl in HrecN; Rewrite HrecN; Reflexivity.
-Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
+Lemma div2_double : forall N:nat, div2 (2 * N) = N.
+intro; induction N as [| N HrecN].
+reflexivity.
+replace (2 * S N)%nat with (S (S (2 * N))).
+simpl in |- *; simpl in HrecN; rewrite HrecN; reflexivity.
+apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR;
+ ring.
Qed.
-Lemma div2_S_double : (N:nat) (div2 (S (mult (2) N)))=N.
-Intro; Induction N.
-Reflexivity.
-Replace (mult (2) (S N)) with (S (S (mult (2) N))).
-Simpl; Simpl in HrecN; Rewrite HrecN; Reflexivity.
-Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
+Lemma div2_S_double : forall N:nat, div2 (S (2 * N)) = N.
+intro; induction N as [| N HrecN].
+reflexivity.
+replace (2 * S N)%nat with (S (S (2 * N))).
+simpl in |- *; simpl in HrecN; rewrite HrecN; reflexivity.
+apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR;
+ ring.
Qed.
-Lemma div2_not_R0 : (N:nat) (lt (1) N) -> (lt O (div2 N)).
-Intros; Induction N.
-Elim (lt_n_O ? H).
-Cut (lt (1) N)\/N=(1).
-Intro; Elim H0; Intro.
-Assert H2 := (even_odd_dec N).
-Elim H2; Intro.
-Rewrite <- (even_div2 ? a); Apply HrecN; Assumption.
-Rewrite <- (odd_div2 ? b); Apply lt_O_Sn.
-Rewrite H1; Simpl; Apply lt_O_Sn.
-Inversion H.
-Right; Reflexivity.
-Left; Apply lt_le_trans with (2); [Apply lt_n_Sn | Apply H1].
+Lemma div2_not_R0 : forall N:nat, (1 < N)%nat -> (0 < div2 N)%nat.
+intros; induction N as [| N HrecN].
+elim (lt_n_O _ H).
+cut ((1 < N)%nat \/ N = 1%nat).
+intro; elim H0; intro.
+assert (H2 := even_odd_dec N).
+elim H2; intro.
+rewrite <- (even_div2 _ a); apply HrecN; assumption.
+rewrite <- (odd_div2 _ b); apply lt_O_Sn.
+rewrite H1; simpl in |- *; apply lt_O_Sn.
+inversion H.
+right; reflexivity.
+left; apply lt_le_trans with 2%nat; [ apply lt_n_Sn | apply H1 ].
Qed.
-Lemma Reste_E_maj : (x,y:R;N:nat) (lt O N) -> ``(Rabsolu (Reste_E x y N))<=(maj_Reste_E x y N)``.
-Intros; Pose M := (Rmax R1 (Rmax (Rabsolu x) (Rabsolu y))).
-Apply Rle_trans with (Rmult (pow M (mult (2) N)) (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``/(Rsqr (INR (fact (div2 (S N)))))`` (pred (minus N k))) (pred N))).
-Unfold Reste_E.
-Apply Rle_trans with (sum_f_R0 [k:nat](Rabsolu (sum_f_R0 [l:nat]``/(INR (fact (S (plus l k))))*(pow x (S (plus l k)))*(/(INR (fact (minus N l)))*(pow y (minus N l)))`` (pred (minus N k)))) (pred N)).
-Apply (sum_Rabsolu [k:nat](sum_f_R0 [l:nat]``/(INR (fact (S (plus l k))))*(pow x (S (plus l k)))*(/(INR (fact (minus N l)))*(pow y (minus N l)))`` (pred (minus N k))) (pred N)).
-Apply Rle_trans with (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(Rabsolu (/(INR (fact (S (plus l k))))*(pow x (S (plus l k)))*(/(INR (fact (minus N l)))*(pow y (minus N l)))))`` (pred (minus N k))) (pred N)).
-Apply sum_Rle; Intros.
-Apply (sum_Rabsolu [l:nat]``/(INR (fact (S (plus l n))))*(pow x (S (plus l n)))*(/(INR (fact (minus N l)))*(pow y (minus N l)))``).
-Apply Rle_trans with (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(pow M (mult (S (S O)) N))*/(INR (fact (S l)))*/(INR (fact (minus N l)))`` (pred (minus N k))) (pred N)).
-Apply sum_Rle; Intros.
-Apply sum_Rle; Intros.
-Repeat Rewrite Rabsolu_mult.
-Do 2 Rewrite <- Pow_Rabsolu.
-Rewrite (Rabsolu_right ``/(INR (fact (S (plus n0 n))))``).
-Rewrite (Rabsolu_right ``/(INR (fact (minus N n0)))``).
-Replace ``/(INR (fact (S (plus n0 n))))*(pow (Rabsolu x) (S (plus n0 n)))*
- (/(INR (fact (minus N n0)))*(pow (Rabsolu y) (minus N n0)))`` with ``/(INR (fact (minus N n0)))*/(INR (fact (S (plus n0 n))))*(pow (Rabsolu x) (S (plus n0 n)))*(pow (Rabsolu y) (minus N n0))``; [Idtac | Ring].
-Rewrite <- (Rmult_sym ``/(INR (fact (minus N n0)))``).
-Repeat Rewrite Rmult_assoc.
-Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Apply Rle_trans with ``/(INR (fact (S n0)))*(pow (Rabsolu x) (S (plus n0 n)))*(pow (Rabsolu y) (minus N n0))``.
-Rewrite (Rmult_sym ``/(INR (fact (S (plus n0 n))))``); Rewrite (Rmult_sym ``/(INR (fact (S n0)))``); Repeat Rewrite Rmult_assoc; Apply Rle_monotony.
-Apply pow_le; Apply Rabsolu_pos.
-Rewrite (Rmult_sym ``/(INR (fact (S n0)))``); Apply Rle_monotony.
-Apply pow_le; Apply Rabsolu_pos.
-Apply Rle_Rinv.
-Apply INR_fact_lt_0.
-Apply INR_fact_lt_0.
-Apply le_INR; Apply fact_growing; Apply le_n_S.
-Apply le_plus_l.
-Rewrite (Rmult_sym ``(pow M (mult (S (S O)) N))``); Rewrite Rmult_assoc; Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Apply Rle_trans with ``(pow M (S (plus n0 n)))*(pow (Rabsolu y) (minus N n0))``.
-Do 2 Rewrite <- (Rmult_sym ``(pow (Rabsolu y) (minus N n0))``).
-Apply Rle_monotony.
-Apply pow_le; Apply Rabsolu_pos.
-Apply pow_incr; Split.
-Apply Rabsolu_pos.
-Apply Rle_trans with (Rmax (Rabsolu x) (Rabsolu y)).
-Apply RmaxLess1.
-Unfold M; Apply RmaxLess2.
-Apply Rle_trans with ``(pow M (S (plus n0 n)))*(pow M (minus N n0))``.
-Apply Rle_monotony.
-Apply pow_le; Apply Rle_trans with R1.
-Left; Apply Rlt_R0_R1.
-Unfold M; Apply RmaxLess1.
-Apply pow_incr; Split.
-Apply Rabsolu_pos.
-Apply Rle_trans with (Rmax (Rabsolu x) (Rabsolu y)).
-Apply RmaxLess2.
-Unfold M; Apply RmaxLess2.
-Rewrite <- pow_add; Replace (plus (S (plus n0 n)) (minus N n0)) with (plus N (S n)).
-Apply Rle_pow.
-Unfold M; Apply RmaxLess1.
-Replace (mult (2) N) with (plus N N); [Idtac | Ring].
-Apply le_reg_l.
-Replace N with (S (pred N)).
-Apply le_n_S; Apply H0.
-Symmetry; Apply S_pred with O; Apply H.
-Apply INR_eq; Do 2 Rewrite plus_INR; Do 2 Rewrite S_INR; Rewrite plus_INR; Rewrite minus_INR.
-Ring.
-Apply le_trans with (pred (minus N n)).
-Apply H1.
-Apply le_S_n.
-Replace (S (pred (minus N n))) with (minus N n).
-Apply le_trans with N.
-Apply simpl_le_plus_l with n.
-Rewrite <- le_plus_minus.
-Apply le_plus_r.
-Apply le_trans with (pred N).
-Apply H0.
-Apply le_pred_n.
-Apply le_n_Sn.
-Apply S_pred with O.
-Apply simpl_lt_plus_l with n.
-Rewrite <- le_plus_minus.
-Replace (plus n (0)) with n; [Idtac | Ring].
-Apply le_lt_trans with (pred N).
-Apply H0.
-Apply lt_pred_n_n.
-Apply H.
-Apply le_trans with (pred N).
-Apply H0.
-Apply le_pred_n.
-Apply Rle_sym1; Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Apply Rle_sym1; Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Rewrite scal_sum.
-Apply sum_Rle; Intros.
-Rewrite <- Rmult_sym.
-Rewrite scal_sum.
-Apply sum_Rle; Intros.
-Rewrite (Rmult_sym ``/(Rsqr (INR (fact (div2 (S N)))))``).
-Rewrite Rmult_assoc; Apply Rle_monotony.
-Apply pow_le.
-Apply Rle_trans with R1.
-Left; Apply Rlt_R0_R1.
-Unfold M; Apply RmaxLess1.
-Assert H2 := (even_odd_cor N).
-Elim H2; Intros N0 H3.
-Elim H3; Intro.
-Apply Rle_trans with ``/(INR (fact n0))*/(INR (fact (minus N n0)))``.
-Do 2 Rewrite <- (Rmult_sym ``/(INR (fact (minus N n0)))``).
-Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Apply Rle_Rinv.
-Apply INR_fact_lt_0.
-Apply INR_fact_lt_0.
-Apply le_INR.
-Apply fact_growing.
-Apply le_n_Sn.
-Replace ``/(INR (fact n0))*/(INR (fact (minus N n0)))`` with ``(C N n0)/(INR (fact N))``.
-Pattern 1 N; Rewrite H4.
-Apply Rle_trans with ``(C N N0)/(INR (fact N))``.
-Unfold Rdiv; Do 2 Rewrite <- (Rmult_sym ``/(INR (fact N))``).
-Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Rewrite H4.
-Apply C_maj.
-Rewrite <- H4; Apply le_trans with (pred (minus N n)).
-Apply H1.
-Apply le_S_n.
-Replace (S (pred (minus N n))) with (minus N n).
-Apply le_trans with N.
-Apply simpl_le_plus_l with n.
-Rewrite <- le_plus_minus.
-Apply le_plus_r.
-Apply le_trans with (pred N).
-Apply H0.
-Apply le_pred_n.
-Apply le_n_Sn.
-Apply S_pred with O.
-Apply simpl_lt_plus_l with n.
-Rewrite <- le_plus_minus.
-Replace (plus n (0)) with n; [Idtac | Ring].
-Apply le_lt_trans with (pred N).
-Apply H0.
-Apply lt_pred_n_n.
-Apply H.
-Apply le_trans with (pred N).
-Apply H0.
-Apply le_pred_n.
-Replace ``(C N N0)/(INR (fact N))`` with ``/(Rsqr (INR (fact N0)))``.
-Rewrite H4; Rewrite div2_S_double; Right; Reflexivity.
-Unfold Rsqr C Rdiv.
-Repeat Rewrite Rinv_Rmult.
-Rewrite (Rmult_sym (INR (fact N))).
-Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Replace (minus N N0) with N0.
-Ring.
-Replace N with (plus N0 N0).
-Symmetry; Apply minus_plus.
-Rewrite H4.
-Apply INR_eq; Rewrite plus_INR; Rewrite mult_INR; Do 2 Rewrite S_INR; Ring.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Unfold C Rdiv.
-Rewrite (Rmult_sym (INR (fact N))).
-Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_r_sym.
-Rewrite Rinv_Rmult.
-Rewrite Rmult_1r; Ring.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Replace ``/(INR (fact (S n0)))*/(INR (fact (minus N n0)))`` with ``(C (S N) (S n0))/(INR (fact (S N)))``.
-Apply Rle_trans with ``(C (S N) (S N0))/(INR (fact (S N)))``.
-Unfold Rdiv; Do 2 Rewrite <- (Rmult_sym ``/(INR (fact (S N)))``).
-Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Cut (S N) = (mult (2) (S N0)).
-Intro; Rewrite H5; Apply C_maj.
-Rewrite <- H5; Apply le_n_S.
-Apply le_trans with (pred (minus N n)).
-Apply H1.
-Apply le_S_n.
-Replace (S (pred (minus N n))) with (minus N n).
-Apply le_trans with N.
-Apply simpl_le_plus_l with n.
-Rewrite <- le_plus_minus.
-Apply le_plus_r.
-Apply le_trans with (pred N).
-Apply H0.
-Apply le_pred_n.
-Apply le_n_Sn.
-Apply S_pred with O.
-Apply simpl_lt_plus_l with n.
-Rewrite <- le_plus_minus.
-Replace (plus n (0)) with n; [Idtac | Ring].
-Apply le_lt_trans with (pred N).
-Apply H0.
-Apply lt_pred_n_n.
-Apply H.
-Apply le_trans with (pred N).
-Apply H0.
-Apply le_pred_n.
-Apply INR_eq; Rewrite H4.
-Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Cut (S N) = (mult (2) (S N0)).
-Intro.
-Replace ``(C (S N) (S N0))/(INR (fact (S N)))`` with ``/(Rsqr (INR (fact (S N0))))``.
-Rewrite H5; Rewrite div2_double.
-Right; Reflexivity.
-Unfold Rsqr C Rdiv.
-Repeat Rewrite Rinv_Rmult.
-Replace (minus (S N) (S N0)) with (S N0).
-Rewrite (Rmult_sym (INR (fact (S N)))).
-Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Reflexivity.
-Apply INR_fact_neq_0.
-Replace (S N) with (plus (S N0) (S N0)).
-Symmetry; Apply minus_plus.
-Rewrite H5; Ring.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply INR_eq; Rewrite H4; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Unfold C Rdiv.
-Rewrite (Rmult_sym (INR (fact (S N)))).
-Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Rewrite Rinv_Rmult.
-Reflexivity.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Unfold maj_Reste_E.
-Unfold Rdiv; Rewrite (Rmult_sym ``4``).
-Rewrite Rmult_assoc.
-Apply Rle_monotony.
-Apply pow_le.
-Apply Rle_trans with R1.
-Left; Apply Rlt_R0_R1.
-Apply RmaxLess1.
-Apply Rle_trans with (sum_f_R0 [k:nat]``(INR (minus N k))*/(Rsqr (INR (fact (div2 (S N)))))`` (pred N)).
-Apply sum_Rle; Intros.
-Rewrite sum_cte.
-Replace (S (pred (minus N n))) with (minus N n).
-Right; Apply Rmult_sym.
-Apply S_pred with O.
-Apply simpl_lt_plus_l with n.
-Rewrite <- le_plus_minus.
-Replace (plus n (0)) with n; [Idtac | Ring].
-Apply le_lt_trans with (pred N).
-Apply H0.
-Apply lt_pred_n_n.
-Apply H.
-Apply le_trans with (pred N).
-Apply H0.
-Apply le_pred_n.
-Apply Rle_trans with (sum_f_R0 [k:nat]``(INR N)*/(Rsqr (INR (fact (div2 (S N)))))`` (pred N)).
-Apply sum_Rle; Intros.
-Do 2 Rewrite <- (Rmult_sym ``/(Rsqr (INR (fact (div2 (S N)))))``).
-Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Apply Rsqr_pos_lt.
-Apply INR_fact_neq_0.
-Apply le_INR.
-Apply simpl_le_plus_l with n.
-Rewrite <- le_plus_minus.
-Apply le_plus_r.
-Apply le_trans with (pred N).
-Apply H0.
-Apply le_pred_n.
-Rewrite sum_cte; Replace (S (pred N)) with N.
-Cut (div2 (S N)) = (S (div2 (pred N))).
-Intro; Rewrite H0.
-Rewrite fact_simpl; Rewrite mult_sym; Rewrite mult_INR; Rewrite Rsqr_times.
-Rewrite Rinv_Rmult.
-Rewrite (Rmult_sym (INR N)); Repeat Rewrite Rmult_assoc; Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Apply Rsqr_pos_lt; Apply INR_fact_neq_0.
-Rewrite <- H0.
-Cut ``(INR N)<=(INR (mult (S (S O)) (div2 (S N))))``.
-Intro; Apply Rle_monotony_contra with ``(Rsqr (INR (div2 (S N))))``.
-Apply Rsqr_pos_lt.
-Apply not_O_INR; Red; Intro.
-Cut (lt (1) (S N)).
-Intro; Assert H4 := (div2_not_R0 ? H3).
-Rewrite H2 in H4; Elim (lt_n_O ? H4).
-Apply lt_n_S; Apply H.
-Repeat Rewrite <- Rmult_assoc.
-Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1l.
-Replace ``(INR N)*(INR N)`` with (Rsqr (INR N)); [Idtac | Reflexivity].
-Rewrite Rmult_assoc.
-Rewrite Rmult_sym.
-Replace ``4`` with (Rsqr ``2``); [Idtac | SqRing].
-Rewrite <- Rsqr_times.
-Apply Rsqr_incr_1.
-Replace ``2`` with (INR (2)).
-Rewrite <- mult_INR; Apply H1.
-Reflexivity.
-Left; Apply lt_INR_0; Apply H.
-Left; Apply Rmult_lt_pos.
-Sup0.
-Apply lt_INR_0; Apply div2_not_R0.
-Apply lt_n_S; Apply H.
-Cut (lt (1) (S N)).
-Intro; Unfold Rsqr; Apply prod_neq_R0; Apply not_O_INR; Intro; Assert H4 := (div2_not_R0 ? H2); Rewrite H3 in H4; Elim (lt_n_O ? H4).
-Apply lt_n_S; Apply H.
-Assert H1 := (even_odd_cor N).
-Elim H1; Intros N0 H2.
-Elim H2; Intro.
-Pattern 2 N; Rewrite H3.
-Rewrite div2_S_double.
-Right; Rewrite H3; Reflexivity.
-Pattern 2 N; Rewrite H3.
-Replace (S (S (mult (2) N0))) with (mult (2) (S N0)).
-Rewrite div2_double.
-Rewrite H3.
-Rewrite S_INR; Do 2 Rewrite mult_INR.
-Rewrite (S_INR N0).
-Rewrite Rmult_Rplus_distr.
-Apply Rle_compatibility.
-Rewrite Rmult_1r.
-Simpl.
-Pattern 1 R1; Rewrite <- Rplus_Or; Apply Rle_compatibility; Left; Apply Rlt_R0_R1.
-Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Unfold Rsqr; Apply prod_neq_R0; Apply INR_fact_neq_0.
-Unfold Rsqr; Apply prod_neq_R0; Apply not_O_INR; Discriminate.
-Assert H0 := (even_odd_cor N).
-Elim H0; Intros N0 H1.
-Elim H1; Intro.
-Cut (lt O N0).
-Intro; Rewrite H2.
-Rewrite div2_S_double.
-Replace (mult (2) N0) with (S (S (mult (2) (pred N0)))).
-Replace (pred (S (S (mult (2) (pred N0))))) with (S (mult (2) (pred N0))).
-Rewrite div2_S_double.
-Apply S_pred with O; Apply H3.
-Reflexivity.
-Replace N0 with (S (pred N0)).
-Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Symmetry; Apply S_pred with O; Apply H3.
-Rewrite H2 in H.
-Apply neq_O_lt.
-Red; Intro.
-Rewrite <- H3 in H.
-Simpl in H.
-Elim (lt_n_O ? H).
-Rewrite H2.
-Replace (pred (S (mult (2) N0))) with (mult (2) N0); [Idtac | Reflexivity].
-Replace (S (S (mult (2) N0))) with (mult (2) (S N0)).
-Do 2 Rewrite div2_double.
-Reflexivity.
-Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Apply S_pred with O; Apply H.
+Lemma Reste_E_maj :
+ forall (x y:R) (N:nat),
+ (0 < N)%nat -> Rabs (Reste_E x y N) <= maj_Reste_E x y N.
+intros; pose (M := Rmax 1 (Rmax (Rabs x) (Rabs y))).
+apply Rle_trans with
+ (M ^ (2 * N) *
+ sum_f_R0
+ (fun k:nat =>
+ sum_f_R0 (fun l:nat => / Rsqr (INR (fact (div2 (S N)))))
+ (pred (N - k))) (pred N)).
+unfold Reste_E in |- *.
+apply Rle_trans with
+ (sum_f_R0
+ (fun k:nat =>
+ Rabs
+ (sum_f_R0
+ (fun l:nat =>
+ / INR (fact (S (l + k))) * x ^ S (l + k) *
+ (/ INR (fact (N - l)) * y ^ (N - l))) (
+ pred (N - k)))) (pred N)).
+apply
+ (Rsum_abs
+ (fun k:nat =>
+ sum_f_R0
+ (fun l:nat =>
+ / INR (fact (S (l + k))) * x ^ S (l + k) *
+ (/ INR (fact (N - l)) * y ^ (N - l))) (
+ pred (N - k))) (pred N)).
+apply Rle_trans with
+ (sum_f_R0
+ (fun k:nat =>
+ sum_f_R0
+ (fun l:nat =>
+ Rabs
+ (/ INR (fact (S (l + k))) * x ^ S (l + k) *
+ (/ INR (fact (N - l)) * y ^ (N - l)))) (
+ pred (N - k))) (pred N)).
+apply sum_Rle; intros.
+apply
+ (Rsum_abs
+ (fun l:nat =>
+ / INR (fact (S (l + n))) * x ^ S (l + n) *
+ (/ INR (fact (N - l)) * y ^ (N - l)))).
+apply Rle_trans with
+ (sum_f_R0
+ (fun k:nat =>
+ sum_f_R0
+ (fun l:nat =>
+ M ^ (2 * N) * / INR (fact (S l)) * / INR (fact (N - l)))
+ (pred (N - k))) (pred N)).
+apply sum_Rle; intros.
+apply sum_Rle; intros.
+repeat rewrite Rabs_mult.
+do 2 rewrite <- RPow_abs.
+rewrite (Rabs_right (/ INR (fact (S (n0 + n))))).
+rewrite (Rabs_right (/ INR (fact (N - n0)))).
+replace
+ (/ INR (fact (S (n0 + n))) * Rabs x ^ S (n0 + n) *
+ (/ INR (fact (N - n0)) * Rabs y ^ (N - n0))) with
+ (/ INR (fact (N - n0)) * / INR (fact (S (n0 + n))) * Rabs x ^ S (n0 + n) *
+ Rabs y ^ (N - n0)); [ idtac | ring ].
+rewrite <- (Rmult_comm (/ INR (fact (N - n0)))).
+repeat rewrite Rmult_assoc.
+apply Rmult_le_compat_l.
+left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+apply Rle_trans with
+ (/ INR (fact (S n0)) * Rabs x ^ S (n0 + n) * Rabs y ^ (N - n0)).
+rewrite (Rmult_comm (/ INR (fact (S (n0 + n)))));
+ rewrite (Rmult_comm (/ INR (fact (S n0)))); repeat rewrite Rmult_assoc;
+ apply Rmult_le_compat_l.
+apply pow_le; apply Rabs_pos.
+rewrite (Rmult_comm (/ INR (fact (S n0)))); apply Rmult_le_compat_l.
+apply pow_le; apply Rabs_pos.
+apply Rle_Rinv.
+apply INR_fact_lt_0.
+apply INR_fact_lt_0.
+apply le_INR; apply fact_le; apply le_n_S.
+apply le_plus_l.
+rewrite (Rmult_comm (M ^ (2 * N))); rewrite Rmult_assoc;
+ apply Rmult_le_compat_l.
+left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+apply Rle_trans with (M ^ S (n0 + n) * Rabs y ^ (N - n0)).
+do 2 rewrite <- (Rmult_comm (Rabs y ^ (N - n0))).
+apply Rmult_le_compat_l.
+apply pow_le; apply Rabs_pos.
+apply pow_incr; split.
+apply Rabs_pos.
+apply Rle_trans with (Rmax (Rabs x) (Rabs y)).
+apply RmaxLess1.
+unfold M in |- *; apply RmaxLess2.
+apply Rle_trans with (M ^ S (n0 + n) * M ^ (N - n0)).
+apply Rmult_le_compat_l.
+apply pow_le; apply Rle_trans with 1.
+left; apply Rlt_0_1.
+unfold M in |- *; apply RmaxLess1.
+apply pow_incr; split.
+apply Rabs_pos.
+apply Rle_trans with (Rmax (Rabs x) (Rabs y)).
+apply RmaxLess2.
+unfold M in |- *; apply RmaxLess2.
+rewrite <- pow_add; replace (S (n0 + n) + (N - n0))%nat with (N + S n)%nat.
+apply Rle_pow.
+unfold M in |- *; apply RmaxLess1.
+replace (2 * N)%nat with (N + N)%nat; [ idtac | ring ].
+apply plus_le_compat_l.
+replace N with (S (pred N)).
+apply le_n_S; apply H0.
+symmetry in |- *; apply S_pred with 0%nat; apply H.
+apply INR_eq; do 2 rewrite plus_INR; do 2 rewrite S_INR; rewrite plus_INR;
+ rewrite minus_INR.
+ring.
+apply le_trans with (pred (N - n)).
+apply H1.
+apply le_S_n.
+replace (S (pred (N - n))) with (N - n)%nat.
+apply le_trans with N.
+apply (fun p n m:nat => plus_le_reg_l n m p) with n.
+rewrite <- le_plus_minus.
+apply le_plus_r.
+apply le_trans with (pred N).
+apply H0.
+apply le_pred_n.
+apply le_n_Sn.
+apply S_pred with 0%nat.
+apply plus_lt_reg_l with n.
+rewrite <- le_plus_minus.
+replace (n + 0)%nat with n; [ idtac | ring ].
+apply le_lt_trans with (pred N).
+apply H0.
+apply lt_pred_n_n.
+apply H.
+apply le_trans with (pred N).
+apply H0.
+apply le_pred_n.
+apply Rle_ge; left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+apply Rle_ge; left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+rewrite scal_sum.
+apply sum_Rle; intros.
+rewrite <- Rmult_comm.
+rewrite scal_sum.
+apply sum_Rle; intros.
+rewrite (Rmult_comm (/ Rsqr (INR (fact (div2 (S N)))))).
+rewrite Rmult_assoc; apply Rmult_le_compat_l.
+apply pow_le.
+apply Rle_trans with 1.
+left; apply Rlt_0_1.
+unfold M in |- *; apply RmaxLess1.
+assert (H2 := even_odd_cor N).
+elim H2; intros N0 H3.
+elim H3; intro.
+apply Rle_trans with (/ INR (fact n0) * / INR (fact (N - n0))).
+do 2 rewrite <- (Rmult_comm (/ INR (fact (N - n0)))).
+apply Rmult_le_compat_l.
+left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+apply Rle_Rinv.
+apply INR_fact_lt_0.
+apply INR_fact_lt_0.
+apply le_INR.
+apply fact_le.
+apply le_n_Sn.
+replace (/ INR (fact n0) * / INR (fact (N - n0))) with
+ (C N n0 / INR (fact N)).
+pattern N at 1 in |- *; rewrite H4.
+apply Rle_trans with (C N N0 / INR (fact N)).
+unfold Rdiv in |- *; do 2 rewrite <- (Rmult_comm (/ INR (fact N))).
+apply Rmult_le_compat_l.
+left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+rewrite H4.
+apply C_maj.
+rewrite <- H4; apply le_trans with (pred (N - n)).
+apply H1.
+apply le_S_n.
+replace (S (pred (N - n))) with (N - n)%nat.
+apply le_trans with N.
+apply (fun p n m:nat => plus_le_reg_l n m p) with n.
+rewrite <- le_plus_minus.
+apply le_plus_r.
+apply le_trans with (pred N).
+apply H0.
+apply le_pred_n.
+apply le_n_Sn.
+apply S_pred with 0%nat.
+apply plus_lt_reg_l with n.
+rewrite <- le_plus_minus.
+replace (n + 0)%nat with n; [ idtac | ring ].
+apply le_lt_trans with (pred N).
+apply H0.
+apply lt_pred_n_n.
+apply H.
+apply le_trans with (pred N).
+apply H0.
+apply le_pred_n.
+replace (C N N0 / INR (fact N)) with (/ Rsqr (INR (fact N0))).
+rewrite H4; rewrite div2_S_double; right; reflexivity.
+unfold Rsqr, C, Rdiv in |- *.
+repeat rewrite Rinv_mult_distr.
+rewrite (Rmult_comm (INR (fact N))).
+repeat rewrite Rmult_assoc.
+rewrite <- Rinv_r_sym.
+rewrite Rmult_1_r; replace (N - N0)%nat with N0.
+ring.
+replace N with (N0 + N0)%nat.
+symmetry in |- *; apply minus_plus.
+rewrite H4.
+apply INR_eq; rewrite plus_INR; rewrite mult_INR; do 2 rewrite S_INR; ring.
+apply INR_fact_neq_0.
+apply INR_fact_neq_0.
+apply INR_fact_neq_0.
+apply INR_fact_neq_0.
+apply INR_fact_neq_0.
+unfold C, Rdiv in |- *.
+rewrite (Rmult_comm (INR (fact N))).
+repeat rewrite Rmult_assoc.
+rewrite <- Rinv_r_sym.
+rewrite Rinv_mult_distr.
+rewrite Rmult_1_r; ring.
+apply INR_fact_neq_0.
+apply INR_fact_neq_0.
+apply INR_fact_neq_0.
+replace (/ INR (fact (S n0)) * / INR (fact (N - n0))) with
+ (C (S N) (S n0) / INR (fact (S N))).
+apply Rle_trans with (C (S N) (S N0) / INR (fact (S N))).
+unfold Rdiv in |- *; do 2 rewrite <- (Rmult_comm (/ INR (fact (S N)))).
+apply Rmult_le_compat_l.
+left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+cut (S N = (2 * S N0)%nat).
+intro; rewrite H5; apply C_maj.
+rewrite <- H5; apply le_n_S.
+apply le_trans with (pred (N - n)).
+apply H1.
+apply le_S_n.
+replace (S (pred (N - n))) with (N - n)%nat.
+apply le_trans with N.
+apply (fun p n m:nat => plus_le_reg_l n m p) with n.
+rewrite <- le_plus_minus.
+apply le_plus_r.
+apply le_trans with (pred N).
+apply H0.
+apply le_pred_n.
+apply le_n_Sn.
+apply S_pred with 0%nat.
+apply plus_lt_reg_l with n.
+rewrite <- le_plus_minus.
+replace (n + 0)%nat with n; [ idtac | ring ].
+apply le_lt_trans with (pred N).
+apply H0.
+apply lt_pred_n_n.
+apply H.
+apply le_trans with (pred N).
+apply H0.
+apply le_pred_n.
+apply INR_eq; rewrite H4.
+do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; ring.
+cut (S N = (2 * S N0)%nat).
+intro.
+replace (C (S N) (S N0) / INR (fact (S N))) with (/ Rsqr (INR (fact (S N0)))).
+rewrite H5; rewrite div2_double.
+right; reflexivity.
+unfold Rsqr, C, Rdiv in |- *.
+repeat rewrite Rinv_mult_distr.
+replace (S N - S N0)%nat with (S N0).
+rewrite (Rmult_comm (INR (fact (S N)))).
+repeat rewrite Rmult_assoc.
+rewrite <- Rinv_r_sym.
+rewrite Rmult_1_r; reflexivity.
+apply INR_fact_neq_0.
+replace (S N) with (S N0 + S N0)%nat.
+symmetry in |- *; apply minus_plus.
+rewrite H5; ring.
+apply INR_fact_neq_0.
+apply INR_fact_neq_0.
+apply INR_fact_neq_0.
+apply INR_fact_neq_0.
+apply INR_eq; rewrite H4; do 2 rewrite S_INR; do 2 rewrite mult_INR;
+ repeat rewrite S_INR; ring.
+unfold C, Rdiv in |- *.
+rewrite (Rmult_comm (INR (fact (S N)))).
+rewrite Rmult_assoc; rewrite <- Rinv_r_sym.
+rewrite Rmult_1_r; rewrite Rinv_mult_distr.
+reflexivity.
+apply INR_fact_neq_0.
+apply INR_fact_neq_0.
+apply INR_fact_neq_0.
+unfold maj_Reste_E in |- *.
+unfold Rdiv in |- *; rewrite (Rmult_comm 4).
+rewrite Rmult_assoc.
+apply Rmult_le_compat_l.
+apply pow_le.
+apply Rle_trans with 1.
+left; apply Rlt_0_1.
+apply RmaxLess1.
+apply Rle_trans with
+ (sum_f_R0 (fun k:nat => INR (N - k) * / Rsqr (INR (fact (div2 (S N)))))
+ (pred N)).
+apply sum_Rle; intros.
+rewrite sum_cte.
+replace (S (pred (N - n))) with (N - n)%nat.
+right; apply Rmult_comm.
+apply S_pred with 0%nat.
+apply plus_lt_reg_l with n.
+rewrite <- le_plus_minus.
+replace (n + 0)%nat with n; [ idtac | ring ].
+apply le_lt_trans with (pred N).
+apply H0.
+apply lt_pred_n_n.
+apply H.
+apply le_trans with (pred N).
+apply H0.
+apply le_pred_n.
+apply Rle_trans with
+ (sum_f_R0 (fun k:nat => INR N * / Rsqr (INR (fact (div2 (S N))))) (pred N)).
+apply sum_Rle; intros.
+do 2 rewrite <- (Rmult_comm (/ Rsqr (INR (fact (div2 (S N)))))).
+apply Rmult_le_compat_l.
+left; apply Rinv_0_lt_compat; apply Rsqr_pos_lt.
+apply INR_fact_neq_0.
+apply le_INR.
+apply (fun p n m:nat => plus_le_reg_l n m p) with n.
+rewrite <- le_plus_minus.
+apply le_plus_r.
+apply le_trans with (pred N).
+apply H0.
+apply le_pred_n.
+rewrite sum_cte; replace (S (pred N)) with N.
+cut (div2 (S N) = S (div2 (pred N))).
+intro; rewrite H0.
+rewrite fact_simpl; rewrite mult_comm; rewrite mult_INR; rewrite Rsqr_mult.
+rewrite Rinv_mult_distr.
+rewrite (Rmult_comm (INR N)); repeat rewrite Rmult_assoc;
+ apply Rmult_le_compat_l.
+left; apply Rinv_0_lt_compat; apply Rsqr_pos_lt; apply INR_fact_neq_0.
+rewrite <- H0.
+cut (INR N <= INR (2 * div2 (S N))).
+intro; apply Rmult_le_reg_l with (Rsqr (INR (div2 (S N)))).
+apply Rsqr_pos_lt.
+apply not_O_INR; red in |- *; intro.
+cut (1 < S N)%nat.
+intro; assert (H4 := div2_not_R0 _ H3).
+rewrite H2 in H4; elim (lt_n_O _ H4).
+apply lt_n_S; apply H.
+repeat rewrite <- Rmult_assoc.
+rewrite <- Rinv_r_sym.
+rewrite Rmult_1_l.
+replace (INR N * INR N) with (Rsqr (INR N)); [ idtac | reflexivity ].
+rewrite Rmult_assoc.
+rewrite Rmult_comm.
+replace 4 with (Rsqr 2); [ idtac | ring_Rsqr ].
+rewrite <- Rsqr_mult.
+apply Rsqr_incr_1.
+replace 2 with (INR 2).
+rewrite <- mult_INR; apply H1.
+reflexivity.
+left; apply lt_INR_0; apply H.
+left; apply Rmult_lt_0_compat.
+prove_sup0.
+apply lt_INR_0; apply div2_not_R0.
+apply lt_n_S; apply H.
+cut (1 < S N)%nat.
+intro; unfold Rsqr in |- *; apply prod_neq_R0; apply not_O_INR; intro;
+ assert (H4 := div2_not_R0 _ H2); rewrite H3 in H4;
+ elim (lt_n_O _ H4).
+apply lt_n_S; apply H.
+assert (H1 := even_odd_cor N).
+elim H1; intros N0 H2.
+elim H2; intro.
+pattern N at 2 in |- *; rewrite H3.
+rewrite div2_S_double.
+right; rewrite H3; reflexivity.
+pattern N at 2 in |- *; rewrite H3.
+replace (S (S (2 * N0))) with (2 * S N0)%nat.
+rewrite div2_double.
+rewrite H3.
+rewrite S_INR; do 2 rewrite mult_INR.
+rewrite (S_INR N0).
+rewrite Rmult_plus_distr_l.
+apply Rplus_le_compat_l.
+rewrite Rmult_1_r.
+simpl in |- *.
+pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left;
+ apply Rlt_0_1.
+apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR;
+ ring.
+unfold Rsqr in |- *; apply prod_neq_R0; apply INR_fact_neq_0.
+unfold Rsqr in |- *; apply prod_neq_R0; apply not_O_INR; discriminate.
+assert (H0 := even_odd_cor N).
+elim H0; intros N0 H1.
+elim H1; intro.
+cut (0 < N0)%nat.
+intro; rewrite H2.
+rewrite div2_S_double.
+replace (2 * N0)%nat with (S (S (2 * pred N0))).
+replace (pred (S (S (2 * pred N0)))) with (S (2 * pred N0)).
+rewrite div2_S_double.
+apply S_pred with 0%nat; apply H3.
+reflexivity.
+replace N0 with (S (pred N0)).
+apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR;
+ ring.
+symmetry in |- *; apply S_pred with 0%nat; apply H3.
+rewrite H2 in H.
+apply neq_O_lt.
+red in |- *; intro.
+rewrite <- H3 in H.
+simpl in H.
+elim (lt_n_O _ H).
+rewrite H2.
+replace (pred (S (2 * N0))) with (2 * N0)%nat; [ idtac | reflexivity ].
+replace (S (S (2 * N0))) with (2 * S N0)%nat.
+do 2 rewrite div2_double.
+reflexivity.
+apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR;
+ ring.
+apply S_pred with 0%nat; apply H.
Qed.
-Lemma maj_Reste_cv_R0 : (x,y:R) (Un_cv (maj_Reste_E x y) ``0``).
-Intros; Assert H := (Majxy_cv_R0 x y).
-Unfold Un_cv in H; Unfold Un_cv; Intros.
-Cut ``0<eps/4``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]].
-Elim (H ? H1); Intros N0 H2.
-Exists (max (mult (2) (S N0)) (2)); Intros.
-Unfold R_dist in H2; Unfold R_dist; Rewrite minus_R0; Unfold Majxy in H2; Unfold maj_Reste_E.
-Rewrite Rabsolu_right.
-Apply Rle_lt_trans with ``4*(pow (Rmax 1 (Rmax (Rabsolu x) (Rabsolu y))) (mult (S (S (S (S O)))) (S (div2 (pred n)))))/(INR (fact (div2 (pred n))))``.
-Apply Rle_monotony.
-Left; Sup0.
-Unfold Rdiv Rsqr; Rewrite Rinv_Rmult.
-Rewrite (Rmult_sym ``(pow (Rmax 1 (Rmax (Rabsolu x) (Rabsolu y))) (mult (S (S O)) n))``); Rewrite (Rmult_sym ``(pow (Rmax 1 (Rmax (Rabsolu x) (Rabsolu y))) (mult (S (S (S (S O)))) (S (div2 (pred n)))))``); Rewrite Rmult_assoc; Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Apply Rle_trans with ``(pow (Rmax 1 (Rmax (Rabsolu x) (Rabsolu y))) (mult (S (S O)) n))``.
-Rewrite Rmult_sym; Pattern 2 (pow (Rmax R1 (Rmax (Rabsolu x) (Rabsolu y))) (mult (2) n)); Rewrite <- Rmult_1r; Apply Rle_monotony.
-Apply pow_le; Apply Rle_trans with R1.
-Left; Apply Rlt_R0_R1.
-Apply RmaxLess1.
-Apply Rle_monotony_contra with ``(INR (fact (div2 (pred n))))``.
-Apply INR_fact_lt_0.
-Rewrite Rmult_1r; Rewrite <- Rinv_r_sym.
-Replace R1 with (INR (1)); [Apply le_INR | Reflexivity].
-Apply lt_le_S.
-Apply INR_lt.
-Apply INR_fact_lt_0.
-Apply INR_fact_neq_0.
-Apply Rle_pow.
-Apply RmaxLess1.
-Assert H4 := (even_odd_cor n).
-Elim H4; Intros N1 H5.
-Elim H5; Intro.
-Cut (lt O N1).
-Intro.
-Rewrite H6.
-Replace (pred (mult (2) N1)) with (S (mult (2) (pred N1))).
-Rewrite div2_S_double.
-Replace (S (pred N1)) with N1.
-Apply INR_le.
-Right.
-Do 3 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Apply S_pred with O; Apply H7.
-Replace (mult (2) N1) with (S (S (mult (2) (pred N1)))).
-Reflexivity.
-Pattern 2 N1; Replace N1 with (S (pred N1)).
-Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Symmetry ; Apply S_pred with O; Apply H7.
-Apply INR_lt.
-Apply Rlt_monotony_contra with (INR (2)).
-Simpl; Sup0.
-Rewrite Rmult_Or; Rewrite <- mult_INR.
-Apply lt_INR_0.
-Rewrite <- H6.
-Apply lt_le_trans with (2).
-Apply lt_O_Sn.
-Apply le_trans with (max (mult (2) (S N0)) (2)).
-Apply le_max_r.
-Apply H3.
-Rewrite H6.
-Replace (pred (S (mult (2) N1))) with (mult (2) N1).
-Rewrite div2_double.
-Replace (mult (4) (S N1)) with (mult (2) (mult (2) (S N1))).
-Apply mult_le.
-Replace (mult (2) (S N1)) with (S (S (mult (2) N1))).
-Apply le_n_Sn.
-Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Ring.
-Reflexivity.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply Rlt_monotony_contra with ``/4``.
-Apply Rlt_Rinv; Sup0.
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l; Rewrite Rmult_sym.
-Replace ``(pow (Rmax 1 (Rmax (Rabsolu x) (Rabsolu y))) (mult (S (S (S (S O)))) (S (div2 (pred n)))))/(INR (fact (div2 (pred n))))`` with ``(Rabsolu ((pow (Rmax 1 (Rmax (Rabsolu x) (Rabsolu y))) (mult (S (S (S (S O)))) (S (div2 (pred n)))))/(INR (fact (div2 (pred n))))-0))``.
-Apply H2; Unfold ge.
-Cut (le (mult (2) (S N0)) n).
-Intro; Apply le_S_n.
-Apply INR_le; Apply Rle_monotony_contra with (INR (2)).
-Simpl; Sup0.
-Do 2 Rewrite <- mult_INR; Apply le_INR.
-Apply le_trans with n.
-Apply H4.
-Assert H5 := (even_odd_cor n).
-Elim H5; Intros N1 H6.
-Elim H6; Intro.
-Cut (lt O N1).
-Intro.
-Rewrite H7.
-Apply mult_le.
-Replace (pred (mult (2) N1)) with (S (mult (2) (pred N1))).
-Rewrite div2_S_double.
-Replace (S (pred N1)) with N1.
-Apply le_n.
-Apply S_pred with O; Apply H8.
-Replace (mult (2) N1) with (S (S (mult (2) (pred N1)))).
-Reflexivity.
-Pattern 2 N1; Replace N1 with (S (pred N1)).
-Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Symmetry; Apply S_pred with O; Apply H8.
-Apply INR_lt.
-Apply Rlt_monotony_contra with (INR (2)).
-Simpl; Sup0.
-Rewrite Rmult_Or; Rewrite <- mult_INR.
-Apply lt_INR_0.
-Rewrite <- H7.
-Apply lt_le_trans with (2).
-Apply lt_O_Sn.
-Apply le_trans with (max (mult (2) (S N0)) (2)).
-Apply le_max_r.
-Apply H3.
-Rewrite H7.
-Replace (pred (S (mult (2) N1))) with (mult (2) N1).
-Rewrite div2_double.
-Replace (mult (2) (S N1)) with (S (S (mult (2) N1))).
-Apply le_n_Sn.
-Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Reflexivity.
-Apply le_trans with (max (mult (2) (S N0)) (2)).
-Apply le_max_l.
-Apply H3.
-Rewrite minus_R0; Apply Rabsolu_right.
-Apply Rle_sym1.
-Unfold Rdiv; Repeat Apply Rmult_le_pos.
-Apply pow_le.
-Apply Rle_trans with R1.
-Left; Apply Rlt_R0_R1.
-Apply RmaxLess1.
-Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-DiscrR.
-Apply Rle_sym1.
-Unfold Rdiv; Apply Rmult_le_pos.
-Left; Sup0.
-Apply Rmult_le_pos.
-Apply pow_le.
-Apply Rle_trans with R1.
-Left; Apply Rlt_R0_R1.
-Apply RmaxLess1.
-Left; Apply Rlt_Rinv; Apply Rsqr_pos_lt; Apply INR_fact_neq_0.
+Lemma maj_Reste_cv_R0 : forall x y:R, Un_cv (maj_Reste_E x y) 0.
+intros; assert (H := Majxy_cv_R0 x y).
+unfold Un_cv in H; unfold Un_cv in |- *; intros.
+cut (0 < eps / 4);
+ [ intro
+ | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ].
+elim (H _ H1); intros N0 H2.
+exists (max (2 * S N0) 2); intros.
+unfold R_dist in H2; unfold R_dist in |- *; rewrite Rminus_0_r;
+ unfold Majxy in H2; unfold maj_Reste_E in |- *.
+rewrite Rabs_right.
+apply Rle_lt_trans with
+ (4 *
+ (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (4 * S (div2 (pred n))) /
+ INR (fact (div2 (pred n))))).
+apply Rmult_le_compat_l.
+left; prove_sup0.
+unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr.
+rewrite (Rmult_comm (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (2 * n)));
+ rewrite
+ (Rmult_comm (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (4 * S (div2 (pred n)))))
+ ; rewrite Rmult_assoc; apply Rmult_le_compat_l.
+left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+apply Rle_trans with (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (2 * n)).
+rewrite Rmult_comm;
+ pattern (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (2 * n)) at 2 in |- *;
+ rewrite <- Rmult_1_r; apply Rmult_le_compat_l.
+apply pow_le; apply Rle_trans with 1.
+left; apply Rlt_0_1.
+apply RmaxLess1.
+apply Rmult_le_reg_l with (INR (fact (div2 (pred n)))).
+apply INR_fact_lt_0.
+rewrite Rmult_1_r; rewrite <- Rinv_r_sym.
+replace 1 with (INR 1); [ apply le_INR | reflexivity ].
+apply lt_le_S.
+apply INR_lt.
+apply INR_fact_lt_0.
+apply INR_fact_neq_0.
+apply Rle_pow.
+apply RmaxLess1.
+assert (H4 := even_odd_cor n).
+elim H4; intros N1 H5.
+elim H5; intro.
+cut (0 < N1)%nat.
+intro.
+rewrite H6.
+replace (pred (2 * N1)) with (S (2 * pred N1)).
+rewrite div2_S_double.
+replace (S (pred N1)) with N1.
+apply INR_le.
+right.
+do 3 rewrite mult_INR; repeat rewrite S_INR; ring.
+apply S_pred with 0%nat; apply H7.
+replace (2 * N1)%nat with (S (S (2 * pred N1))).
+reflexivity.
+pattern N1 at 2 in |- *; replace N1 with (S (pred N1)).
+apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR;
+ ring.
+symmetry in |- *; apply S_pred with 0%nat; apply H7.
+apply INR_lt.
+apply Rmult_lt_reg_l with (INR 2).
+simpl in |- *; prove_sup0.
+rewrite Rmult_0_r; rewrite <- mult_INR.
+apply lt_INR_0.
+rewrite <- H6.
+apply lt_le_trans with 2%nat.
+apply lt_O_Sn.
+apply le_trans with (max (2 * S N0) 2).
+apply le_max_r.
+apply H3.
+rewrite H6.
+replace (pred (S (2 * N1))) with (2 * N1)%nat.
+rewrite div2_double.
+replace (4 * S N1)%nat with (2 * (2 * S N1))%nat.
+apply (fun m n p:nat => mult_le_compat_l p n m).
+replace (2 * S N1)%nat with (S (S (2 * N1))).
+apply le_n_Sn.
+apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR;
+ ring.
+ring.
+reflexivity.
+apply INR_fact_neq_0.
+apply INR_fact_neq_0.
+apply Rmult_lt_reg_l with (/ 4).
+apply Rinv_0_lt_compat; prove_sup0.
+rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
+rewrite Rmult_1_l; rewrite Rmult_comm.
+replace
+ (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (4 * S (div2 (pred n))) /
+ INR (fact (div2 (pred n)))) with
+ (Rabs
+ (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (4 * S (div2 (pred n))) /
+ INR (fact (div2 (pred n))) - 0)).
+apply H2; unfold ge in |- *.
+cut (2 * S N0 <= n)%nat.
+intro; apply le_S_n.
+apply INR_le; apply Rmult_le_reg_l with (INR 2).
+simpl in |- *; prove_sup0.
+do 2 rewrite <- mult_INR; apply le_INR.
+apply le_trans with n.
+apply H4.
+assert (H5 := even_odd_cor n).
+elim H5; intros N1 H6.
+elim H6; intro.
+cut (0 < N1)%nat.
+intro.
+rewrite H7.
+apply (fun m n p:nat => mult_le_compat_l p n m).
+replace (pred (2 * N1)) with (S (2 * pred N1)).
+rewrite div2_S_double.
+replace (S (pred N1)) with N1.
+apply le_n.
+apply S_pred with 0%nat; apply H8.
+replace (2 * N1)%nat with (S (S (2 * pred N1))).
+reflexivity.
+pattern N1 at 2 in |- *; replace N1 with (S (pred N1)).
+apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR;
+ ring.
+symmetry in |- *; apply S_pred with 0%nat; apply H8.
+apply INR_lt.
+apply Rmult_lt_reg_l with (INR 2).
+simpl in |- *; prove_sup0.
+rewrite Rmult_0_r; rewrite <- mult_INR.
+apply lt_INR_0.
+rewrite <- H7.
+apply lt_le_trans with 2%nat.
+apply lt_O_Sn.
+apply le_trans with (max (2 * S N0) 2).
+apply le_max_r.
+apply H3.
+rewrite H7.
+replace (pred (S (2 * N1))) with (2 * N1)%nat.
+rewrite div2_double.
+replace (2 * S N1)%nat with (S (S (2 * N1))).
+apply le_n_Sn.
+apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR;
+ ring.
+reflexivity.
+apply le_trans with (max (2 * S N0) 2).
+apply le_max_l.
+apply H3.
+rewrite Rminus_0_r; apply Rabs_right.
+apply Rle_ge.
+unfold Rdiv in |- *; repeat apply Rmult_le_pos.
+apply pow_le.
+apply Rle_trans with 1.
+left; apply Rlt_0_1.
+apply RmaxLess1.
+left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+discrR.
+apply Rle_ge.
+unfold Rdiv in |- *; apply Rmult_le_pos.
+left; prove_sup0.
+apply Rmult_le_pos.
+apply pow_le.
+apply Rle_trans with 1.
+left; apply Rlt_0_1.
+apply RmaxLess1.
+left; apply Rinv_0_lt_compat; apply Rsqr_pos_lt; apply INR_fact_neq_0.
Qed.
(**********)
-Lemma Reste_E_cv : (x,y:R) (Un_cv (Reste_E x y) R0).
-Intros; Assert H := (maj_Reste_cv_R0 x y).
-Unfold Un_cv in H; Unfold Un_cv; Intros; Elim (H ? H0); Intros.
-Exists (max x0 (1)); Intros.
-Unfold R_dist; Rewrite minus_R0.
-Apply Rle_lt_trans with (maj_Reste_E x y n).
-Apply Reste_E_maj.
-Apply lt_le_trans with (1).
-Apply lt_O_Sn.
-Apply le_trans with (max x0 (1)).
-Apply le_max_r.
-Apply H2.
-Replace (maj_Reste_E x y n) with (R_dist (maj_Reste_E x y n) R0).
-Apply H1.
-Unfold ge; Apply le_trans with (max x0 (1)).
-Apply le_max_l.
-Apply H2.
-Unfold R_dist; Rewrite minus_R0; Apply Rabsolu_right.
-Apply Rle_sym1; Apply Rle_trans with (Rabsolu (Reste_E x y n)).
-Apply Rabsolu_pos.
-Apply Reste_E_maj.
-Apply lt_le_trans with (1).
-Apply lt_O_Sn.
-Apply le_trans with (max x0 (1)).
-Apply le_max_r.
-Apply H2.
+Lemma Reste_E_cv : forall x y:R, Un_cv (Reste_E x y) 0.
+intros; assert (H := maj_Reste_cv_R0 x y).
+unfold Un_cv in H; unfold Un_cv in |- *; intros; elim (H _ H0); intros.
+exists (max x0 1); intros.
+unfold R_dist in |- *; rewrite Rminus_0_r.
+apply Rle_lt_trans with (maj_Reste_E x y n).
+apply Reste_E_maj.
+apply lt_le_trans with 1%nat.
+apply lt_O_Sn.
+apply le_trans with (max x0 1).
+apply le_max_r.
+apply H2.
+replace (maj_Reste_E x y n) with (R_dist (maj_Reste_E x y n) 0).
+apply H1.
+unfold ge in |- *; apply le_trans with (max x0 1).
+apply le_max_l.
+apply H2.
+unfold R_dist in |- *; rewrite Rminus_0_r; apply Rabs_right.
+apply Rle_ge; apply Rle_trans with (Rabs (Reste_E x y n)).
+apply Rabs_pos.
+apply Reste_E_maj.
+apply lt_le_trans with 1%nat.
+apply lt_O_Sn.
+apply le_trans with (max x0 1).
+apply le_max_r.
+apply H2.
Qed.
(**********)
-Lemma exp_plus : (x,y:R) ``(exp (x+y))==(exp x)*(exp y)``.
-Intros; Assert H0 := (E1_cvg x).
-Assert H := (E1_cvg y).
-Assert H1 := (E1_cvg ``x+y``).
-EApply UL_sequence.
-Apply H1.
-Assert H2 := (CV_mult ? ? ? ? H0 H).
-Assert H3 := (CV_minus ? ? ? ? H2 (Reste_E_cv x y)).
-Unfold Un_cv; Unfold Un_cv in H3; Intros.
-Elim (H3 ? H4); Intros.
-Exists (S x0); Intros.
-Rewrite <- (exp_form x y n).
-Rewrite minus_R0 in H5.
-Apply H5.
-Unfold ge; Apply le_trans with (S x0).
-Apply le_n_Sn.
-Apply H6.
-Apply lt_le_trans with (S x0).
-Apply lt_O_Sn.
-Apply H6.
+Lemma exp_plus : forall x y:R, exp (x + y) = exp x * exp y.
+intros; assert (H0 := E1_cvg x).
+assert (H := E1_cvg y).
+assert (H1 := E1_cvg (x + y)).
+eapply UL_sequence.
+apply H1.
+assert (H2 := CV_mult _ _ _ _ H0 H).
+assert (H3 := CV_minus _ _ _ _ H2 (Reste_E_cv x y)).
+unfold Un_cv in |- *; unfold Un_cv in H3; intros.
+elim (H3 _ H4); intros.
+exists (S x0); intros.
+rewrite <- (exp_form x y n).
+rewrite Rminus_0_r in H5.
+apply H5.
+unfold ge in |- *; apply le_trans with (S x0).
+apply le_n_Sn.
+apply H6.
+apply lt_le_trans with (S x0).
+apply lt_O_Sn.
+apply H6.
Qed.
(**********)
-Lemma exp_pos_pos : (x:R) ``0<x`` -> ``0<(exp x)``.
-Intros; Pose An := [N:nat]``/(INR (fact N))*(pow x N)``.
-Cut (Un_cv [n:nat](sum_f_R0 An n) (exp x)).
-Intro; Apply Rlt_le_trans with (sum_f_R0 An O).
-Unfold An; Simpl; Rewrite Rinv_R1; Rewrite Rmult_1r; Apply Rlt_R0_R1.
-Apply sum_incr.
-Assumption.
-Intro; Unfold An; Left; Apply Rmult_lt_pos.
-Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Apply (pow_lt ? n H).
-Unfold exp; Unfold projT1; Case (exist_exp x); Intro.
-Unfold exp_in; Unfold infinit_sum Un_cv; Trivial.
+Lemma exp_pos_pos : forall x:R, 0 < x -> 0 < exp x.
+intros; pose (An := fun N:nat => / INR (fact N) * x ^ N).
+cut (Un_cv (fun n:nat => sum_f_R0 An n) (exp x)).
+intro; apply Rlt_le_trans with (sum_f_R0 An 0).
+unfold An in |- *; simpl in |- *; rewrite Rinv_1; rewrite Rmult_1_r;
+ apply Rlt_0_1.
+apply sum_incr.
+assumption.
+intro; unfold An in |- *; left; apply Rmult_lt_0_compat.
+apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+apply (pow_lt _ n H).
+unfold exp in |- *; unfold projT1 in |- *; case (exist_exp x); intro.
+unfold exp_in in |- *; unfold infinit_sum, Un_cv in |- *; trivial.
Qed.
(**********)
-Lemma exp_pos : (x:R) ``0<(exp x)``.
-Intro; Case (total_order_T R0 x); Intro.
-Elim s; Intro.
-Apply (exp_pos_pos ? a).
-Rewrite <- b; Rewrite exp_0; Apply Rlt_R0_R1.
-Replace (exp x) with ``1/(exp (-x))``.
-Unfold Rdiv; Apply Rmult_lt_pos.
-Apply Rlt_R0_R1.
-Apply Rlt_Rinv; Apply exp_pos_pos.
-Apply (Rgt_RO_Ropp ? r).
-Cut ``(exp (-x))<>0``.
-Intro; Unfold Rdiv; Apply r_Rmult_mult with ``(exp (-x))``.
-Rewrite Rmult_1l; Rewrite <- Rinv_r_sym.
-Rewrite <- exp_plus.
-Rewrite Rplus_Ropp_l; Rewrite exp_0; Reflexivity.
-Apply H.
-Apply H.
-Assert H := (exp_plus x ``-x``).
-Rewrite Rplus_Ropp_r in H; Rewrite exp_0 in H.
-Red; Intro; Rewrite H0 in H.
-Rewrite Rmult_Or in H.
-Elim R1_neq_R0; Assumption.
+Lemma exp_pos : forall x:R, 0 < exp x.
+intro; case (total_order_T 0 x); intro.
+elim s; intro.
+apply (exp_pos_pos _ a).
+rewrite <- b; rewrite exp_0; apply Rlt_0_1.
+replace (exp x) with (1 / exp (- x)).
+unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+apply Rlt_0_1.
+apply Rinv_0_lt_compat; apply exp_pos_pos.
+apply (Ropp_0_gt_lt_contravar _ r).
+cut (exp (- x) <> 0).
+intro; unfold Rdiv in |- *; apply Rmult_eq_reg_l with (exp (- x)).
+rewrite Rmult_1_l; rewrite <- Rinv_r_sym.
+rewrite <- exp_plus.
+rewrite Rplus_opp_l; rewrite exp_0; reflexivity.
+apply H.
+apply H.
+assert (H := exp_plus x (- x)).
+rewrite Rplus_opp_r in H; rewrite exp_0 in H.
+red in |- *; intro; rewrite H0 in H.
+rewrite Rmult_0_r in H.
+elim R1_neq_R0; assumption.
Qed.
(* ((exp h)-1)/h -> 0 quand h->0 *)
-Lemma derivable_pt_lim_exp_0 : (derivable_pt_lim exp ``0`` ``1``).
-Unfold derivable_pt_lim; Intros.
-Pose fn := [N:nat][x:R]``(pow x N)/(INR (fact (S N)))``.
-Cut (CVN_R fn).
-Intro; Cut (x:R)(sigTT ? [l:R](Un_cv [N:nat](SP fn N x) l)).
-Intro cv; Cut ((n:nat)(continuity (fn n))).
-Intro; Cut (continuity (SFL fn cv)).
-Intro; Unfold continuity in H1.
-Assert H2 := (H1 R0).
-Unfold continuity_pt in H2; Unfold continue_in in H2; Unfold limit1_in in H2; Unfold limit_in in H2; Simpl in H2; Unfold R_dist in H2.
-Elim (H2 ? H); Intros alp H3.
-Elim H3; Intros.
-Exists (mkposreal ? H4); Intros.
-Rewrite Rplus_Ol; Rewrite exp_0.
-Replace ``((exp h)-1)/h`` with (SFL fn cv h).
-Replace R1 with (SFL fn cv R0).
-Apply H5.
-Split.
-Unfold D_x no_cond; Split.
-Trivial.
-Apply (not_sym ? ? H6).
-Rewrite minus_R0; Apply H7.
-Unfold SFL.
-Case (cv ``0``); Intros.
-EApply UL_sequence.
-Apply u.
-Unfold Un_cv SP.
-Intros; Exists (1); Intros.
-Unfold R_dist; Rewrite decomp_sum.
-Rewrite (Rplus_sym (fn O R0)).
-Replace (fn O R0) with R1.
-Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or.
-Replace (sum_f_R0 [i:nat](fn (S i) ``0``) (pred n)) with R0.
-Rewrite Rabsolu_R0; Apply H8.
-Symmetry; Apply sum_eq_R0; Intros.
-Unfold fn.
-Simpl.
-Unfold Rdiv; Do 2 Rewrite Rmult_Ol; Reflexivity.
-Unfold fn; Simpl.
-Unfold Rdiv; Rewrite Rinv_R1; Rewrite Rmult_1r; Reflexivity.
-Apply lt_le_trans with (1); [Apply lt_n_Sn | Apply H9].
-Unfold SFL exp.
-Unfold projT1.
-Case (cv h); Case (exist_exp h); Intros.
-EApply UL_sequence.
-Apply u.
-Unfold Un_cv; Intros.
-Unfold exp_in in e.
-Unfold infinit_sum in e.
-Cut ``0<eps0*(Rabsolu h)``.
-Intro; Elim (e ? H9); Intros N0 H10.
-Exists N0; Intros.
-Unfold R_dist.
-Apply Rlt_monotony_contra with ``(Rabsolu h)``.
-Apply Rabsolu_pos_lt; Assumption.
-Rewrite <- Rabsolu_mult.
-Rewrite Rminus_distr.
-Replace ``h*(x-1)/h`` with ``(x-1)``.
-Unfold R_dist in H10.
-Replace ``h*(SP fn n h)-(x-1)`` with (Rminus (sum_f_R0 [i:nat]``/(INR (fact i))*(pow h i)`` (S n)) x).
-Rewrite (Rmult_sym (Rabsolu h)).
-Apply H10.
-Unfold ge.
-Apply le_trans with (S N0).
-Apply le_n_Sn.
-Apply le_n_S; Apply H11.
-Rewrite decomp_sum.
-Replace ``/(INR (fact O))*(pow h O)`` with R1.
-Unfold Rminus.
-Rewrite Ropp_distr1.
-Rewrite Ropp_Ropp.
-Rewrite <- (Rplus_sym ``-x``).
-Rewrite <- (Rplus_sym ``-x+1``).
-Rewrite Rplus_assoc; Repeat Apply Rplus_plus_r.
-Replace (pred (S n)) with n; [Idtac | Reflexivity].
-Unfold SP.
-Rewrite scal_sum.
-Apply sum_eq; Intros.
-Unfold fn.
-Replace (pow h (S i)) with ``h*(pow h i)``.
-Unfold Rdiv; Ring.
-Simpl; Ring.
-Simpl; Rewrite Rinv_R1; Rewrite Rmult_1r; Reflexivity.
-Apply lt_O_Sn.
-Unfold Rdiv.
-Rewrite <- Rmult_assoc.
-Symmetry; Apply Rinv_r_simpl_m.
-Assumption.
-Apply Rmult_lt_pos.
-Apply H8.
-Apply Rabsolu_pos_lt; Assumption.
-Apply SFL_continuity; Assumption.
-Intro; Unfold fn.
-Replace [x:R]``(pow x n)/(INR (fact (S n)))`` with (div_fct (pow_fct n) (fct_cte (INR (fact (S n))))); [Idtac | Reflexivity].
-Apply continuity_div.
-Apply derivable_continuous; Apply (derivable_pow n).
-Apply derivable_continuous; Apply derivable_const.
-Intro; Unfold fct_cte; Apply INR_fact_neq_0.
-Apply (CVN_R_CVS ? X).
-Assert H0 := Alembert_exp.
-Unfold CVN_R.
-Intro; Unfold CVN_r.
-Apply Specif.existT with [N:nat]``(pow r N)/(INR (fact (S N)))``.
-Cut (SigT ? [l:R](Un_cv [n:nat](sum_f_R0 [k:nat](Rabsolu ``(pow r k)/(INR (fact (S k)))``) n) l)).
-Intro.
-Elim X; Intros.
-Exists x; Intros.
-Split.
-Apply p.
-Unfold Boule; Intros.
-Rewrite minus_R0 in H1.
-Unfold fn.
-Unfold Rdiv; Rewrite Rabsolu_mult.
-Cut ``0<(INR (fact (S n)))``.
-Intro.
-Rewrite (Rabsolu_right ``/(INR (fact (S n)))``).
-Do 2 Rewrite <- (Rmult_sym ``/(INR (fact (S n)))``).
-Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Apply H2.
-Rewrite <- Pow_Rabsolu.
-Apply pow_maj_Rabs.
-Rewrite Rabsolu_Rabsolu; Left; Apply H1.
-Apply Rle_sym1; Left; Apply Rlt_Rinv; Apply H2.
-Apply INR_fact_lt_0.
-Cut (r::R)<>``0``.
-Intro; Apply Alembert_C2.
-Intro; Apply Rabsolu_no_R0.
-Unfold Rdiv; Apply prod_neq_R0.
-Apply pow_nonzero; Assumption.
-Apply Rinv_neq_R0; Apply INR_fact_neq_0.
-Unfold Un_cv in H0.
-Unfold Un_cv; Intros.
-Cut ``0<eps0/r``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Apply (cond_pos r)]].
-Elim (H0 ? H3); Intros N0 H4.
-Exists N0; Intros.
-Cut (ge (S n) N0).
-Intro hyp_sn.
-Assert H6 := (H4 ? hyp_sn).
-Unfold R_dist in H6; Rewrite minus_R0 in H6.
-Rewrite Rabsolu_Rabsolu in H6.
-Unfold R_dist; Rewrite minus_R0.
-Rewrite Rabsolu_Rabsolu.
-Replace ``(Rabsolu ((pow r (S n))/(INR (fact (S (S n))))))/
- (Rabsolu ((pow r n)/(INR (fact (S n)))))`` with ``r*/(INR (fact (S (S n))))*//(INR (fact (S n)))``.
-Rewrite Rmult_assoc; Rewrite Rabsolu_mult.
-Rewrite (Rabsolu_right r).
-Apply Rlt_monotony_contra with ``/r``.
-Apply Rlt_Rinv; Apply (cond_pos r).
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l; Rewrite <- (Rmult_sym eps0).
-Apply H6.
-Assumption.
-Apply Rle_sym1; Left; Apply (cond_pos r).
-Unfold Rdiv.
-Repeat Rewrite Rabsolu_mult.
-Repeat Rewrite Rabsolu_Rinv.
-Rewrite Rinv_Rmult.
-Repeat Rewrite Rabsolu_right.
-Rewrite Rinv_Rinv.
-Rewrite (Rmult_sym r).
-Rewrite (Rmult_sym (pow r (S n))).
-Repeat Rewrite Rmult_assoc.
-Apply Rmult_mult_r.
-Rewrite (Rmult_sym r).
-Rewrite <- Rmult_assoc; Rewrite <- (Rmult_sym (INR (fact (S n)))).
-Apply Rmult_mult_r.
-Simpl.
-Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym.
-Ring.
-Apply pow_nonzero; Assumption.
-Apply INR_fact_neq_0.
-Apply Rle_sym1; Left; Apply INR_fact_lt_0.
-Apply Rle_sym1; Left; Apply pow_lt; Apply (cond_pos r).
-Apply Rle_sym1; Left; Apply INR_fact_lt_0.
-Apply Rle_sym1; Left; Apply pow_lt; Apply (cond_pos r).
-Apply Rabsolu_no_R0; Apply pow_nonzero; Assumption.
-Apply Rinv_neq_R0; Apply Rabsolu_no_R0; Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Unfold ge; Apply le_trans with n.
-Apply H5.
-Apply le_n_Sn.
-Assert H1 := (cond_pos r); Red; Intro; Rewrite H2 in H1; Elim (Rlt_antirefl ? H1).
+Lemma derivable_pt_lim_exp_0 : derivable_pt_lim exp 0 1.
+unfold derivable_pt_lim in |- *; intros.
+pose (fn := fun (N:nat) (x:R) => x ^ N / INR (fact (S N))).
+cut (CVN_R fn).
+intro; cut (forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l)).
+intro cv; cut (forall n:nat, continuity (fn n)).
+intro; cut (continuity (SFL fn cv)).
+intro; unfold continuity in H1.
+assert (H2 := H1 0).
+unfold continuity_pt in H2; unfold continue_in in H2; unfold limit1_in in H2;
+ unfold limit_in in H2; simpl in H2; unfold R_dist in H2.
+elim (H2 _ H); intros alp H3.
+elim H3; intros.
+exists (mkposreal _ H4); intros.
+rewrite Rplus_0_l; rewrite exp_0.
+replace ((exp h - 1) / h) with (SFL fn cv h).
+replace 1 with (SFL fn cv 0).
+apply H5.
+split.
+unfold D_x, no_cond in |- *; split.
+trivial.
+apply (sym_not_eq H6).
+rewrite Rminus_0_r; apply H7.
+unfold SFL in |- *.
+case (cv 0); intros.
+eapply UL_sequence.
+apply u.
+unfold Un_cv, SP in |- *.
+intros; exists 1%nat; intros.
+unfold R_dist in |- *; rewrite decomp_sum.
+rewrite (Rplus_comm (fn 0%nat 0)).
+replace (fn 0%nat 0) with 1.
+unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_r;
+ rewrite Rplus_0_r.
+replace (sum_f_R0 (fun i:nat => fn (S i) 0) (pred n)) with 0.
+rewrite Rabs_R0; apply H8.
+symmetry in |- *; apply sum_eq_R0; intros.
+unfold fn in |- *.
+simpl in |- *.
+unfold Rdiv in |- *; do 2 rewrite Rmult_0_l; reflexivity.
+unfold fn in |- *; simpl in |- *.
+unfold Rdiv in |- *; rewrite Rinv_1; rewrite Rmult_1_r; reflexivity.
+apply lt_le_trans with 1%nat; [ apply lt_n_Sn | apply H9 ].
+unfold SFL, exp in |- *.
+unfold projT1 in |- *.
+case (cv h); case (exist_exp h); intros.
+eapply UL_sequence.
+apply u.
+unfold Un_cv in |- *; intros.
+unfold exp_in in e.
+unfold infinit_sum in e.
+cut (0 < eps0 * Rabs h).
+intro; elim (e _ H9); intros N0 H10.
+exists N0; intros.
+unfold R_dist in |- *.
+apply Rmult_lt_reg_l with (Rabs h).
+apply Rabs_pos_lt; assumption.
+rewrite <- Rabs_mult.
+rewrite Rmult_minus_distr_l.
+replace (h * ((x - 1) / h)) with (x - 1).
+unfold R_dist in H10.
+replace (h * SP fn n h - (x - 1)) with
+ (sum_f_R0 (fun i:nat => / INR (fact i) * h ^ i) (S n) - x).
+rewrite (Rmult_comm (Rabs h)).
+apply H10.
+unfold ge in |- *.
+apply le_trans with (S N0).
+apply le_n_Sn.
+apply le_n_S; apply H11.
+rewrite decomp_sum.
+replace (/ INR (fact 0) * h ^ 0) with 1.
+unfold Rminus in |- *.
+rewrite Ropp_plus_distr.
+rewrite Ropp_involutive.
+rewrite <- (Rplus_comm (- x)).
+rewrite <- (Rplus_comm (- x + 1)).
+rewrite Rplus_assoc; repeat apply Rplus_eq_compat_l.
+replace (pred (S n)) with n; [ idtac | reflexivity ].
+unfold SP in |- *.
+rewrite scal_sum.
+apply sum_eq; intros.
+unfold fn in |- *.
+replace (h ^ S i) with (h * h ^ i).
+unfold Rdiv in |- *; ring.
+simpl in |- *; ring.
+simpl in |- *; rewrite Rinv_1; rewrite Rmult_1_r; reflexivity.
+apply lt_O_Sn.
+unfold Rdiv in |- *.
+rewrite <- Rmult_assoc.
+symmetry in |- *; apply Rinv_r_simpl_m.
+assumption.
+apply Rmult_lt_0_compat.
+apply H8.
+apply Rabs_pos_lt; assumption.
+apply SFL_continuity; assumption.
+intro; unfold fn in |- *.
+replace (fun x:R => x ^ n / INR (fact (S n))) with
+ (pow_fct n / fct_cte (INR (fact (S n))))%F; [ idtac | reflexivity ].
+apply continuity_div.
+apply derivable_continuous; apply (derivable_pow n).
+apply derivable_continuous; apply derivable_const.
+intro; unfold fct_cte in |- *; apply INR_fact_neq_0.
+apply (CVN_R_CVS _ X).
+assert (H0 := Alembert_exp).
+unfold CVN_R in |- *.
+intro; unfold CVN_r in |- *.
+apply existT with (fun N:nat => r ^ N / INR (fact (S N))).
+cut
+ (sigT
+ (fun l:R =>
+ Un_cv
+ (fun n:nat =>
+ sum_f_R0 (fun k:nat => Rabs (r ^ k / INR (fact (S k)))) n) l)).
+intro.
+elim X; intros.
+exists x; intros.
+split.
+apply p.
+unfold Boule in |- *; intros.
+rewrite Rminus_0_r in H1.
+unfold fn in |- *.
+unfold Rdiv in |- *; rewrite Rabs_mult.
+cut (0 < INR (fact (S n))).
+intro.
+rewrite (Rabs_right (/ INR (fact (S n)))).
+do 2 rewrite <- (Rmult_comm (/ INR (fact (S n)))).
+apply Rmult_le_compat_l.
+left; apply Rinv_0_lt_compat; apply H2.
+rewrite <- RPow_abs.
+apply pow_maj_Rabs.
+rewrite Rabs_Rabsolu; left; apply H1.
+apply Rle_ge; left; apply Rinv_0_lt_compat; apply H2.
+apply INR_fact_lt_0.
+cut ((r:R) <> 0).
+intro; apply Alembert_C2.
+intro; apply Rabs_no_R0.
+unfold Rdiv in |- *; apply prod_neq_R0.
+apply pow_nonzero; assumption.
+apply Rinv_neq_0_compat; apply INR_fact_neq_0.
+unfold Un_cv in H0.
+unfold Un_cv in |- *; intros.
+cut (0 < eps0 / r);
+ [ intro
+ | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ assumption | apply Rinv_0_lt_compat; apply (cond_pos r) ] ].
+elim (H0 _ H3); intros N0 H4.
+exists N0; intros.
+cut (S n >= N0)%nat.
+intro hyp_sn.
+assert (H6 := H4 _ hyp_sn).
+unfold R_dist in H6; rewrite Rminus_0_r in H6.
+rewrite Rabs_Rabsolu in H6.
+unfold R_dist in |- *; rewrite Rminus_0_r.
+rewrite Rabs_Rabsolu.
+replace
+ (Rabs (r ^ S n / INR (fact (S (S n)))) / Rabs (r ^ n / INR (fact (S n))))
+ with (r * / INR (fact (S (S n))) * / / INR (fact (S n))).
+rewrite Rmult_assoc; rewrite Rabs_mult.
+rewrite (Rabs_right r).
+apply Rmult_lt_reg_l with (/ r).
+apply Rinv_0_lt_compat; apply (cond_pos r).
+rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
+rewrite Rmult_1_l; rewrite <- (Rmult_comm eps0).
+apply H6.
+assumption.
+apply Rle_ge; left; apply (cond_pos r).
+unfold Rdiv in |- *.
+repeat rewrite Rabs_mult.
+repeat rewrite Rabs_Rinv.
+rewrite Rinv_mult_distr.
+repeat rewrite Rabs_right.
+rewrite Rinv_involutive.
+rewrite (Rmult_comm r).
+rewrite (Rmult_comm (r ^ S n)).
+repeat rewrite Rmult_assoc.
+apply Rmult_eq_compat_l.
+rewrite (Rmult_comm r).
+rewrite <- Rmult_assoc; rewrite <- (Rmult_comm (INR (fact (S n)))).
+apply Rmult_eq_compat_l.
+simpl in |- *.
+rewrite Rmult_assoc; rewrite <- Rinv_r_sym.
+ring.
+apply pow_nonzero; assumption.
+apply INR_fact_neq_0.
+apply Rle_ge; left; apply INR_fact_lt_0.
+apply Rle_ge; left; apply pow_lt; apply (cond_pos r).
+apply Rle_ge; left; apply INR_fact_lt_0.
+apply Rle_ge; left; apply pow_lt; apply (cond_pos r).
+apply Rabs_no_R0; apply pow_nonzero; assumption.
+apply Rinv_neq_0_compat; apply Rabs_no_R0; apply INR_fact_neq_0.
+apply INR_fact_neq_0.
+apply INR_fact_neq_0.
+unfold ge in |- *; apply le_trans with n.
+apply H5.
+apply le_n_Sn.
+assert (H1 := cond_pos r); red in |- *; intro; rewrite H2 in H1;
+ elim (Rlt_irrefl _ H1).
Qed.
(**********)
-Lemma derivable_pt_lim_exp : (x:R) (derivable_pt_lim exp x (exp x)).
-Intro; Assert H0 := derivable_pt_lim_exp_0.
-Unfold derivable_pt_lim in H0; Unfold derivable_pt_lim; Intros.
-Cut ``0<eps/(exp x)``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Apply H | Apply Rlt_Rinv; Apply exp_pos]].
-Elim (H0 ? H1); Intros del H2.
-Exists del; Intros.
-Assert H5 := (H2 ? H3 H4).
-Rewrite Rplus_Ol in H5; Rewrite exp_0 in H5.
-Replace ``((exp (x+h))-(exp x))/h-(exp x)`` with ``(exp x)*(((exp h)-1)/h-1)``.
-Rewrite Rabsolu_mult; Rewrite (Rabsolu_right (exp x)).
-Apply Rlt_monotony_contra with ``/(exp x)``.
-Apply Rlt_Rinv; Apply exp_pos.
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l; Rewrite <- (Rmult_sym eps).
-Apply H5.
-Assert H6 := (exp_pos x); Red; Intro; Rewrite H7 in H6; Elim (Rlt_antirefl ? H6).
-Apply Rle_sym1; Left; Apply exp_pos.
-Rewrite Rminus_distr.
-Rewrite Rmult_1r; Unfold Rdiv; Rewrite <- Rmult_assoc; Rewrite Rminus_distr.
-Rewrite Rmult_1r; Rewrite exp_plus; Reflexivity.
-Qed.
+Lemma derivable_pt_lim_exp : forall x:R, derivable_pt_lim exp x (exp x).
+intro; assert (H0 := derivable_pt_lim_exp_0).
+unfold derivable_pt_lim in H0; unfold derivable_pt_lim in |- *; intros.
+cut (0 < eps / exp x);
+ [ intro
+ | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ apply H | apply Rinv_0_lt_compat; apply exp_pos ] ].
+elim (H0 _ H1); intros del H2.
+exists del; intros.
+assert (H5 := H2 _ H3 H4).
+rewrite Rplus_0_l in H5; rewrite exp_0 in H5.
+replace ((exp (x + h) - exp x) / h - exp x) with
+ (exp x * ((exp h - 1) / h - 1)).
+rewrite Rabs_mult; rewrite (Rabs_right (exp x)).
+apply Rmult_lt_reg_l with (/ exp x).
+apply Rinv_0_lt_compat; apply exp_pos.
+rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
+rewrite Rmult_1_l; rewrite <- (Rmult_comm eps).
+apply H5.
+assert (H6 := exp_pos x); red in |- *; intro; rewrite H7 in H6;
+ elim (Rlt_irrefl _ H6).
+apply Rle_ge; left; apply exp_pos.
+rewrite Rmult_minus_distr_l.
+rewrite Rmult_1_r; unfold Rdiv in |- *; rewrite <- Rmult_assoc;
+ rewrite Rmult_minus_distr_l.
+rewrite Rmult_1_r; rewrite exp_plus; reflexivity.
+Qed. \ No newline at end of file
diff --git a/theories/Reals/MVT.v b/theories/Reals/MVT.v
index 330d53812..5eab01e5b 100644
--- a/theories/Reals/MVT.v
+++ b/theories/Reals/MVT.v
@@ -8,510 +8,692 @@
(*i $Id$ i*)
-Require Rbase.
-Require Rfunctions.
-Require Ranalysis1.
-Require Rtopology.
-V7only [Import R_scope.]. Open Local Scope R_scope.
+Require Import Rbase.
+Require Import Rfunctions.
+Require Import Ranalysis1.
+Require Import Rtopology. Open Local Scope R_scope.
(* The Mean Value Theorem *)
-Theorem MVT : (f,g:R->R;a,b:R;pr1:(c:R)``a<c<b``->(derivable_pt f c);pr2:(c:R)``a<c<b``->(derivable_pt g c)) ``a<b`` -> ((c:R)``a<=c<=b``->(continuity_pt f c)) -> ((c:R)``a<=c<=b``->(continuity_pt g c)) -> (EXT c : R | (EXT P : ``a<c<b`` | ``((g b)-(g a))*(derive_pt f c (pr1 c P))==((f b)-(f a))*(derive_pt g c (pr2 c P))``)).
-Intros; Assert H2 := (Rlt_le ? ? H).
-Pose h := [y:R]``((g b)-(g a))*(f y)-((f b)-(f a))*(g y)``.
-Cut (c:R)``a<c<b``->(derivable_pt h c).
-Intro; Cut ((c:R)``a<=c<=b``->(continuity_pt h c)).
-Intro; Assert H4 := (continuity_ab_maj h a b H2 H3).
-Assert H5 := (continuity_ab_min h a b H2 H3).
-Elim H4; Intros Mx H6.
-Elim H5; Intros mx H7.
-Cut (h a)==(h b).
-Intro; Pose M := (h Mx); Pose m := (h mx).
-Cut (c:R;P:``a<c<b``) (derive_pt h c (X c P))==``((g b)-(g a))*(derive_pt f c (pr1 c P))-((f b)-(f a))*(derive_pt g c (pr2 c P))``.
-Intro; Case (Req_EM (h a) M); Intro.
-Case (Req_EM (h a) m); Intro.
-Cut ((c:R)``a<=c<=b``->(h c)==M).
-Intro; Cut ``a<(a+b)/2<b``.
+Theorem MVT :
+ forall (f g:R -> R) (a b:R) (pr1:forall c:R, a < c < b -> derivable_pt f c)
+ (pr2:forall c:R, a < c < b -> derivable_pt g c),
+ a < b ->
+ (forall c:R, a <= c <= b -> continuity_pt f c) ->
+ (forall c:R, a <= c <= b -> continuity_pt g c) ->
+ exists c : R
+ | ( exists P : a < c < b
+ | (g b - g a) * derive_pt f c (pr1 c P) =
+ (f b - f a) * derive_pt g c (pr2 c P)).
+intros; assert (H2 := Rlt_le _ _ H).
+pose (h := fun y:R => (g b - g a) * f y - (f b - f a) * g y).
+cut (forall c:R, a < c < b -> derivable_pt h c).
+intro; cut (forall c:R, a <= c <= b -> continuity_pt h c).
+intro; assert (H4 := continuity_ab_maj h a b H2 H3).
+assert (H5 := continuity_ab_min h a b H2 H3).
+elim H4; intros Mx H6.
+elim H5; intros mx H7.
+cut (h a = h b).
+intro; pose (M := h Mx); pose (m := h mx).
+cut
+ (forall (c:R) (P:a < c < b),
+ derive_pt h c (X c P) =
+ (g b - g a) * derive_pt f c (pr1 c P) -
+ (f b - f a) * derive_pt g c (pr2 c P)).
+intro; case (Req_dec (h a) M); intro.
+case (Req_dec (h a) m); intro.
+cut (forall c:R, a <= c <= b -> h c = M).
+intro; cut (a < (a + b) / 2 < b).
(*** h constant ***)
-Intro; Exists ``(a+b)/2``.
-Exists H13.
-Apply Rminus_eq; Rewrite <- H9; Apply deriv_constant2 with a b.
-Elim H13; Intros; Assumption.
-Elim H13; Intros; Assumption.
-Intros; Rewrite (H12 ``(a+b)/2``).
-Apply H12; Split; Left; Assumption.
-Elim H13; Intros; Split; Left; Assumption.
-Split.
-Apply Rlt_monotony_contra with ``2``.
-Sup0.
-Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Apply H.
-DiscrR.
-Apply Rlt_monotony_contra with ``2``.
-Sup0.
-Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1l; Rewrite Rplus_sym; Rewrite double; Apply Rlt_compatibility; Apply H.
-DiscrR.
-Intros; Elim H6; Intros H13 _.
-Elim H7; Intros H14 _.
-Apply Rle_antisym.
-Apply H13; Apply H12.
-Rewrite H10 in H11; Rewrite H11; Apply H14; Apply H12.
-Cut ``a<mx<b``.
+intro; exists ((a + b) / 2).
+exists H13.
+apply Rminus_diag_uniq; rewrite <- H9; apply deriv_constant2 with a b.
+elim H13; intros; assumption.
+elim H13; intros; assumption.
+intros; rewrite (H12 ((a + b) / 2)).
+apply H12; split; left; assumption.
+elim H13; intros; split; left; assumption.
+split.
+apply Rmult_lt_reg_l with 2.
+prove_sup0.
+unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+ rewrite <- Rinv_r_sym.
+rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; apply H.
+discrR.
+apply Rmult_lt_reg_l with 2.
+prove_sup0.
+unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+ rewrite <- Rinv_r_sym.
+rewrite Rmult_1_l; rewrite Rplus_comm; rewrite double;
+ apply Rplus_lt_compat_l; apply H.
+discrR.
+intros; elim H6; intros H13 _.
+elim H7; intros H14 _.
+apply Rle_antisym.
+apply H13; apply H12.
+rewrite H10 in H11; rewrite H11; apply H14; apply H12.
+cut (a < mx < b).
(*** h admet un minimum global sur [a,b] ***)
-Intro; Exists mx.
-Exists H12.
-Apply Rminus_eq; Rewrite <- H9; Apply deriv_minimum with a b.
-Elim H12; Intros; Assumption.
-Elim H12; Intros; Assumption.
-Intros; Elim H7; Intros.
-Apply H15; Split; Left; Assumption.
-Elim H7; Intros _ H12; Elim H12; Intros; Split.
-Inversion H13.
-Apply H15.
-Rewrite H15 in H11; Elim H11; Reflexivity.
-Inversion H14.
-Apply H15.
-Rewrite H8 in H11; Rewrite <- H15 in H11; Elim H11; Reflexivity.
-Cut ``a<Mx<b``.
+intro; exists mx.
+exists H12.
+apply Rminus_diag_uniq; rewrite <- H9; apply deriv_minimum with a b.
+elim H12; intros; assumption.
+elim H12; intros; assumption.
+intros; elim H7; intros.
+apply H15; split; left; assumption.
+elim H7; intros _ H12; elim H12; intros; split.
+inversion H13.
+apply H15.
+rewrite H15 in H11; elim H11; reflexivity.
+inversion H14.
+apply H15.
+rewrite H8 in H11; rewrite <- H15 in H11; elim H11; reflexivity.
+cut (a < Mx < b).
(*** h admet un maximum global sur [a,b] ***)
-Intro; Exists Mx.
-Exists H11.
-Apply Rminus_eq; Rewrite <- H9; Apply deriv_maximum with a b.
-Elim H11; Intros; Assumption.
-Elim H11; Intros; Assumption.
-Intros; Elim H6; Intros; Apply H14.
-Split; Left; Assumption.
-Elim H6; Intros _ H11; Elim H11; Intros; Split.
-Inversion H12.
-Apply H14.
-Rewrite H14 in H10; Elim H10; Reflexivity.
-Inversion H13.
-Apply H14.
-Rewrite H8 in H10; Rewrite <- H14 in H10; Elim H10; Reflexivity.
-Intros; Unfold h; Replace (derive_pt [y:R]``((g b)-(g a))*(f y)-((f b)-(f a))*(g y)`` c (X c P)) with (derive_pt (minus_fct (mult_fct (fct_cte ``(g b)-(g a)``) f) (mult_fct (fct_cte ``(f b)-(f a)``) g)) c (derivable_pt_minus ? ? ? (derivable_pt_mult ? ? ? (derivable_pt_const ``(g b)-(g a)`` c) (pr1 c P)) (derivable_pt_mult ? ? ? (derivable_pt_const ``(f b)-(f a)`` c) (pr2 c P)))); [Idtac | Apply pr_nu].
-Rewrite derive_pt_minus; Do 2 Rewrite derive_pt_mult; Do 2 Rewrite derive_pt_const; Do 2 Rewrite Rmult_Ol; Do 2 Rewrite Rplus_Ol; Reflexivity.
-Unfold h; Ring.
-Intros; Unfold h; Change (continuity_pt (minus_fct (mult_fct (fct_cte ``(g b)-(g a)``) f) (mult_fct (fct_cte ``(f b)-(f a)``) g)) c).
-Apply continuity_pt_minus; Apply continuity_pt_mult.
-Apply derivable_continuous_pt; Apply derivable_const.
-Apply H0; Apply H3.
-Apply derivable_continuous_pt; Apply derivable_const.
-Apply H1; Apply H3.
-Intros; Change (derivable_pt (minus_fct (mult_fct (fct_cte ``(g b)-(g a)``) f) (mult_fct (fct_cte ``(f b)-(f a)``) g)) c).
-Apply derivable_pt_minus; Apply derivable_pt_mult.
-Apply derivable_pt_const.
-Apply (pr1 ? H3).
-Apply derivable_pt_const.
-Apply (pr2 ? H3).
+intro; exists Mx.
+exists H11.
+apply Rminus_diag_uniq; rewrite <- H9; apply deriv_maximum with a b.
+elim H11; intros; assumption.
+elim H11; intros; assumption.
+intros; elim H6; intros; apply H14.
+split; left; assumption.
+elim H6; intros _ H11; elim H11; intros; split.
+inversion H12.
+apply H14.
+rewrite H14 in H10; elim H10; reflexivity.
+inversion H13.
+apply H14.
+rewrite H8 in H10; rewrite <- H14 in H10; elim H10; reflexivity.
+intros; unfold h in |- *;
+ replace
+ (derive_pt (fun y:R => (g b - g a) * f y - (f b - f a) * g y) c (X c P))
+ with
+ (derive_pt ((fct_cte (g b - g a) * f)%F - (fct_cte (f b - f a) * g)%F) c
+ (derivable_pt_minus _ _ _
+ (derivable_pt_mult _ _ _ (derivable_pt_const (g b - g a) c) (pr1 c P))
+ (derivable_pt_mult _ _ _ (derivable_pt_const (f b - f a) c) (pr2 c P))));
+ [ idtac | apply pr_nu ].
+rewrite derive_pt_minus; do 2 rewrite derive_pt_mult;
+ do 2 rewrite derive_pt_const; do 2 rewrite Rmult_0_l;
+ do 2 rewrite Rplus_0_l; reflexivity.
+unfold h in |- *; ring.
+intros; unfold h in |- *;
+ change
+ (continuity_pt ((fct_cte (g b - g a) * f)%F - (fct_cte (f b - f a) * g)%F)
+ c) in |- *.
+apply continuity_pt_minus; apply continuity_pt_mult.
+apply derivable_continuous_pt; apply derivable_const.
+apply H0; apply H3.
+apply derivable_continuous_pt; apply derivable_const.
+apply H1; apply H3.
+intros;
+ change
+ (derivable_pt ((fct_cte (g b - g a) * f)%F - (fct_cte (f b - f a) * g)%F)
+ c) in |- *.
+apply derivable_pt_minus; apply derivable_pt_mult.
+apply derivable_pt_const.
+apply (pr1 _ H3).
+apply derivable_pt_const.
+apply (pr2 _ H3).
Qed.
(* Corollaries ... *)
-Lemma MVT_cor1 : (f:(R->R); a,b:R; pr:(derivable f)) ``a < b``->(EXT c:R | ``(f b)-(f a) == (derive_pt f c (pr c))*(b-a)``/\``a < c < b``).
-Intros f a b pr H; Cut (c:R)``a<c<b``->(derivable_pt f c); [Intro | Intros; Apply pr].
-Cut (c:R)``a<c<b``->(derivable_pt id c); [Intro | Intros; Apply derivable_pt_id].
-Cut ((c:R)``a<=c<=b``->(continuity_pt f c)); [Intro | Intros; Apply derivable_continuous_pt; Apply pr].
-Cut ((c:R)``a<=c<=b``->(continuity_pt id c)); [Intro | Intros; Apply derivable_continuous_pt; Apply derivable_id].
-Assert H2 := (MVT f id a b X X0 H H0 H1).
-Elim H2; Intros c H3; Elim H3; Intros.
-Exists c; Split.
-Cut (derive_pt id c (X0 c x)) == (derive_pt id c (derivable_pt_id c)); [Intro | Apply pr_nu].
-Rewrite H5 in H4; Rewrite (derive_pt_id c) in H4; Rewrite Rmult_1r in H4; Rewrite <- H4; Replace (derive_pt f c (X c x)) with (derive_pt f c (pr c)); [Idtac | Apply pr_nu]; Apply Rmult_sym.
-Apply x.
+Lemma MVT_cor1 :
+ forall (f:R -> R) (a b:R) (pr:derivable f),
+ a < b ->
+ exists c : R | f b - f a = derive_pt f c (pr c) * (b - a) /\ a < c < b.
+intros f a b pr H; cut (forall c:R, a < c < b -> derivable_pt f c);
+ [ intro | intros; apply pr ].
+cut (forall c:R, a < c < b -> derivable_pt id c);
+ [ intro | intros; apply derivable_pt_id ].
+cut (forall c:R, a <= c <= b -> continuity_pt f c);
+ [ intro | intros; apply derivable_continuous_pt; apply pr ].
+cut (forall c:R, a <= c <= b -> continuity_pt id c);
+ [ intro | intros; apply derivable_continuous_pt; apply derivable_id ].
+assert (H2 := MVT f id a b X X0 H H0 H1).
+elim H2; intros c H3; elim H3; intros.
+exists c; split.
+cut (derive_pt id c (X0 c x) = derive_pt id c (derivable_pt_id c));
+ [ intro | apply pr_nu ].
+rewrite H5 in H4; rewrite (derive_pt_id c) in H4; rewrite Rmult_1_r in H4;
+ rewrite <- H4; replace (derive_pt f c (X c x)) with (derive_pt f c (pr c));
+ [ idtac | apply pr_nu ]; apply Rmult_comm.
+apply x.
Qed.
-Theorem MVT_cor2 : (f,f':R->R;a,b:R) ``a<b`` -> ((c:R)``a<=c<=b``->(derivable_pt_lim f c (f' c))) -> (EXT c:R | ``(f b)-(f a)==(f' c)*(b-a)``/\``a<c<b``).
-Intros f f' a b H H0; Cut ((c:R)``a<=c<=b``->(derivable_pt f c)).
-Intro; Cut ((c:R)``a<c<b``->(derivable_pt f c)).
-Intro; Cut ((c:R)``a<=c<=b``->(continuity_pt f c)).
-Intro; Cut ((c:R)``a<=c<=b``->(derivable_pt id c)).
-Intro; Cut ((c:R)``a<c<b``->(derivable_pt id c)).
-Intro; Cut ((c:R)``a<=c<=b``->(continuity_pt id c)).
-Intro; Elim (MVT f id a b X0 X2 H H1 H2); Intros; Elim H3; Clear H3; Intros; Exists x; Split.
-Cut (derive_pt id x (X2 x x0))==R1.
-Cut (derive_pt f x (X0 x x0))==(f' x).
-Intros; Rewrite H4 in H3; Rewrite H5 in H3; Unfold id in H3; Rewrite Rmult_1r in H3; Rewrite Rmult_sym; Symmetry; Assumption.
-Apply derive_pt_eq_0; Apply H0; Elim x0; Intros; Split; Left; Assumption.
-Apply derive_pt_eq_0; Apply derivable_pt_lim_id.
-Assumption.
-Intros; Apply derivable_continuous_pt; Apply X1; Assumption.
-Intros; Apply derivable_pt_id.
-Intros; Apply derivable_pt_id.
-Intros; Apply derivable_continuous_pt; Apply X; Assumption.
-Intros; Elim H1; Intros; Apply X; Split; Left; Assumption.
-Intros; Unfold derivable_pt; Apply Specif.existT with (f' c); Apply H0; Apply H1.
+Theorem MVT_cor2 :
+ forall (f f':R -> R) (a b:R),
+ a < b ->
+ (forall c:R, a <= c <= b -> derivable_pt_lim f c (f' c)) ->
+ exists c : R | f b - f a = f' c * (b - a) /\ a < c < b.
+intros f f' a b H H0; cut (forall c:R, a <= c <= b -> derivable_pt f c).
+intro; cut (forall c:R, a < c < b -> derivable_pt f c).
+intro; cut (forall c:R, a <= c <= b -> continuity_pt f c).
+intro; cut (forall c:R, a <= c <= b -> derivable_pt id c).
+intro; cut (forall c:R, a < c < b -> derivable_pt id c).
+intro; cut (forall c:R, a <= c <= b -> continuity_pt id c).
+intro; elim (MVT f id a b X0 X2 H H1 H2); intros; elim H3; clear H3; intros;
+ exists x; split.
+cut (derive_pt id x (X2 x x0) = 1).
+cut (derive_pt f x (X0 x x0) = f' x).
+intros; rewrite H4 in H3; rewrite H5 in H3; unfold id in H3;
+ rewrite Rmult_1_r in H3; rewrite Rmult_comm; symmetry in |- *;
+ assumption.
+apply derive_pt_eq_0; apply H0; elim x0; intros; split; left; assumption.
+apply derive_pt_eq_0; apply derivable_pt_lim_id.
+assumption.
+intros; apply derivable_continuous_pt; apply X1; assumption.
+intros; apply derivable_pt_id.
+intros; apply derivable_pt_id.
+intros; apply derivable_continuous_pt; apply X; assumption.
+intros; elim H1; intros; apply X; split; left; assumption.
+intros; unfold derivable_pt in |- *; apply existT with (f' c); apply H0;
+ apply H1.
Qed.
-Lemma MVT_cor3 : (f,f':(R->R); a,b:R) ``a < b`` -> ((x:R)``a <= x`` -> ``x <= b``->(derivable_pt_lim f x (f' x))) -> (EXT c:R | ``a<=c``/\``c<=b``/\``(f b)==(f a) + (f' c)*(b-a)``).
-Intros f f' a b H H0; Assert H1 : (EXT c:R | ``(f b) -(f a) == (f' c)*(b-a)``/\``a<c<b``); [Apply MVT_cor2; [Apply H | Intros; Elim H1; Intros; Apply (H0 ? H2 H3)] | Elim H1; Intros; Exists x; Elim H2; Intros; Elim H4; Intros; Split; [Left; Assumption | Split; [Left; Assumption | Rewrite <- H3; Ring]]].
+Lemma MVT_cor3 :
+ forall (f f':R -> R) (a b:R),
+ a < b ->
+ (forall x:R, a <= x -> x <= b -> derivable_pt_lim f x (f' x)) ->
+ exists c : R | a <= c /\ c <= b /\ f b = f a + f' c * (b - a).
+intros f f' a b H H0;
+ assert (H1 : exists c : R | f b - f a = f' c * (b - a) /\ a < c < b);
+ [ apply MVT_cor2; [ apply H | intros; elim H1; intros; apply (H0 _ H2 H3) ]
+ | elim H1; intros; exists x; elim H2; intros; elim H4; intros; split;
+ [ left; assumption | split; [ left; assumption | rewrite <- H3; ring ] ] ].
Qed.
-Lemma Rolle : (f:R->R;a,b:R;pr:(x:R)``a<x<b``->(derivable_pt f x)) ((x:R)``a<=x<=b``->(continuity_pt f x)) -> ``a<b`` -> (f a)==(f b) -> (EXT c:R | (EXT P: ``a<c<b`` | ``(derive_pt f c (pr c P))==0``)).
-Intros; Assert H2 : (x:R)``a<x<b``->(derivable_pt id x).
-Intros; Apply derivable_pt_id.
-Assert H3 := (MVT f id a b pr H2 H0 H); Assert H4 : (x:R)``a<=x<=b``->(continuity_pt id x).
-Intros; Apply derivable_continuous; Apply derivable_id.
-Elim (H3 H4); Intros; Elim H5; Intros; Exists x; Exists x0; Rewrite H1 in H6; Unfold id in H6; Unfold Rminus in H6; Rewrite Rplus_Ropp_r in H6; Rewrite Rmult_Ol in H6; Apply r_Rmult_mult with ``b-a``; [Rewrite Rmult_Or; Apply H6 | Apply Rminus_eq_contra; Red; Intro; Rewrite H7 in H0; Elim (Rlt_antirefl ? H0)].
+Lemma Rolle :
+ forall (f:R -> R) (a b:R) (pr:forall x:R, a < x < b -> derivable_pt f x),
+ (forall x:R, a <= x <= b -> continuity_pt f x) ->
+ a < b ->
+ f a = f b ->
+ exists c : R | ( exists P : a < c < b | derive_pt f c (pr c P) = 0).
+intros; assert (H2 : forall x:R, a < x < b -> derivable_pt id x).
+intros; apply derivable_pt_id.
+assert (H3 := MVT f id a b pr H2 H0 H);
+ assert (H4 : forall x:R, a <= x <= b -> continuity_pt id x).
+intros; apply derivable_continuous; apply derivable_id.
+elim (H3 H4); intros; elim H5; intros; exists x; exists x0; rewrite H1 in H6;
+ unfold id in H6; unfold Rminus in H6; rewrite Rplus_opp_r in H6;
+ rewrite Rmult_0_l in H6; apply Rmult_eq_reg_l with (b - a);
+ [ rewrite Rmult_0_r; apply H6
+ | apply Rminus_eq_contra; red in |- *; intro; rewrite H7 in H0;
+ elim (Rlt_irrefl _ H0) ].
Qed.
(**********)
-Lemma nonneg_derivative_1 : (f:R->R;pr:(derivable f)) ((x:R) ``0<=(derive_pt f x (pr x))``) -> (increasing f).
-Intros.
-Unfold increasing.
-Intros.
-Case (total_order_T x y); Intro.
-Elim s; Intro.
-Apply Rle_anti_compatibility with ``-(f x)``.
-Rewrite Rplus_Ropp_l; Rewrite Rplus_sym.
-Assert H1 := (MVT_cor1 f ? ? pr a).
-Elim H1; Intros.
-Elim H2; Intros.
-Unfold Rminus in H3.
-Rewrite H3.
-Apply Rmult_le_pos.
-Apply H.
-Apply Rle_anti_compatibility with x.
-Rewrite Rplus_Or; Replace ``x+(y+ -x)`` with y; [Assumption | Ring].
-Rewrite b; Right; Reflexivity.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H0 r)).
+Lemma nonneg_derivative_1 :
+ forall (f:R -> R) (pr:derivable f),
+ (forall x:R, 0 <= derive_pt f x (pr x)) -> increasing f.
+intros.
+unfold increasing in |- *.
+intros.
+case (total_order_T x y); intro.
+elim s; intro.
+apply Rplus_le_reg_l with (- f x).
+rewrite Rplus_opp_l; rewrite Rplus_comm.
+assert (H1 := MVT_cor1 f _ _ pr a).
+elim H1; intros.
+elim H2; intros.
+unfold Rminus in H3.
+rewrite H3.
+apply Rmult_le_pos.
+apply H.
+apply Rplus_le_reg_l with x.
+rewrite Rplus_0_r; replace (x + (y + - x)) with y; [ assumption | ring ].
+rewrite b; right; reflexivity.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 r)).
Qed.
(**********)
-Lemma nonpos_derivative_0 : (f:R->R;pr:(derivable f)) (decreasing f) -> ((x:R) ``(derive_pt f x (pr x))<=0``).
-Intros f pr H x; Assert H0 :=H; Unfold decreasing in H0; Generalize (derivable_derive f x (pr x)); Intro; Elim H1; Intros l H2.
-Rewrite H2; Case (total_order l R0); Intro.
-Left; Assumption.
-Elim H3; Intro.
-Right; Assumption.
-Generalize (derive_pt_eq_1 f x l (pr x) H2); Intros; Cut ``0< (l/2)``.
-Intro; Elim (H5 ``(l/2)`` H6); Intros delta H7; Cut ``delta/2<>0``/\``0<delta/2``/\``(Rabsolu delta/2)<delta``.
-Intro; Decompose [and] H8; Intros; Generalize (H7 ``delta/2`` H9 H12); Cut ``((f (x+delta/2))-(f x))/(delta/2)<=0``.
-Intro; Cut ``0< -(((f (x+delta/2))-(f x))/(delta/2)-l)``.
-Intro; Unfold Rabsolu; Case (case_Rabsolu ``((f (x+delta/2))-(f x))/(delta/2)-l``).
-Intros; Generalize (Rlt_compatibility_r ``-l`` ``-(((f (x+delta/2))-(f x))/(delta/2)-l)`` ``(l/2)`` H14); Unfold Rminus.
-Replace ``(l/2)+ -l`` with ``-(l/2)``.
-Replace `` -(((f (x+delta/2))+ -(f x))/(delta/2)+ -l)+ -l`` with ``-(((f (x+delta/2))+ -(f x))/(delta/2))``.
-Intro.
-Generalize (Rlt_Ropp ``-(((f (x+delta/2))+ -(f x))/(delta/2))`` ``-(l/2)`` H15).
-Repeat Rewrite Ropp_Ropp.
-Intro.
-Generalize (Rlt_trans ``0`` ``l/2`` ``((f (x+delta/2))-(f x))/(delta/2)`` H6 H16); Intro.
-Elim (Rlt_antirefl ``0`` (Rlt_le_trans ``0`` ``((f (x+delta/2))-(f x))/(delta/2)`` ``0`` H17 H10)).
-Ring.
-Pattern 3 l; Rewrite double_var.
-Ring.
-Intros.
-Generalize (Rge_Ropp ``((f (x+delta/2))-(f x))/(delta/2)-l`` ``0`` r).
-Rewrite Ropp_O.
-Intro.
-Elim (Rlt_antirefl ``0`` (Rlt_le_trans ``0`` ``-(((f (x+delta/2))-(f x))/(delta/2)-l)`` ``0`` H13 H15)).
-Replace ``-(((f (x+delta/2))-(f x))/(delta/2)-l)`` with ``(((f (x))-(f (x+delta/2)))/(delta/2)) +l``.
-Unfold Rminus.
-Apply ge0_plus_gt0_is_gt0.
-Unfold Rdiv; Apply Rmult_le_pos.
-Cut ``x<=(x+(delta*/2))``.
-Intro; Generalize (H0 x ``x+(delta*/2)`` H13); Intro; Generalize (Rle_compatibility ``-(f (x+delta/2))`` ``(f (x+delta/2))`` ``(f x)`` H14); Rewrite Rplus_Ropp_l; Rewrite Rplus_sym; Intro; Assumption.
-Pattern 1 x; Rewrite <- (Rplus_Or x); Apply Rle_compatibility; Left; Assumption.
-Left; Apply Rlt_Rinv; Assumption.
-Assumption.
-Rewrite Ropp_distr2.
-Unfold Rminus.
-Rewrite (Rplus_sym l).
-Unfold Rdiv.
-Rewrite <- Ropp_mul1.
-Rewrite Ropp_distr1.
-Rewrite Ropp_Ropp.
-Rewrite (Rplus_sym (f x)).
-Reflexivity.
-Replace ``((f (x+delta/2))-(f x))/(delta/2)`` with ``-(((f x)-(f (x+delta/2)))/(delta/2))``.
-Rewrite <- Ropp_O.
-Apply Rge_Ropp.
-Apply Rle_sym1.
-Unfold Rdiv; Apply Rmult_le_pos.
-Cut ``x<=(x+(delta*/2))``.
-Intro; Generalize (H0 x ``x+(delta*/2)`` H10); Intro.
-Generalize (Rle_compatibility ``-(f (x+delta/2))`` ``(f (x+delta/2))`` ``(f x)`` H13); Rewrite Rplus_Ropp_l; Rewrite Rplus_sym; Intro; Assumption.
-Pattern 1 x; Rewrite <- (Rplus_Or x); Apply Rle_compatibility; Left; Assumption.
-Left; Apply Rlt_Rinv; Assumption.
-Unfold Rdiv; Rewrite <- Ropp_mul1.
-Rewrite Ropp_distr2.
-Reflexivity.
-Split.
-Unfold Rdiv; Apply prod_neq_R0.
-Generalize (cond_pos delta); Intro; Red; Intro H9; Rewrite H9 in H8; Elim (Rlt_antirefl ``0`` H8).
-Apply Rinv_neq_R0; DiscrR.
-Split.
-Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos delta) | Apply Rlt_Rinv; Sup0].
-Rewrite Rabsolu_right.
-Unfold Rdiv; Apply Rlt_monotony_contra with ``2``.
-Sup0.
-Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1l; Rewrite double; Pattern 1 (pos delta); Rewrite <- Rplus_Or.
-Apply Rlt_compatibility; Apply (cond_pos delta).
-DiscrR.
-Apply Rle_sym1; Unfold Rdiv; Left; Apply Rmult_lt_pos.
-Apply (cond_pos delta).
-Apply Rlt_Rinv; Sup0.
-Unfold Rdiv; Apply Rmult_lt_pos; [Apply H4 | Apply Rlt_Rinv; Sup0].
+Lemma nonpos_derivative_0 :
+ forall (f:R -> R) (pr:derivable f),
+ decreasing f -> forall x:R, derive_pt f x (pr x) <= 0.
+intros f pr H x; assert (H0 := H); unfold decreasing in H0;
+ generalize (derivable_derive f x (pr x)); intro; elim H1;
+ intros l H2.
+rewrite H2; case (Rtotal_order l 0); intro.
+left; assumption.
+elim H3; intro.
+right; assumption.
+generalize (derive_pt_eq_1 f x l (pr x) H2); intros; cut (0 < l / 2).
+intro; elim (H5 (l / 2) H6); intros delta H7;
+ cut (delta / 2 <> 0 /\ 0 < delta / 2 /\ Rabs (delta / 2) < delta).
+intro; decompose [and] H8; intros; generalize (H7 (delta / 2) H9 H12);
+ cut ((f (x + delta / 2) - f x) / (delta / 2) <= 0).
+intro; cut (0 < - ((f (x + delta / 2) - f x) / (delta / 2) - l)).
+intro; unfold Rabs in |- *;
+ case (Rcase_abs ((f (x + delta / 2) - f x) / (delta / 2) - l)).
+intros;
+ generalize
+ (Rplus_lt_compat_r (- l) (- ((f (x + delta / 2) - f x) / (delta / 2) - l))
+ (l / 2) H14); unfold Rminus in |- *.
+replace (l / 2 + - l) with (- (l / 2)).
+replace (- ((f (x + delta / 2) + - f x) / (delta / 2) + - l) + - l) with
+ (- ((f (x + delta / 2) + - f x) / (delta / 2))).
+intro.
+generalize
+ (Ropp_lt_gt_contravar (- ((f (x + delta / 2) + - f x) / (delta / 2)))
+ (- (l / 2)) H15).
+repeat rewrite Ropp_involutive.
+intro.
+generalize
+ (Rlt_trans 0 (l / 2) ((f (x + delta / 2) - f x) / (delta / 2)) H6 H16);
+ intro.
+elim
+ (Rlt_irrefl 0
+ (Rlt_le_trans 0 ((f (x + delta / 2) - f x) / (delta / 2)) 0 H17 H10)).
+ring.
+pattern l at 3 in |- *; rewrite double_var.
+ring.
+intros.
+generalize
+ (Ropp_ge_le_contravar ((f (x + delta / 2) - f x) / (delta / 2) - l) 0 r).
+rewrite Ropp_0.
+intro.
+elim
+ (Rlt_irrefl 0
+ (Rlt_le_trans 0 (- ((f (x + delta / 2) - f x) / (delta / 2) - l)) 0 H13
+ H15)).
+replace (- ((f (x + delta / 2) - f x) / (delta / 2) - l)) with
+ ((f x - f (x + delta / 2)) / (delta / 2) + l).
+unfold Rminus in |- *.
+apply Rplus_le_lt_0_compat.
+unfold Rdiv in |- *; apply Rmult_le_pos.
+cut (x <= x + delta * / 2).
+intro; generalize (H0 x (x + delta * / 2) H13); intro;
+ generalize
+ (Rplus_le_compat_l (- f (x + delta / 2)) (f (x + delta / 2)) (f x) H14);
+ rewrite Rplus_opp_l; rewrite Rplus_comm; intro; assumption.
+pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l;
+ left; assumption.
+left; apply Rinv_0_lt_compat; assumption.
+assumption.
+rewrite Ropp_minus_distr.
+unfold Rminus in |- *.
+rewrite (Rplus_comm l).
+unfold Rdiv in |- *.
+rewrite <- Ropp_mult_distr_l_reverse.
+rewrite Ropp_plus_distr.
+rewrite Ropp_involutive.
+rewrite (Rplus_comm (f x)).
+reflexivity.
+replace ((f (x + delta / 2) - f x) / (delta / 2)) with
+ (- ((f x - f (x + delta / 2)) / (delta / 2))).
+rewrite <- Ropp_0.
+apply Ropp_ge_le_contravar.
+apply Rle_ge.
+unfold Rdiv in |- *; apply Rmult_le_pos.
+cut (x <= x + delta * / 2).
+intro; generalize (H0 x (x + delta * / 2) H10); intro.
+generalize
+ (Rplus_le_compat_l (- f (x + delta / 2)) (f (x + delta / 2)) (f x) H13);
+ rewrite Rplus_opp_l; rewrite Rplus_comm; intro; assumption.
+pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l;
+ left; assumption.
+left; apply Rinv_0_lt_compat; assumption.
+unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse.
+rewrite Ropp_minus_distr.
+reflexivity.
+split.
+unfold Rdiv in |- *; apply prod_neq_R0.
+generalize (cond_pos delta); intro; red in |- *; intro H9; rewrite H9 in H8;
+ elim (Rlt_irrefl 0 H8).
+apply Rinv_neq_0_compat; discrR.
+split.
+unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ].
+rewrite Rabs_right.
+unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2.
+prove_sup0.
+rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym.
+rewrite Rmult_1_l; rewrite double; pattern (pos delta) at 1 in |- *;
+ rewrite <- Rplus_0_r.
+apply Rplus_lt_compat_l; apply (cond_pos delta).
+discrR.
+apply Rle_ge; unfold Rdiv in |- *; left; apply Rmult_lt_0_compat.
+apply (cond_pos delta).
+apply Rinv_0_lt_compat; prove_sup0.
+unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ apply H4 | apply Rinv_0_lt_compat; prove_sup0 ].
Qed.
(**********)
-Lemma increasing_decreasing_opp : (f:R->R) (increasing f) -> (decreasing (opp_fct f)).
-Unfold increasing decreasing opp_fct; Intros; Generalize (H x y H0); Intro; Apply Rge_Ropp; Apply Rle_sym1; Assumption.
+Lemma increasing_decreasing_opp :
+ forall f:R -> R, increasing f -> decreasing (- f)%F.
+unfold increasing, decreasing, opp_fct in |- *; intros; generalize (H x y H0);
+ intro; apply Ropp_ge_le_contravar; apply Rle_ge; assumption.
Qed.
(**********)
-Lemma nonpos_derivative_1 : (f:R->R;pr:(derivable f)) ((x:R) ``(derive_pt f x (pr x))<=0``) -> (decreasing f).
-Intros.
-Cut (h:R)``-(-(f h))==(f h)``.
-Intro.
-Generalize (increasing_decreasing_opp (opp_fct f)).
-Unfold decreasing.
-Unfold opp_fct.
-Intros.
-Rewrite <- (H0 x); Rewrite <- (H0 y).
-Apply H1.
-Cut (x:R)``0<=(derive_pt (opp_fct f) x ((derivable_opp f pr) x))``.
-Intros.
-Replace [x:R]``-(f x)`` with (opp_fct f); [Idtac | Reflexivity].
-Apply (nonneg_derivative_1 (opp_fct f) (derivable_opp f pr) H3).
-Intro.
-Assert H3 := (derive_pt_opp f x0 (pr x0)).
-Cut ``(derive_pt (opp_fct f) x0 (derivable_pt_opp f x0 (pr x0)))==(derive_pt (opp_fct f) x0 (derivable_opp f pr x0))``.
-Intro.
-Rewrite <- H4.
-Rewrite H3.
-Rewrite <- Ropp_O; Apply Rge_Ropp; Apply Rle_sym1; Apply (H x0).
-Apply pr_nu.
-Assumption.
-Intro; Ring.
+Lemma nonpos_derivative_1 :
+ forall (f:R -> R) (pr:derivable f),
+ (forall x:R, derive_pt f x (pr x) <= 0) -> decreasing f.
+intros.
+cut (forall h:R, - - f h = f h).
+intro.
+generalize (increasing_decreasing_opp (- f)%F).
+unfold decreasing in |- *.
+unfold opp_fct in |- *.
+intros.
+rewrite <- (H0 x); rewrite <- (H0 y).
+apply H1.
+cut (forall x:R, 0 <= derive_pt (- f) x (derivable_opp f pr x)).
+intros.
+replace (fun x:R => - f x) with (- f)%F; [ idtac | reflexivity ].
+apply (nonneg_derivative_1 (- f)%F (derivable_opp f pr) H3).
+intro.
+assert (H3 := derive_pt_opp f x0 (pr x0)).
+cut
+ (derive_pt (- f) x0 (derivable_pt_opp f x0 (pr x0)) =
+ derive_pt (- f) x0 (derivable_opp f pr x0)).
+intro.
+rewrite <- H4.
+rewrite H3.
+rewrite <- Ropp_0; apply Ropp_ge_le_contravar; apply Rle_ge; apply (H x0).
+apply pr_nu.
+assumption.
+intro; ring.
Qed.
(**********)
-Lemma positive_derivative : (f:R->R;pr:(derivable f)) ((x:R) ``0<(derive_pt f x (pr x))``)->(strict_increasing f).
-Intros.
-Unfold strict_increasing.
-Intros.
-Apply Rlt_anti_compatibility with ``-(f x)``.
-Rewrite Rplus_Ropp_l; Rewrite Rplus_sym.
-Assert H1 := (MVT_cor1 f ? ? pr H0).
-Elim H1; Intros.
-Elim H2; Intros.
-Unfold Rminus in H3.
-Rewrite H3.
-Apply Rmult_lt_pos.
-Apply H.
-Apply Rlt_anti_compatibility with x.
-Rewrite Rplus_Or; Replace ``x+(y+ -x)`` with y; [Assumption | Ring].
+Lemma positive_derivative :
+ forall (f:R -> R) (pr:derivable f),
+ (forall x:R, 0 < derive_pt f x (pr x)) -> strict_increasing f.
+intros.
+unfold strict_increasing in |- *.
+intros.
+apply Rplus_lt_reg_r with (- f x).
+rewrite Rplus_opp_l; rewrite Rplus_comm.
+assert (H1 := MVT_cor1 f _ _ pr H0).
+elim H1; intros.
+elim H2; intros.
+unfold Rminus in H3.
+rewrite H3.
+apply Rmult_lt_0_compat.
+apply H.
+apply Rplus_lt_reg_r with x.
+rewrite Rplus_0_r; replace (x + (y + - x)) with y; [ assumption | ring ].
Qed.
(**********)
-Lemma strictincreasing_strictdecreasing_opp : (f:R->R) (strict_increasing f) ->
-(strict_decreasing (opp_fct f)).
-Unfold strict_increasing strict_decreasing opp_fct; Intros; Generalize (H x y H0); Intro; Apply Rlt_Ropp; Assumption.
+Lemma strictincreasing_strictdecreasing_opp :
+ forall f:R -> R, strict_increasing f -> strict_decreasing (- f)%F.
+unfold strict_increasing, strict_decreasing, opp_fct in |- *; intros;
+ generalize (H x y H0); intro; apply Ropp_lt_gt_contravar;
+ assumption.
Qed.
(**********)
-Lemma negative_derivative : (f:R->R;pr:(derivable f)) ((x:R) ``(derive_pt f x (pr x))<0``)->(strict_decreasing f).
-Intros.
-Cut (h:R)``- (-(f h))==(f h)``.
-Intros.
-Generalize (strictincreasing_strictdecreasing_opp (opp_fct f)).
-Unfold strict_decreasing opp_fct.
-Intros.
-Rewrite <- (H0 x).
-Rewrite <- (H0 y).
-Apply H1; [Idtac | Assumption].
-Cut (x:R)``0<(derive_pt (opp_fct f) x (derivable_opp f pr x))``.
-Intros; EApply positive_derivative; Apply H3.
-Intro.
-Assert H3 := (derive_pt_opp f x0 (pr x0)).
-Cut ``(derive_pt (opp_fct f) x0 (derivable_pt_opp f x0 (pr x0)))==(derive_pt (opp_fct f) x0 (derivable_opp f pr x0))``.
-Intro.
-Rewrite <- H4; Rewrite H3.
-Rewrite <- Ropp_O; Apply Rlt_Ropp; Apply (H x0).
-Apply pr_nu.
-Intro; Ring.
+Lemma negative_derivative :
+ forall (f:R -> R) (pr:derivable f),
+ (forall x:R, derive_pt f x (pr x) < 0) -> strict_decreasing f.
+intros.
+cut (forall h:R, - - f h = f h).
+intros.
+generalize (strictincreasing_strictdecreasing_opp (- f)%F).
+unfold strict_decreasing, opp_fct in |- *.
+intros.
+rewrite <- (H0 x).
+rewrite <- (H0 y).
+apply H1; [ idtac | assumption ].
+cut (forall x:R, 0 < derive_pt (- f) x (derivable_opp f pr x)).
+intros; eapply positive_derivative; apply H3.
+intro.
+assert (H3 := derive_pt_opp f x0 (pr x0)).
+cut
+ (derive_pt (- f) x0 (derivable_pt_opp f x0 (pr x0)) =
+ derive_pt (- f) x0 (derivable_opp f pr x0)).
+intro.
+rewrite <- H4; rewrite H3.
+rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; apply (H x0).
+apply pr_nu.
+intro; ring.
Qed.
(**********)
-Lemma null_derivative_0 : (f:R->R;pr:(derivable f)) (constant f)->((x:R) ``(derive_pt f x (pr x))==0``).
-Intros.
-Unfold constant in H.
-Apply derive_pt_eq_0.
-Intros; Exists (mkposreal ``1`` Rlt_R0_R1); Simpl; Intros.
-Rewrite (H x ``x+h``); Unfold Rminus; Unfold Rdiv; Rewrite Rplus_Ropp_r; Rewrite Rmult_Ol; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption.
+Lemma null_derivative_0 :
+ forall (f:R -> R) (pr:derivable f),
+ constant f -> forall x:R, derive_pt f x (pr x) = 0.
+intros.
+unfold constant in H.
+apply derive_pt_eq_0.
+intros; exists (mkposreal 1 Rlt_0_1); simpl in |- *; intros.
+rewrite (H x (x + h)); unfold Rminus in |- *; unfold Rdiv in |- *;
+ rewrite Rplus_opp_r; rewrite Rmult_0_l; rewrite Rplus_opp_r;
+ rewrite Rabs_R0; assumption.
Qed.
(**********)
-Lemma increasing_decreasing : (f:R->R) (increasing f) -> (decreasing f) -> (constant f).
-Unfold increasing decreasing constant; Intros; Case (total_order x y); Intro.
-Generalize (Rlt_le x y H1); Intro; Apply (Rle_antisym (f x) (f y) (H x y H2) (H0 x y H2)).
-Elim H1; Intro.
-Rewrite H2; Reflexivity.
-Generalize (Rlt_le y x H2); Intro; Symmetry; Apply (Rle_antisym (f y) (f x) (H y x H3) (H0 y x H3)).
+Lemma increasing_decreasing :
+ forall f:R -> R, increasing f -> decreasing f -> constant f.
+unfold increasing, decreasing, constant in |- *; intros;
+ case (Rtotal_order x y); intro.
+generalize (Rlt_le x y H1); intro;
+ apply (Rle_antisym (f x) (f y) (H x y H2) (H0 x y H2)).
+elim H1; intro.
+rewrite H2; reflexivity.
+generalize (Rlt_le y x H2); intro; symmetry in |- *;
+ apply (Rle_antisym (f y) (f x) (H y x H3) (H0 y x H3)).
Qed.
(**********)
-Lemma null_derivative_1 : (f:R->R;pr:(derivable f)) ((x:R) ``(derive_pt f x (pr x))==0``)->(constant f).
-Intros.
-Cut (x:R)``(derive_pt f x (pr x)) <= 0``.
-Cut (x:R)``0 <= (derive_pt f x (pr x))``.
-Intros.
-Assert H2 := (nonneg_derivative_1 f pr H0).
-Assert H3 := (nonpos_derivative_1 f pr H1).
-Apply increasing_decreasing; Assumption.
-Intro; Right; Symmetry; Apply (H x).
-Intro; Right; Apply (H x).
+Lemma null_derivative_1 :
+ forall (f:R -> R) (pr:derivable f),
+ (forall x:R, derive_pt f x (pr x) = 0) -> constant f.
+intros.
+cut (forall x:R, derive_pt f x (pr x) <= 0).
+cut (forall x:R, 0 <= derive_pt f x (pr x)).
+intros.
+assert (H2 := nonneg_derivative_1 f pr H0).
+assert (H3 := nonpos_derivative_1 f pr H1).
+apply increasing_decreasing; assumption.
+intro; right; symmetry in |- *; apply (H x).
+intro; right; apply (H x).
Qed.
(**********)
-Lemma derive_increasing_interv_ax : (a,b:R;f:R->R;pr:(derivable f)) ``a<b``-> (((t:R) ``a<t<b`` -> ``0<(derive_pt f t (pr t))``) -> ((x,y:R) ``a<=x<=b``->``a<=y<=b``->``x<y``->``(f x)<(f y)``)) /\ (((t:R) ``a<t<b`` -> ``0<=(derive_pt f t (pr t))``) -> ((x,y:R) ``a<=x<=b``->``a<=y<=b``->``x<y``->``(f x)<=(f y)``)).
-Intros.
-Split; Intros.
-Apply Rlt_anti_compatibility with ``-(f x)``.
-Rewrite Rplus_Ropp_l; Rewrite Rplus_sym.
-Assert H4 := (MVT_cor1 f ? ? pr H3).
-Elim H4; Intros.
-Elim H5; Intros.
-Unfold Rminus in H6.
-Rewrite H6.
-Apply Rmult_lt_pos.
-Apply H0.
-Elim H7; Intros.
-Split.
-Elim H1; Intros.
-Apply Rle_lt_trans with x; Assumption.
-Elim H2; Intros.
-Apply Rlt_le_trans with y; Assumption.
-Apply Rlt_anti_compatibility with x.
-Rewrite Rplus_Or; Replace ``x+(y+ -x)`` with y; [Assumption | Ring].
-Apply Rle_anti_compatibility with ``-(f x)``.
-Rewrite Rplus_Ropp_l; Rewrite Rplus_sym.
-Assert H4 := (MVT_cor1 f ? ? pr H3).
-Elim H4; Intros.
-Elim H5; Intros.
-Unfold Rminus in H6.
-Rewrite H6.
-Apply Rmult_le_pos.
-Apply H0.
-Elim H7; Intros.
-Split.
-Elim H1; Intros.
-Apply Rle_lt_trans with x; Assumption.
-Elim H2; Intros.
-Apply Rlt_le_trans with y; Assumption.
-Apply Rle_anti_compatibility with x.
-Rewrite Rplus_Or; Replace ``x+(y+ -x)`` with y; [Left; Assumption | Ring].
+Lemma derive_increasing_interv_ax :
+ forall (a b:R) (f:R -> R) (pr:derivable f),
+ a < b ->
+ ((forall t:R, a < t < b -> 0 < derive_pt f t (pr t)) ->
+ forall x y:R, a <= x <= b -> a <= y <= b -> x < y -> f x < f y) /\
+ ((forall t:R, a < t < b -> 0 <= derive_pt f t (pr t)) ->
+ forall x y:R, a <= x <= b -> a <= y <= b -> x < y -> f x <= f y).
+intros.
+split; intros.
+apply Rplus_lt_reg_r with (- f x).
+rewrite Rplus_opp_l; rewrite Rplus_comm.
+assert (H4 := MVT_cor1 f _ _ pr H3).
+elim H4; intros.
+elim H5; intros.
+unfold Rminus in H6.
+rewrite H6.
+apply Rmult_lt_0_compat.
+apply H0.
+elim H7; intros.
+split.
+elim H1; intros.
+apply Rle_lt_trans with x; assumption.
+elim H2; intros.
+apply Rlt_le_trans with y; assumption.
+apply Rplus_lt_reg_r with x.
+rewrite Rplus_0_r; replace (x + (y + - x)) with y; [ assumption | ring ].
+apply Rplus_le_reg_l with (- f x).
+rewrite Rplus_opp_l; rewrite Rplus_comm.
+assert (H4 := MVT_cor1 f _ _ pr H3).
+elim H4; intros.
+elim H5; intros.
+unfold Rminus in H6.
+rewrite H6.
+apply Rmult_le_pos.
+apply H0.
+elim H7; intros.
+split.
+elim H1; intros.
+apply Rle_lt_trans with x; assumption.
+elim H2; intros.
+apply Rlt_le_trans with y; assumption.
+apply Rplus_le_reg_l with x.
+rewrite Rplus_0_r; replace (x + (y + - x)) with y;
+ [ left; assumption | ring ].
Qed.
(**********)
-Lemma derive_increasing_interv : (a,b:R;f:R->R;pr:(derivable f)) ``a<b``-> ((t:R) ``a<t<b`` -> ``0<(derive_pt f t (pr t))``) -> ((x,y:R) ``a<=x<=b``->``a<=y<=b``->``x<y``->``(f x)<(f y)``).
-Intros.
-Generalize (derive_increasing_interv_ax a b f pr H); Intro.
-Elim H4; Intros H5 _; Apply (H5 H0 x y H1 H2 H3).
+Lemma derive_increasing_interv :
+ forall (a b:R) (f:R -> R) (pr:derivable f),
+ a < b ->
+ (forall t:R, a < t < b -> 0 < derive_pt f t (pr t)) ->
+ forall x y:R, a <= x <= b -> a <= y <= b -> x < y -> f x < f y.
+intros.
+generalize (derive_increasing_interv_ax a b f pr H); intro.
+elim H4; intros H5 _; apply (H5 H0 x y H1 H2 H3).
Qed.
(**********)
-Lemma derive_increasing_interv_var : (a,b:R;f:R->R;pr:(derivable f)) ``a<b``-> ((t:R) ``a<t<b`` -> ``0<=(derive_pt f t (pr t))``) -> ((x,y:R) ``a<=x<=b``->``a<=y<=b``->``x<y``->``(f x)<=(f y)``).
-Intros a b f pr H H0 x y H1 H2 H3; Generalize (derive_increasing_interv_ax a b f pr H); Intro; Elim H4; Intros _ H5; Apply (H5 H0 x y H1 H2 H3).
+Lemma derive_increasing_interv_var :
+ forall (a b:R) (f:R -> R) (pr:derivable f),
+ a < b ->
+ (forall t:R, a < t < b -> 0 <= derive_pt f t (pr t)) ->
+ forall x y:R, a <= x <= b -> a <= y <= b -> x < y -> f x <= f y.
+intros a b f pr H H0 x y H1 H2 H3;
+ generalize (derive_increasing_interv_ax a b f pr H);
+ intro; elim H4; intros _ H5; apply (H5 H0 x y H1 H2 H3).
Qed.
(**********)
(**********)
-Theorem IAF : (f:R->R;a,b,k:R;pr:(derivable f)) ``a<=b`` -> ((c:R) ``a<=c<=b`` -> ``(derive_pt f c (pr c))<=k``) -> ``(f b)-(f a)<=k*(b-a)``.
-Intros.
-Case (total_order_T a b); Intro.
-Elim s; Intro.
-Assert H1 := (MVT_cor1 f ? ? pr a0).
-Elim H1; Intros.
-Elim H2; Intros.
-Rewrite H3.
-Do 2 Rewrite <- (Rmult_sym ``(b-a)``).
-Apply Rle_monotony.
-Apply Rle_anti_compatibility with ``a``; Rewrite Rplus_Or.
-Replace ``a+(b-a)`` with b; [Assumption | Ring].
-Apply H0.
-Elim H4; Intros.
-Split; Left; Assumption.
-Rewrite b0.
-Unfold Rminus; Do 2 Rewrite Rplus_Ropp_r.
-Rewrite Rmult_Or; Right; Reflexivity.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r)).
+Theorem IAF :
+ forall (f:R -> R) (a b k:R) (pr:derivable f),
+ a <= b ->
+ (forall c:R, a <= c <= b -> derive_pt f c (pr c) <= k) ->
+ f b - f a <= k * (b - a).
+intros.
+case (total_order_T a b); intro.
+elim s; intro.
+assert (H1 := MVT_cor1 f _ _ pr a0).
+elim H1; intros.
+elim H2; intros.
+rewrite H3.
+do 2 rewrite <- (Rmult_comm (b - a)).
+apply Rmult_le_compat_l.
+apply Rplus_le_reg_l with a; rewrite Rplus_0_r.
+replace (a + (b - a)) with b; [ assumption | ring ].
+apply H0.
+elim H4; intros.
+split; left; assumption.
+rewrite b0.
+unfold Rminus in |- *; do 2 rewrite Rplus_opp_r.
+rewrite Rmult_0_r; right; reflexivity.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)).
Qed.
-Lemma IAF_var : (f,g:R->R;a,b:R;pr1:(derivable f);pr2:(derivable g)) ``a<=b`` -> ((c:R) ``a<=c<=b`` -> ``(derive_pt g c (pr2 c))<=(derive_pt f c (pr1 c))``) -> ``(g b)-(g a)<=(f b)-(f a)``.
-Intros.
-Cut (derivable (minus_fct g f)).
-Intro.
-Cut (c:R)``a<=c<=b``->``(derive_pt (minus_fct g f) c (X c))<=0``.
-Intro.
-Assert H2 := (IAF (minus_fct g f) a b R0 X H H1).
-Rewrite Rmult_Ol in H2; Unfold minus_fct in H2.
-Apply Rle_anti_compatibility with ``-(f b)+(f a)``.
-Replace ``-(f b)+(f a)+((f b)-(f a))`` with R0; [Idtac | Ring].
-Replace ``-(f b)+(f a)+((g b)-(g a))`` with ``(g b)-(f b)-((g a)-(f a))``; [Apply H2 | Ring].
-Intros.
-Cut (derive_pt (minus_fct g f) c (X c))==(derive_pt (minus_fct g f) c (derivable_pt_minus ? ? ? (pr2 c) (pr1 c))).
-Intro.
-Rewrite H2.
-Rewrite derive_pt_minus.
-Apply Rle_anti_compatibility with (derive_pt f c (pr1 c)).
-Rewrite Rplus_Or.
-Replace ``(derive_pt f c (pr1 c))+((derive_pt g c (pr2 c))-(derive_pt f c (pr1 c)))`` with ``(derive_pt g c (pr2 c))``; [Idtac | Ring].
-Apply H0; Assumption.
-Apply pr_nu.
-Apply derivable_minus; Assumption.
+Lemma IAF_var :
+ forall (f g:R -> R) (a b:R) (pr1:derivable f) (pr2:derivable g),
+ a <= b ->
+ (forall c:R, a <= c <= b -> derive_pt g c (pr2 c) <= derive_pt f c (pr1 c)) ->
+ g b - g a <= f b - f a.
+intros.
+cut (derivable (g - f)).
+intro.
+cut (forall c:R, a <= c <= b -> derive_pt (g - f) c (X c) <= 0).
+intro.
+assert (H2 := IAF (g - f)%F a b 0 X H H1).
+rewrite Rmult_0_l in H2; unfold minus_fct in H2.
+apply Rplus_le_reg_l with (- f b + f a).
+replace (- f b + f a + (f b - f a)) with 0; [ idtac | ring ].
+replace (- f b + f a + (g b - g a)) with (g b - f b - (g a - f a));
+ [ apply H2 | ring ].
+intros.
+cut
+ (derive_pt (g - f) c (X c) =
+ derive_pt (g - f) c (derivable_pt_minus _ _ _ (pr2 c) (pr1 c))).
+intro.
+rewrite H2.
+rewrite derive_pt_minus.
+apply Rplus_le_reg_l with (derive_pt f c (pr1 c)).
+rewrite Rplus_0_r.
+replace
+ (derive_pt f c (pr1 c) + (derive_pt g c (pr2 c) - derive_pt f c (pr1 c)))
+ with (derive_pt g c (pr2 c)); [ idtac | ring ].
+apply H0; assumption.
+apply pr_nu.
+apply derivable_minus; assumption.
Qed.
(* If f has a null derivative in ]a,b[ and is continue in [a,b], *)
(* then f is constant on [a,b] *)
-Lemma null_derivative_loc : (f:R->R;a,b:R;pr:(x:R)``a<x<b``->(derivable_pt f x)) ((x:R)``a<=x<=b``->(continuity_pt f x)) -> ((x:R;P:``a<x<b``)(derive_pt f x (pr x P))==R0) -> (constant_D_eq f [x:R]``a<=x<=b`` (f a)).
-Intros; Unfold constant_D_eq; Intros; Case (total_order_T a b); Intro.
-Elim s; Intro.
-Assert H2 : (y:R)``a<y<x``->(derivable_pt id y).
-Intros; Apply derivable_pt_id.
-Assert H3 : (y:R)``a<=y<=x``->(continuity_pt id y).
-Intros; Apply derivable_continuous; Apply derivable_id.
-Assert H4 : (y:R)``a<y<x``->(derivable_pt f y).
-Intros; Apply pr; Elim H4; Intros; Split.
-Assumption.
-Elim H1; Intros; Apply Rlt_le_trans with x; Assumption.
-Assert H5 : (y:R)``a<=y<=x``->(continuity_pt f y).
-Intros; Apply H; Elim H5; Intros; Split.
-Assumption.
-Elim H1; Intros; Apply Rle_trans with x; Assumption.
-Elim H1; Clear H1; Intros; Elim H1; Clear H1; Intro.
-Assert H7 := (MVT f id a x H4 H2 H1 H5 H3).
-Elim H7; Intros; Elim H8; Intros; Assert H10 : ``a<x0<b``.
-Elim x1; Intros; Split.
-Assumption.
-Apply Rlt_le_trans with x; Assumption.
-Assert H11 : ``(derive_pt f x0 (H4 x0 x1))==0``.
-Replace (derive_pt f x0 (H4 x0 x1)) with (derive_pt f x0 (pr x0 H10)); [Apply H0 | Apply pr_nu].
-Assert H12 : ``(derive_pt id x0 (H2 x0 x1))==1``.
-Apply derive_pt_eq_0; Apply derivable_pt_lim_id.
-Rewrite H11 in H9; Rewrite H12 in H9; Rewrite Rmult_Or in H9; Rewrite Rmult_1r in H9; Apply Rminus_eq; Symmetry; Assumption.
-Rewrite H1; Reflexivity.
-Assert H2 : x==a.
-Rewrite <- b0 in H1; Elim H1; Intros; Apply Rle_antisym; Assumption.
-Rewrite H2; Reflexivity.
-Elim H1; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? (Rle_trans ? ? ? H2 H3) r)).
+Lemma null_derivative_loc :
+ forall (f:R -> R) (a b:R) (pr:forall x:R, a < x < b -> derivable_pt f x),
+ (forall x:R, a <= x <= b -> continuity_pt f x) ->
+ (forall (x:R) (P:a < x < b), derive_pt f x (pr x P) = 0) ->
+ constant_D_eq f (fun x:R => a <= x <= b) (f a).
+intros; unfold constant_D_eq in |- *; intros; case (total_order_T a b); intro.
+elim s; intro.
+assert (H2 : forall y:R, a < y < x -> derivable_pt id y).
+intros; apply derivable_pt_id.
+assert (H3 : forall y:R, a <= y <= x -> continuity_pt id y).
+intros; apply derivable_continuous; apply derivable_id.
+assert (H4 : forall y:R, a < y < x -> derivable_pt f y).
+intros; apply pr; elim H4; intros; split.
+assumption.
+elim H1; intros; apply Rlt_le_trans with x; assumption.
+assert (H5 : forall y:R, a <= y <= x -> continuity_pt f y).
+intros; apply H; elim H5; intros; split.
+assumption.
+elim H1; intros; apply Rle_trans with x; assumption.
+elim H1; clear H1; intros; elim H1; clear H1; intro.
+assert (H7 := MVT f id a x H4 H2 H1 H5 H3).
+elim H7; intros; elim H8; intros; assert (H10 : a < x0 < b).
+elim x1; intros; split.
+assumption.
+apply Rlt_le_trans with x; assumption.
+assert (H11 : derive_pt f x0 (H4 x0 x1) = 0).
+replace (derive_pt f x0 (H4 x0 x1)) with (derive_pt f x0 (pr x0 H10));
+ [ apply H0 | apply pr_nu ].
+assert (H12 : derive_pt id x0 (H2 x0 x1) = 1).
+apply derive_pt_eq_0; apply derivable_pt_lim_id.
+rewrite H11 in H9; rewrite H12 in H9; rewrite Rmult_0_r in H9;
+ rewrite Rmult_1_r in H9; apply Rminus_diag_uniq; symmetry in |- *;
+ assumption.
+rewrite H1; reflexivity.
+assert (H2 : x = a).
+rewrite <- b0 in H1; elim H1; intros; apply Rle_antisym; assumption.
+rewrite H2; reflexivity.
+elim H1; intros;
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ (Rle_trans _ _ _ H2 H3) r)).
Qed.
(* Unicity of the antiderivative *)
-Lemma antiderivative_Ucte : (f,g1,g2:R->R;a,b:R) (antiderivative f g1 a b) -> (antiderivative f g2 a b) -> (EXT c:R | (x:R)``a<=x<=b``->``(g1 x)==(g2 x)+c``).
-Unfold antiderivative; Intros; Elim H; Clear H; Intros; Elim H0; Clear H0; Intros H0 _; Exists ``(g1 a)-(g2 a)``; Intros; Assert H3 : (x:R)``a<=x<=b``->(derivable_pt g1 x).
-Intros; Unfold derivable_pt; Apply Specif.existT with (f x0); Elim (H x0 H3); Intros; EApply derive_pt_eq_1; Symmetry; Apply H4.
-Assert H4 : (x:R)``a<=x<=b``->(derivable_pt g2 x).
-Intros; Unfold derivable_pt; Apply Specif.existT with (f x0); Elim (H0 x0 H4); Intros; EApply derive_pt_eq_1; Symmetry; Apply H5.
-Assert H5 : (x:R)``a<x<b``->(derivable_pt (minus_fct g1 g2) x).
-Intros; Elim H5; Intros; Apply derivable_pt_minus; [Apply H3; Split; Left; Assumption | Apply H4; Split; Left; Assumption].
-Assert H6 : (x:R)``a<=x<=b``->(continuity_pt (minus_fct g1 g2) x).
-Intros; Apply derivable_continuous_pt; Apply derivable_pt_minus; [Apply H3 | Apply H4]; Assumption.
-Assert H7 : (x:R;P:``a<x<b``)(derive_pt (minus_fct g1 g2) x (H5 x P))==``0``.
-Intros; Elim P; Intros; Apply derive_pt_eq_0; Replace R0 with ``(f x0)-(f x0)``; [Idtac | Ring].
-Assert H9 : ``a<=x0<=b``.
-Split; Left; Assumption.
-Apply derivable_pt_lim_minus; [Elim (H ? H9) | Elim (H0 ? H9)]; Intros; EApply derive_pt_eq_1; Symmetry; Apply H10.
-Assert H8 := (null_derivative_loc (minus_fct g1 g2) a b H5 H6 H7); Unfold constant_D_eq in H8; Assert H9 := (H8 ? H2); Unfold minus_fct in H9; Rewrite <- H9; Ring.
-Qed.
+Lemma antiderivative_Ucte :
+ forall (f g1 g2:R -> R) (a b:R),
+ antiderivative f g1 a b ->
+ antiderivative f g2 a b ->
+ exists c : R | (forall x:R, a <= x <= b -> g1 x = g2 x + c).
+unfold antiderivative in |- *; intros; elim H; clear H; intros; elim H0;
+ clear H0; intros H0 _; exists (g1 a - g2 a); intros;
+ assert (H3 : forall x:R, a <= x <= b -> derivable_pt g1 x).
+intros; unfold derivable_pt in |- *; apply existT with (f x0); elim (H x0 H3);
+ intros; eapply derive_pt_eq_1; symmetry in |- *;
+ apply H4.
+assert (H4 : forall x:R, a <= x <= b -> derivable_pt g2 x).
+intros; unfold derivable_pt in |- *; apply existT with (f x0);
+ elim (H0 x0 H4); intros; eapply derive_pt_eq_1; symmetry in |- *;
+ apply H5.
+assert (H5 : forall x:R, a < x < b -> derivable_pt (g1 - g2) x).
+intros; elim H5; intros; apply derivable_pt_minus;
+ [ apply H3; split; left; assumption | apply H4; split; left; assumption ].
+assert (H6 : forall x:R, a <= x <= b -> continuity_pt (g1 - g2) x).
+intros; apply derivable_continuous_pt; apply derivable_pt_minus;
+ [ apply H3 | apply H4 ]; assumption.
+assert (H7 : forall (x:R) (P:a < x < b), derive_pt (g1 - g2) x (H5 x P) = 0).
+intros; elim P; intros; apply derive_pt_eq_0; replace 0 with (f x0 - f x0);
+ [ idtac | ring ].
+assert (H9 : a <= x0 <= b).
+split; left; assumption.
+apply derivable_pt_lim_minus; [ elim (H _ H9) | elim (H0 _ H9) ]; intros;
+ eapply derive_pt_eq_1; symmetry in |- *; apply H10.
+assert (H8 := null_derivative_loc (g1 - g2)%F a b H5 H6 H7);
+ unfold constant_D_eq in H8; assert (H9 := H8 _ H2);
+ unfold minus_fct in H9; rewrite <- H9; ring.
+Qed. \ No newline at end of file
diff --git a/theories/Reals/NewtonInt.v b/theories/Reals/NewtonInt.v
index 961f8bf0a..e2080827b 100644
--- a/theories/Reals/NewtonInt.v
+++ b/theories/Reals/NewtonInt.v
@@ -8,593 +8,781 @@
(*i $Id$ i*)
-Require Rbase.
-Require Rfunctions.
-Require SeqSeries.
-Require Rtrigo.
-Require Ranalysis.
-V7only [Import R_scope.]. Open Local Scope R_scope.
+Require Import Rbase.
+Require Import Rfunctions.
+Require Import SeqSeries.
+Require Import Rtrigo.
+Require Import Ranalysis. Open Local Scope R_scope.
(*******************************************)
(* Newton's Integral *)
(*******************************************)
-Definition Newton_integrable [f:R->R;a,b:R] : Type := (sigTT ? [g:R->R](antiderivative f g a b)\/(antiderivative f g b a)).
+Definition Newton_integrable (f:R -> R) (a b:R) : Type :=
+ sigT (fun g:R -> R => antiderivative f g a b \/ antiderivative f g b a).
-Definition NewtonInt [f:R->R;a,b:R;pr:(Newton_integrable f a b)] : R := let g = Cases pr of (existTT a b) => a end in ``(g b)-(g a)``.
+Definition NewtonInt (f:R -> R) (a b:R) (pr:Newton_integrable f a b) : R :=
+ let g := match pr with
+ | existT a b => a
+ end in g b - g a.
(* If f is differentiable, then f' is Newton integrable (Tautology ?) *)
-Lemma FTCN_step1 : (f:Differential;a,b:R) (Newton_integrable [x:R](derive_pt f x (cond_diff f x)) a b).
-Intros f a b; Unfold Newton_integrable; Apply existTT with (d1 f); Unfold antiderivative; Intros; Case (total_order_Rle a b); Intro; [Left; Split; [Intros; Exists (cond_diff f x); Reflexivity | Assumption] | Right; Split; [Intros; Exists (cond_diff f x); Reflexivity | Auto with real]].
+Lemma FTCN_step1 :
+ forall (f:Differential) (a b:R),
+ Newton_integrable (fun x:R => derive_pt f x (cond_diff f x)) a b.
+intros f a b; unfold Newton_integrable in |- *; apply existT with (d1 f);
+ unfold antiderivative in |- *; intros; case (Rle_dec a b);
+ intro;
+ [ left; split; [ intros; exists (cond_diff f x); reflexivity | assumption ]
+ | right; split;
+ [ intros; exists (cond_diff f x); reflexivity | auto with real ] ].
Defined.
(* By definition, we have the Fondamental Theorem of Calculus *)
-Lemma FTC_Newton : (f:Differential;a,b:R) (NewtonInt [x:R](derive_pt f x (cond_diff f x)) a b (FTCN_step1 f a b))==``(f b)-(f a)``.
-Intros; Unfold NewtonInt; Reflexivity.
+Lemma FTC_Newton :
+ forall (f:Differential) (a b:R),
+ NewtonInt (fun x:R => derive_pt f x (cond_diff f x)) a b
+ (FTCN_step1 f a b) = f b - f a.
+intros; unfold NewtonInt in |- *; reflexivity.
Qed.
(* $\int_a^a f$ exists forall a:R and f:R->R *)
-Lemma NewtonInt_P1 : (f:R->R;a:R) (Newton_integrable f a a).
-Intros f a; Unfold Newton_integrable; Apply existTT with (mult_fct (fct_cte (f a)) id); Left; Unfold antiderivative; Split.
-Intros; Assert H1 : (derivable_pt (mult_fct (fct_cte (f a)) id) x).
-Apply derivable_pt_mult.
-Apply derivable_pt_const.
-Apply derivable_pt_id.
-Exists H1; Assert H2 : x==a.
-Elim H; Intros; Apply Rle_antisym; Assumption.
-Symmetry; Apply derive_pt_eq_0; Replace (f x) with ``0*(id x)+(fct_cte (f a) x)*1``; [Apply (derivable_pt_lim_mult (fct_cte (f a)) id x); [Apply derivable_pt_lim_const | Apply derivable_pt_lim_id] | Unfold id fct_cte; Rewrite H2; Ring].
-Right; Reflexivity.
+Lemma NewtonInt_P1 : forall (f:R -> R) (a:R), Newton_integrable f a a.
+intros f a; unfold Newton_integrable in |- *;
+ apply existT with (fct_cte (f a) * id)%F; left;
+ unfold antiderivative in |- *; split.
+intros; assert (H1 : derivable_pt (fct_cte (f a) * id) x).
+apply derivable_pt_mult.
+apply derivable_pt_const.
+apply derivable_pt_id.
+exists H1; assert (H2 : x = a).
+elim H; intros; apply Rle_antisym; assumption.
+symmetry in |- *; apply derive_pt_eq_0;
+ replace (f x) with (0 * id x + fct_cte (f a) x * 1);
+ [ apply (derivable_pt_lim_mult (fct_cte (f a)) id x);
+ [ apply derivable_pt_lim_const | apply derivable_pt_lim_id ]
+ | unfold id, fct_cte in |- *; rewrite H2; ring ].
+right; reflexivity.
Defined.
(* $\int_a^a f = 0$ *)
-Lemma NewtonInt_P2 : (f:R->R;a:R) ``(NewtonInt f a a (NewtonInt_P1 f a))==0``.
-Intros; Unfold NewtonInt; Simpl; Unfold mult_fct fct_cte id; Ring.
+Lemma NewtonInt_P2 :
+ forall (f:R -> R) (a:R), NewtonInt f a a (NewtonInt_P1 f a) = 0.
+intros; unfold NewtonInt in |- *; simpl in |- *;
+ unfold mult_fct, fct_cte, id in |- *; ring.
Qed.
(* If $\int_a^b f$ exists, then $\int_b^a f$ exists too *)
-Lemma NewtonInt_P3 : (f:R->R;a,b:R;X:(Newton_integrable f a b)) (Newton_integrable f b a).
-Unfold Newton_integrable; Intros; Elim X; Intros g H; Apply existTT with g; Tauto.
+Lemma NewtonInt_P3 :
+ forall (f:R -> R) (a b:R) (X:Newton_integrable f a b),
+ Newton_integrable f b a.
+unfold Newton_integrable in |- *; intros; elim X; intros g H;
+ apply existT with g; tauto.
Defined.
(* $\int_a^b f = -\int_b^a f$ *)
-Lemma NewtonInt_P4 : (f:R->R;a,b:R;pr:(Newton_integrable f a b)) ``(NewtonInt f a b pr)==-(NewtonInt f b a (NewtonInt_P3 f a b pr))``.
-Intros; Unfold Newton_integrable in pr; Elim pr; Intros; Elim p; Intro.
-Unfold NewtonInt; Case (NewtonInt_P3 f a b (existTT R->R [g:(R->R)](antiderivative f g a b)\/(antiderivative f g b a) x p)).
-Intros; Elim o; Intro.
-Unfold antiderivative in H0; Elim H0; Intros; Elim H2; Intro.
-Unfold antiderivative in H; Elim H; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H5 H3)).
-Rewrite H3; Ring.
-Assert H1 := (antiderivative_Ucte f x x0 a b H H0); Elim H1; Intros; Unfold antiderivative in H0; Elim H0; Clear H0; Intros _ H0.
-Assert H3 : ``a<=a<=b``.
-Split; [Right; Reflexivity | Assumption].
-Assert H4 : ``a<=b<=b``.
-Split; [Assumption | Right; Reflexivity].
-Assert H5 := (H2 ? H3); Assert H6 := (H2 ? H4); Rewrite H5; Rewrite H6; Ring.
-Unfold NewtonInt; Case (NewtonInt_P3 f a b (existTT R->R [g:(R->R)](antiderivative f g a b)\/(antiderivative f g b a) x p)); Intros; Elim o; Intro.
-Assert H1 := (antiderivative_Ucte f x x0 b a H H0); Elim H1; Intros; Unfold antiderivative in H0; Elim H0; Clear H0; Intros _ H0.
-Assert H3 : ``b<=a<=a``.
-Split; [Assumption | Right; Reflexivity].
-Assert H4 : ``b<=b<=a``.
-Split; [Right; Reflexivity | Assumption].
-Assert H5 := (H2 ? H3); Assert H6 := (H2 ? H4); Rewrite H5; Rewrite H6; Ring.
-Unfold antiderivative in H0; Elim H0; Intros; Elim H2; Intro.
-Unfold antiderivative in H; Elim H; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H5 H3)).
-Rewrite H3; Ring.
+Lemma NewtonInt_P4 :
+ forall (f:R -> R) (a b:R) (pr:Newton_integrable f a b),
+ NewtonInt f a b pr = - NewtonInt f b a (NewtonInt_P3 f a b pr).
+intros; unfold Newton_integrable in pr; elim pr; intros; elim p; intro.
+unfold NewtonInt in |- *;
+ case
+ (NewtonInt_P3 f a b
+ (existT
+ (fun g:R -> R => antiderivative f g a b \/ antiderivative f g b a) x
+ p)).
+intros; elim o; intro.
+unfold antiderivative in H0; elim H0; intros; elim H2; intro.
+unfold antiderivative in H; elim H; intros;
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H5 H3)).
+rewrite H3; ring.
+assert (H1 := antiderivative_Ucte f x x0 a b H H0); elim H1; intros;
+ unfold antiderivative in H0; elim H0; clear H0; intros _ H0.
+assert (H3 : a <= a <= b).
+split; [ right; reflexivity | assumption ].
+assert (H4 : a <= b <= b).
+split; [ assumption | right; reflexivity ].
+assert (H5 := H2 _ H3); assert (H6 := H2 _ H4); rewrite H5; rewrite H6; ring.
+unfold NewtonInt in |- *;
+ case
+ (NewtonInt_P3 f a b
+ (existT
+ (fun g:R -> R => antiderivative f g a b \/ antiderivative f g b a) x
+ p)); intros; elim o; intro.
+assert (H1 := antiderivative_Ucte f x x0 b a H H0); elim H1; intros;
+ unfold antiderivative in H0; elim H0; clear H0; intros _ H0.
+assert (H3 : b <= a <= a).
+split; [ assumption | right; reflexivity ].
+assert (H4 : b <= b <= a).
+split; [ right; reflexivity | assumption ].
+assert (H5 := H2 _ H3); assert (H6 := H2 _ H4); rewrite H5; rewrite H6; ring.
+unfold antiderivative in H0; elim H0; intros; elim H2; intro.
+unfold antiderivative in H; elim H; intros;
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H5 H3)).
+rewrite H3; ring.
Qed.
(* The set of Newton integrable functions is a vectorial space *)
-Lemma NewtonInt_P5 : (f,g:R->R;l,a,b:R) (Newton_integrable f a b) -> (Newton_integrable g a b) -> (Newton_integrable [x:R]``l*(f x)+(g x)`` a b).
-Unfold Newton_integrable; Intros; Elim X; Intros; Elim X0; Intros; Exists [y:R]``l*(x y)+(x0 y)``.
-Elim p; Intro.
-Elim p0; Intro.
-Left; Unfold antiderivative; Unfold antiderivative in H H0; Elim H; Clear H; Intros; Elim H0; Clear H0; Intros H0 _.
-Split.
-Intros; Elim (H ? H2); Elim (H0 ? H2); Intros.
-Assert H5 : (derivable_pt [y:R]``l*(x y)+(x0 y)`` x1).
-Reg.
-Exists H5; Symmetry; Reg; Rewrite <- H3; Rewrite <- H4; Reflexivity.
-Assumption.
-Unfold antiderivative in H H0; Elim H; Elim H0; Intros; Elim H4; Intro.
-Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? H5 H2)).
-Left; Rewrite <- H5; Unfold antiderivative; Split.
-Intros; Elim H6; Intros; Assert H9 : ``x1==a``.
-Apply Rle_antisym; Assumption.
-Assert H10 : ``a<=x1<=b``.
-Split; Right; [Symmetry; Assumption | Rewrite <- H5; Assumption].
-Assert H11 : ``b<=x1<=a``.
-Split; Right; [Rewrite <- H5; Symmetry; Assumption | Assumption].
-Assert H12 : (derivable_pt x x1).
-Unfold derivable_pt; Exists (f x1); Elim (H3 ? H10); Intros; EApply derive_pt_eq_1; Symmetry; Apply H12.
-Assert H13 : (derivable_pt x0 x1).
-Unfold derivable_pt; Exists (g x1); Elim (H1 ? H11); Intros; EApply derive_pt_eq_1; Symmetry; Apply H13.
-Assert H14 : (derivable_pt [y:R]``l*(x y)+(x0 y)`` x1).
-Reg.
-Exists H14; Symmetry; Reg.
-Assert H15 : ``(derive_pt x0 x1 H13)==(g x1)``.
-Elim (H1 ? H11); Intros; Rewrite H15; Apply pr_nu.
-Assert H16 : ``(derive_pt x x1 H12)==(f x1)``.
-Elim (H3 ? H10); Intros; Rewrite H16; Apply pr_nu.
-Rewrite H15; Rewrite H16; Ring.
-Right; Reflexivity.
-Elim p0; Intro.
-Unfold antiderivative in H H0; Elim H; Elim H0; Intros; Elim H4; Intro.
-Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? H5 H2)).
-Left; Rewrite H5; Unfold antiderivative; Split.
-Intros; Elim H6; Intros; Assert H9 : ``x1==a``.
-Apply Rle_antisym; Assumption.
-Assert H10 : ``a<=x1<=b``.
-Split; Right; [Symmetry; Assumption | Rewrite H5; Assumption].
-Assert H11 : ``b<=x1<=a``.
-Split; Right; [Rewrite H5; Symmetry; Assumption | Assumption].
-Assert H12 : (derivable_pt x x1).
-Unfold derivable_pt; Exists (f x1); Elim (H3 ? H11); Intros; EApply derive_pt_eq_1; Symmetry; Apply H12.
-Assert H13 : (derivable_pt x0 x1).
-Unfold derivable_pt; Exists (g x1); Elim (H1 ? H10); Intros; EApply derive_pt_eq_1; Symmetry; Apply H13.
-Assert H14 : (derivable_pt [y:R]``l*(x y)+(x0 y)`` x1).
-Reg.
-Exists H14; Symmetry; Reg.
-Assert H15 : ``(derive_pt x0 x1 H13)==(g x1)``.
-Elim (H1 ? H10); Intros; Rewrite H15; Apply pr_nu.
-Assert H16 : ``(derive_pt x x1 H12)==(f x1)``.
-Elim (H3 ? H11); Intros; Rewrite H16; Apply pr_nu.
-Rewrite H15; Rewrite H16; Ring.
-Right; Reflexivity.
-Right; Unfold antiderivative; Unfold antiderivative in H H0; Elim H; Clear H; Intros; Elim H0; Clear H0; Intros H0 _; Split.
-Intros; Elim (H ? H2); Elim (H0 ? H2); Intros.
-Assert H5 : (derivable_pt [y:R]``l*(x y)+(x0 y)`` x1).
-Reg.
-Exists H5; Symmetry; Reg; Rewrite <- H3; Rewrite <- H4; Reflexivity.
-Assumption.
+Lemma NewtonInt_P5 :
+ forall (f g:R -> R) (l a b:R),
+ Newton_integrable f a b ->
+ Newton_integrable g a b ->
+ Newton_integrable (fun x:R => l * f x + g x) a b.
+unfold Newton_integrable in |- *; intros; elim X; intros; elim X0; intros;
+ exists (fun y:R => l * x y + x0 y).
+elim p; intro.
+elim p0; intro.
+left; unfold antiderivative in |- *; unfold antiderivative in H, H0; elim H;
+ clear H; intros; elim H0; clear H0; intros H0 _.
+split.
+intros; elim (H _ H2); elim (H0 _ H2); intros.
+assert (H5 : derivable_pt (fun y:R => l * x y + x0 y) x1).
+reg.
+exists H5; symmetry in |- *; reg; rewrite <- H3; rewrite <- H4; reflexivity.
+assumption.
+unfold antiderivative in H, H0; elim H; elim H0; intros; elim H4; intro.
+elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H5 H2)).
+left; rewrite <- H5; unfold antiderivative in |- *; split.
+intros; elim H6; intros; assert (H9 : x1 = a).
+apply Rle_antisym; assumption.
+assert (H10 : a <= x1 <= b).
+split; right; [ symmetry in |- *; assumption | rewrite <- H5; assumption ].
+assert (H11 : b <= x1 <= a).
+split; right; [ rewrite <- H5; symmetry in |- *; assumption | assumption ].
+assert (H12 : derivable_pt x x1).
+unfold derivable_pt in |- *; exists (f x1); elim (H3 _ H10); intros;
+ eapply derive_pt_eq_1; symmetry in |- *; apply H12.
+assert (H13 : derivable_pt x0 x1).
+unfold derivable_pt in |- *; exists (g x1); elim (H1 _ H11); intros;
+ eapply derive_pt_eq_1; symmetry in |- *; apply H13.
+assert (H14 : derivable_pt (fun y:R => l * x y + x0 y) x1).
+reg.
+exists H14; symmetry in |- *; reg.
+assert (H15 : derive_pt x0 x1 H13 = g x1).
+elim (H1 _ H11); intros; rewrite H15; apply pr_nu.
+assert (H16 : derive_pt x x1 H12 = f x1).
+elim (H3 _ H10); intros; rewrite H16; apply pr_nu.
+rewrite H15; rewrite H16; ring.
+right; reflexivity.
+elim p0; intro.
+unfold antiderivative in H, H0; elim H; elim H0; intros; elim H4; intro.
+elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H5 H2)).
+left; rewrite H5; unfold antiderivative in |- *; split.
+intros; elim H6; intros; assert (H9 : x1 = a).
+apply Rle_antisym; assumption.
+assert (H10 : a <= x1 <= b).
+split; right; [ symmetry in |- *; assumption | rewrite H5; assumption ].
+assert (H11 : b <= x1 <= a).
+split; right; [ rewrite H5; symmetry in |- *; assumption | assumption ].
+assert (H12 : derivable_pt x x1).
+unfold derivable_pt in |- *; exists (f x1); elim (H3 _ H11); intros;
+ eapply derive_pt_eq_1; symmetry in |- *; apply H12.
+assert (H13 : derivable_pt x0 x1).
+unfold derivable_pt in |- *; exists (g x1); elim (H1 _ H10); intros;
+ eapply derive_pt_eq_1; symmetry in |- *; apply H13.
+assert (H14 : derivable_pt (fun y:R => l * x y + x0 y) x1).
+reg.
+exists H14; symmetry in |- *; reg.
+assert (H15 : derive_pt x0 x1 H13 = g x1).
+elim (H1 _ H10); intros; rewrite H15; apply pr_nu.
+assert (H16 : derive_pt x x1 H12 = f x1).
+elim (H3 _ H11); intros; rewrite H16; apply pr_nu.
+rewrite H15; rewrite H16; ring.
+right; reflexivity.
+right; unfold antiderivative in |- *; unfold antiderivative in H, H0; elim H;
+ clear H; intros; elim H0; clear H0; intros H0 _; split.
+intros; elim (H _ H2); elim (H0 _ H2); intros.
+assert (H5 : derivable_pt (fun y:R => l * x y + x0 y) x1).
+reg.
+exists H5; symmetry in |- *; reg; rewrite <- H3; rewrite <- H4; reflexivity.
+assumption.
Defined.
(**********)
-Lemma antiderivative_P1 : (f,g,F,G:R->R;l,a,b:R) (antiderivative f F a b) -> (antiderivative g G a b) -> (antiderivative [x:R]``l*(f x)+(g x)`` [x:R]``l*(F x)+(G x)`` a b).
-Unfold antiderivative; Intros; Elim H; Elim H0; Clear H H0; Intros; Split.
-Intros; Elim (H ? H3); Elim (H1 ? H3); Intros.
-Assert H6 : (derivable_pt [x:R]``l*(F x)+(G x)`` x).
-Reg.
-Exists H6; Symmetry; Reg; Rewrite <- H4; Rewrite <- H5; Ring.
-Assumption.
+Lemma antiderivative_P1 :
+ forall (f g F G:R -> R) (l a b:R),
+ antiderivative f F a b ->
+ antiderivative g G a b ->
+ antiderivative (fun x:R => l * f x + g x) (fun x:R => l * F x + G x) a b.
+unfold antiderivative in |- *; intros; elim H; elim H0; clear H H0; intros;
+ split.
+intros; elim (H _ H3); elim (H1 _ H3); intros.
+assert (H6 : derivable_pt (fun x:R => l * F x + G x) x).
+reg.
+exists H6; symmetry in |- *; reg; rewrite <- H4; rewrite <- H5; ring.
+assumption.
Qed.
(* $\int_a^b \lambda f + g = \lambda \int_a^b f + \int_a^b f *)
-Lemma NewtonInt_P6 : (f,g:R->R;l,a,b:R;pr1:(Newton_integrable f a b);pr2:(Newton_integrable g a b)) (NewtonInt [x:R]``l*(f x)+(g x)`` a b (NewtonInt_P5 f g l a b pr1 pr2))==``l*(NewtonInt f a b pr1)+(NewtonInt g a b pr2)``.
-Intros f g l a b pr1 pr2; Unfold NewtonInt; Case (NewtonInt_P5 f g l a b pr1 pr2); Intros; Case pr1; Intros; Case pr2; Intros; Case (total_order_T a b); Intro.
-Elim s; Intro.
-Elim o; Intro.
-Elim o0; Intro.
-Elim o1; Intro.
-Assert H2 := (antiderivative_P1 f g x0 x1 l a b H0 H1); Assert H3 := (antiderivative_Ucte ? ? ? ? ? H H2); Elim H3; Intros; Assert H5 : ``a<=a<=b``.
-Split; [Right; Reflexivity | Left; Assumption].
-Assert H6 : ``a<=b<=b``.
-Split; [Left; Assumption | Right; Reflexivity].
-Assert H7 := (H4 ? H5); Assert H8 := (H4 ? H6); Rewrite H7; Rewrite H8; Ring.
-Unfold antiderivative in H1; Elim H1; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H3 a0)).
-Unfold antiderivative in H0; Elim H0; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H2 a0)).
-Unfold antiderivative in H; Elim H; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H1 a0)).
-Rewrite b0; Ring.
-Elim o; Intro.
-Unfold antiderivative in H; Elim H; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H1 r)).
-Elim o0; Intro.
-Unfold antiderivative in H0; Elim H0; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H2 r)).
-Elim o1; Intro.
-Unfold antiderivative in H1; Elim H1; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H3 r)).
-Assert H2 := (antiderivative_P1 f g x0 x1 l b a H0 H1); Assert H3 := (antiderivative_Ucte ? ? ? ? ? H H2); Elim H3; Intros; Assert H5 : ``b<=a<=a``.
-Split; [Left; Assumption | Right; Reflexivity].
-Assert H6 : ``b<=b<=a``.
-Split; [Right; Reflexivity | Left; Assumption].
-Assert H7 := (H4 ? H5); Assert H8 := (H4 ? H6); Rewrite H7; Rewrite H8; Ring.
+Lemma NewtonInt_P6 :
+ forall (f g:R -> R) (l a b:R) (pr1:Newton_integrable f a b)
+ (pr2:Newton_integrable g a b),
+ NewtonInt (fun x:R => l * f x + g x) a b (NewtonInt_P5 f g l a b pr1 pr2) =
+ l * NewtonInt f a b pr1 + NewtonInt g a b pr2.
+intros f g l a b pr1 pr2; unfold NewtonInt in |- *;
+ case (NewtonInt_P5 f g l a b pr1 pr2); intros; case pr1;
+ intros; case pr2; intros; case (total_order_T a b);
+ intro.
+elim s; intro.
+elim o; intro.
+elim o0; intro.
+elim o1; intro.
+assert (H2 := antiderivative_P1 f g x0 x1 l a b H0 H1);
+ assert (H3 := antiderivative_Ucte _ _ _ _ _ H H2);
+ elim H3; intros; assert (H5 : a <= a <= b).
+split; [ right; reflexivity | left; assumption ].
+assert (H6 : a <= b <= b).
+split; [ left; assumption | right; reflexivity ].
+assert (H7 := H4 _ H5); assert (H8 := H4 _ H6); rewrite H7; rewrite H8; ring.
+unfold antiderivative in H1; elim H1; intros;
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H3 a0)).
+unfold antiderivative in H0; elim H0; intros;
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a0)).
+unfold antiderivative in H; elim H; intros;
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 a0)).
+rewrite b0; ring.
+elim o; intro.
+unfold antiderivative in H; elim H; intros;
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 r)).
+elim o0; intro.
+unfold antiderivative in H0; elim H0; intros;
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 r)).
+elim o1; intro.
+unfold antiderivative in H1; elim H1; intros;
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H3 r)).
+assert (H2 := antiderivative_P1 f g x0 x1 l b a H0 H1);
+ assert (H3 := antiderivative_Ucte _ _ _ _ _ H H2);
+ elim H3; intros; assert (H5 : b <= a <= a).
+split; [ left; assumption | right; reflexivity ].
+assert (H6 : b <= b <= a).
+split; [ right; reflexivity | left; assumption ].
+assert (H7 := H4 _ H5); assert (H8 := H4 _ H6); rewrite H7; rewrite H8; ring.
Qed.
-Lemma antiderivative_P2 : (f,F0,F1:R->R;a,b,c:R) (antiderivative f F0 a b) -> (antiderivative f F1 b c) -> (antiderivative f [x:R](Cases (total_order_Rle x b) of (leftT _) => (F0 x) | (rightT _) => ``(F1 x)+((F0 b)-(F1 b))`` end) a c).
-Unfold antiderivative; Intros; Elim H; Clear H; Intros; Elim H0; Clear H0; Intros; Split.
-2:Apply Rle_trans with b; Assumption.
-Intros; Elim H3; Clear H3; Intros; Case (total_order_T x b); Intro.
-Elim s; Intro.
-Assert H5 : ``a<=x<=b``.
-Split; [Assumption | Left; Assumption].
-Assert H6 := (H ? H5); Elim H6; Clear H6; Intros; Assert H7 : (derivable_pt_lim [x:R](Cases (total_order_Rle x b) of (leftT _) => (F0 x) | (rightT _) => ``(F1 x)+((F0 b)-(F1 b))`` end) x (f x)).
-Unfold derivable_pt_lim; Assert H7 : ``(derive_pt F0 x x0)==(f x)``.
-Symmetry; Assumption.
-Assert H8 := (derive_pt_eq_1 F0 x (f x) x0 H7); Unfold derivable_pt_lim in H8; Intros; Elim (H8 ? H9); Intros; Pose D := (Rmin x1 ``b-x``).
-Assert H11 : ``0<D``.
-Unfold D; Unfold Rmin; Case (total_order_Rle x1 ``b-x``); Intro.
-Apply (cond_pos x1).
-Apply Rlt_Rminus; Assumption.
-Exists (mkposreal ? H11); Intros; Case (total_order_Rle x b); Intro.
-Case (total_order_Rle ``x+h`` b); Intro.
-Apply H10.
-Assumption.
-Apply Rlt_le_trans with D; [Assumption | Unfold D; Apply Rmin_l].
-Elim n; Left; Apply Rlt_le_trans with ``x+D``.
-Apply Rlt_compatibility; Apply Rle_lt_trans with (Rabsolu h).
-Apply Rle_Rabsolu.
-Apply H13.
-Apply Rle_anti_compatibility with ``-x``; Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Rewrite Rplus_sym; Unfold D; Apply Rmin_r.
-Elim n; Left; Assumption.
-Assert H8 : (derivable_pt [x:R]Cases (total_order_Rle x b) of (leftT _) => (F0 x) | (rightT _) => ``(F1 x)+((F0 b)-(F1 b))`` end x).
-Unfold derivable_pt; Apply Specif.existT with (f x); Apply H7.
-Exists H8; Symmetry; Apply derive_pt_eq_0; Apply H7.
-Assert H5 : ``a<=x<=b``.
-Split; [Assumption | Right; Assumption].
-Assert H6 : ``b<=x<=c``.
-Split; [Right; Symmetry; Assumption | Assumption].
-Elim (H ? H5); Elim (H0 ? H6); Intros; Assert H9 : (derive_pt F0 x x1)==(f x).
-Symmetry; Assumption.
-Assert H10 : (derive_pt F1 x x0)==(f x).
-Symmetry; Assumption.
-Assert H11 := (derive_pt_eq_1 F0 x (f x) x1 H9); Assert H12 := (derive_pt_eq_1 F1 x (f x) x0 H10); Assert H13 : (derivable_pt_lim [x:R]Cases (total_order_Rle x b) of (leftT _) => (F0 x) | (rightT _) => ``(F1 x)+((F0 b)-(F1 b))`` end x (f x)).
-Unfold derivable_pt_lim; Unfold derivable_pt_lim in H11 H12; Intros; Elim (H11 ? H13); Elim (H12 ? H13); Intros; Pose D := (Rmin x2 x3); Assert H16 : ``0<D``.
-Unfold D; Unfold Rmin; Case (total_order_Rle x2 x3); Intro.
-Apply (cond_pos x2).
-Apply (cond_pos x3).
-Exists (mkposreal ? H16); Intros; Case (total_order_Rle x b); Intro.
-Case (total_order_Rle ``x+h`` b); Intro.
-Apply H15.
-Assumption.
-Apply Rlt_le_trans with D; [Assumption | Unfold D; Apply Rmin_r].
-Replace ``(F1 (x+h))+((F0 b)-(F1 b))-(F0 x)`` with ``(F1 (x+h))-(F1 x)``.
-Apply H14.
-Assumption.
-Apply Rlt_le_trans with D; [Assumption | Unfold D; Apply Rmin_l].
-Rewrite b0; Ring.
-Elim n; Right; Assumption.
-Assert H14 : (derivable_pt [x:R](Cases (total_order_Rle x b) of (leftT _) => (F0 x) | (rightT _) => ``(F1 x)+((F0 b)-(F1 b))`` end) x).
-Unfold derivable_pt; Apply Specif.existT with (f x); Apply H13.
-Exists H14; Symmetry; Apply derive_pt_eq_0; Apply H13.
-Assert H5 : ``b<=x<=c``.
-Split; [Left; Assumption | Assumption].
-Assert H6 := (H0 ? H5); Elim H6; Clear H6; Intros; Assert H7 : (derivable_pt_lim [x:R]Cases (total_order_Rle x b) of (leftT _) => (F0 x) | (rightT _) => ``(F1 x)+((F0 b)-(F1 b))`` end x (f x)).
-Unfold derivable_pt_lim; Assert H7 : ``(derive_pt F1 x x0)==(f x)``.
-Symmetry; Assumption.
-Assert H8 := (derive_pt_eq_1 F1 x (f x) x0 H7); Unfold derivable_pt_lim in H8; Intros; Elim (H8 ? H9); Intros; Pose D := (Rmin x1 ``x-b``); Assert H11 : ``0<D``.
-Unfold D; Unfold Rmin; Case (total_order_Rle x1 ``x-b``); Intro.
-Apply (cond_pos x1).
-Apply Rlt_Rminus; Assumption.
-Exists (mkposreal ? H11); Intros; Case (total_order_Rle x b); Intro.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r0 r)).
-Case (total_order_Rle ``x+h`` b); Intro.
-Cut ``b<x+h``.
-Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r0 H14)).
-Apply Rlt_anti_compatibility with ``-h-b``; Replace ``-h-b+b`` with ``-h``; [Idtac | Ring]; Replace ``-h-b+(x+h)`` with ``x-b``; [Idtac | Ring]; Apply Rle_lt_trans with (Rabsolu h).
-Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu.
-Apply Rlt_le_trans with D.
-Apply H13.
-Unfold D; Apply Rmin_r.
-Replace ``((F1 (x+h))+((F0 b)-(F1 b)))-((F1 x)+((F0 b)-(F1 b)))`` with ``(F1 (x+h))-(F1 x)``; [Idtac | Ring]; Apply H10.
-Assumption.
-Apply Rlt_le_trans with D.
-Assumption.
-Unfold D; Apply Rmin_l.
-Assert H8 : (derivable_pt [x:R]Cases (total_order_Rle x b) of (leftT _) => (F0 x) | (rightT _) => ``(F1 x)+((F0 b)-(F1 b))`` end x).
-Unfold derivable_pt; Apply Specif.existT with (f x); Apply H7.
-Exists H8; Symmetry; Apply derive_pt_eq_0; Apply H7.
+Lemma antiderivative_P2 :
+ forall (f F0 F1:R -> R) (a b c:R),
+ antiderivative f F0 a b ->
+ antiderivative f F1 b c ->
+ antiderivative f
+ (fun x:R =>
+ match Rle_dec x b with
+ | left _ => F0 x
+ | right _ => F1 x + (F0 b - F1 b)
+ end) a c.
+unfold antiderivative in |- *; intros; elim H; clear H; intros; elim H0;
+ clear H0; intros; split.
+2: apply Rle_trans with b; assumption.
+intros; elim H3; clear H3; intros; case (total_order_T x b); intro.
+elim s; intro.
+assert (H5 : a <= x <= b).
+split; [ assumption | left; assumption ].
+assert (H6 := H _ H5); elim H6; clear H6; intros;
+ assert
+ (H7 :
+ derivable_pt_lim
+ (fun x:R =>
+ match Rle_dec x b with
+ | left _ => F0 x
+ | right _ => F1 x + (F0 b - F1 b)
+ end) x (f x)).
+unfold derivable_pt_lim in |- *; assert (H7 : derive_pt F0 x x0 = f x).
+symmetry in |- *; assumption.
+assert (H8 := derive_pt_eq_1 F0 x (f x) x0 H7); unfold derivable_pt_lim in H8;
+ intros; elim (H8 _ H9); intros; pose (D := Rmin x1 (b - x)).
+assert (H11 : 0 < D).
+unfold D in |- *; unfold Rmin in |- *; case (Rle_dec x1 (b - x)); intro.
+apply (cond_pos x1).
+apply Rlt_Rminus; assumption.
+exists (mkposreal _ H11); intros; case (Rle_dec x b); intro.
+case (Rle_dec (x + h) b); intro.
+apply H10.
+assumption.
+apply Rlt_le_trans with D; [ assumption | unfold D in |- *; apply Rmin_l ].
+elim n; left; apply Rlt_le_trans with (x + D).
+apply Rplus_lt_compat_l; apply Rle_lt_trans with (Rabs h).
+apply RRle_abs.
+apply H13.
+apply Rplus_le_reg_l with (- x); rewrite <- Rplus_assoc; rewrite Rplus_opp_l;
+ rewrite Rplus_0_l; rewrite Rplus_comm; unfold D in |- *;
+ apply Rmin_r.
+elim n; left; assumption.
+assert
+ (H8 :
+ derivable_pt
+ (fun x:R =>
+ match Rle_dec x b with
+ | left _ => F0 x
+ | right _ => F1 x + (F0 b - F1 b)
+ end) x).
+unfold derivable_pt in |- *; apply existT with (f x); apply H7.
+exists H8; symmetry in |- *; apply derive_pt_eq_0; apply H7.
+assert (H5 : a <= x <= b).
+split; [ assumption | right; assumption ].
+assert (H6 : b <= x <= c).
+split; [ right; symmetry in |- *; assumption | assumption ].
+elim (H _ H5); elim (H0 _ H6); intros; assert (H9 : derive_pt F0 x x1 = f x).
+symmetry in |- *; assumption.
+assert (H10 : derive_pt F1 x x0 = f x).
+symmetry in |- *; assumption.
+assert (H11 := derive_pt_eq_1 F0 x (f x) x1 H9);
+ assert (H12 := derive_pt_eq_1 F1 x (f x) x0 H10);
+ assert
+ (H13 :
+ derivable_pt_lim
+ (fun x:R =>
+ match Rle_dec x b with
+ | left _ => F0 x
+ | right _ => F1 x + (F0 b - F1 b)
+ end) x (f x)).
+unfold derivable_pt_lim in |- *; unfold derivable_pt_lim in H11, H12; intros;
+ elim (H11 _ H13); elim (H12 _ H13); intros; pose (D := Rmin x2 x3);
+ assert (H16 : 0 < D).
+unfold D in |- *; unfold Rmin in |- *; case (Rle_dec x2 x3); intro.
+apply (cond_pos x2).
+apply (cond_pos x3).
+exists (mkposreal _ H16); intros; case (Rle_dec x b); intro.
+case (Rle_dec (x + h) b); intro.
+apply H15.
+assumption.
+apply Rlt_le_trans with D; [ assumption | unfold D in |- *; apply Rmin_r ].
+replace (F1 (x + h) + (F0 b - F1 b) - F0 x) with (F1 (x + h) - F1 x).
+apply H14.
+assumption.
+apply Rlt_le_trans with D; [ assumption | unfold D in |- *; apply Rmin_l ].
+rewrite b0; ring.
+elim n; right; assumption.
+assert
+ (H14 :
+ derivable_pt
+ (fun x:R =>
+ match Rle_dec x b with
+ | left _ => F0 x
+ | right _ => F1 x + (F0 b - F1 b)
+ end) x).
+unfold derivable_pt in |- *; apply existT with (f x); apply H13.
+exists H14; symmetry in |- *; apply derive_pt_eq_0; apply H13.
+assert (H5 : b <= x <= c).
+split; [ left; assumption | assumption ].
+assert (H6 := H0 _ H5); elim H6; clear H6; intros;
+ assert
+ (H7 :
+ derivable_pt_lim
+ (fun x:R =>
+ match Rle_dec x b with
+ | left _ => F0 x
+ | right _ => F1 x + (F0 b - F1 b)
+ end) x (f x)).
+unfold derivable_pt_lim in |- *; assert (H7 : derive_pt F1 x x0 = f x).
+symmetry in |- *; assumption.
+assert (H8 := derive_pt_eq_1 F1 x (f x) x0 H7); unfold derivable_pt_lim in H8;
+ intros; elim (H8 _ H9); intros; pose (D := Rmin x1 (x - b));
+ assert (H11 : 0 < D).
+unfold D in |- *; unfold Rmin in |- *; case (Rle_dec x1 (x - b)); intro.
+apply (cond_pos x1).
+apply Rlt_Rminus; assumption.
+exists (mkposreal _ H11); intros; case (Rle_dec x b); intro.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 r)).
+case (Rle_dec (x + h) b); intro.
+cut (b < x + h).
+intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 H14)).
+apply Rplus_lt_reg_r with (- h - b); replace (- h - b + b) with (- h);
+ [ idtac | ring ]; replace (- h - b + (x + h)) with (x - b);
+ [ idtac | ring ]; apply Rle_lt_trans with (Rabs h).
+rewrite <- Rabs_Ropp; apply RRle_abs.
+apply Rlt_le_trans with D.
+apply H13.
+unfold D in |- *; apply Rmin_r.
+replace (F1 (x + h) + (F0 b - F1 b) - (F1 x + (F0 b - F1 b))) with
+ (F1 (x + h) - F1 x); [ idtac | ring ]; apply H10.
+assumption.
+apply Rlt_le_trans with D.
+assumption.
+unfold D in |- *; apply Rmin_l.
+assert
+ (H8 :
+ derivable_pt
+ (fun x:R =>
+ match Rle_dec x b with
+ | left _ => F0 x
+ | right _ => F1 x + (F0 b - F1 b)
+ end) x).
+unfold derivable_pt in |- *; apply existT with (f x); apply H7.
+exists H8; symmetry in |- *; apply derive_pt_eq_0; apply H7.
Qed.
-Lemma antiderivative_P3 : (f,F0,F1:R->R;a,b,c:R) (antiderivative f F0 a b) -> (antiderivative f F1 c b) -> (antiderivative f F1 c a)\/(antiderivative f F0 a c).
-Intros; Unfold antiderivative in H H0; Elim H; Clear H; Elim H0; Clear H0; Intros; Case (total_order_T a c); Intro.
-Elim s; Intro.
-Right; Unfold antiderivative; Split.
-Intros; Apply H1; Elim H3; Intros; Split; [Assumption | Apply Rle_trans with c; Assumption].
-Left; Assumption.
-Right; Unfold antiderivative; Split.
-Intros; Apply H1; Elim H3; Intros; Split; [Assumption | Apply Rle_trans with c; Assumption].
-Right; Assumption.
-Left; Unfold antiderivative; Split.
-Intros; Apply H; Elim H3; Intros; Split; [Assumption | Apply Rle_trans with a; Assumption].
-Left; Assumption.
+Lemma antiderivative_P3 :
+ forall (f F0 F1:R -> R) (a b c:R),
+ antiderivative f F0 a b ->
+ antiderivative f F1 c b ->
+ antiderivative f F1 c a \/ antiderivative f F0 a c.
+intros; unfold antiderivative in H, H0; elim H; clear H; elim H0; clear H0;
+ intros; case (total_order_T a c); intro.
+elim s; intro.
+right; unfold antiderivative in |- *; split.
+intros; apply H1; elim H3; intros; split;
+ [ assumption | apply Rle_trans with c; assumption ].
+left; assumption.
+right; unfold antiderivative in |- *; split.
+intros; apply H1; elim H3; intros; split;
+ [ assumption | apply Rle_trans with c; assumption ].
+right; assumption.
+left; unfold antiderivative in |- *; split.
+intros; apply H; elim H3; intros; split;
+ [ assumption | apply Rle_trans with a; assumption ].
+left; assumption.
Qed.
-Lemma antiderivative_P4 : (f,F0,F1:R->R;a,b,c:R) (antiderivative f F0 a b) -> (antiderivative f F1 a c) -> (antiderivative f F1 b c)\/(antiderivative f F0 c b).
-Intros; Unfold antiderivative in H H0; Elim H; Clear H; Elim H0; Clear H0; Intros; Case (total_order_T c b); Intro.
-Elim s; Intro.
-Right; Unfold antiderivative; Split.
-Intros; Apply H1; Elim H3; Intros; Split; [Apply Rle_trans with c; Assumption | Assumption].
-Left; Assumption.
-Right; Unfold antiderivative; Split.
-Intros; Apply H1; Elim H3; Intros; Split; [Apply Rle_trans with c; Assumption | Assumption].
-Right; Assumption.
-Left; Unfold antiderivative; Split.
-Intros; Apply H; Elim H3; Intros; Split; [Apply Rle_trans with b; Assumption | Assumption].
-Left; Assumption.
+Lemma antiderivative_P4 :
+ forall (f F0 F1:R -> R) (a b c:R),
+ antiderivative f F0 a b ->
+ antiderivative f F1 a c ->
+ antiderivative f F1 b c \/ antiderivative f F0 c b.
+intros; unfold antiderivative in H, H0; elim H; clear H; elim H0; clear H0;
+ intros; case (total_order_T c b); intro.
+elim s; intro.
+right; unfold antiderivative in |- *; split.
+intros; apply H1; elim H3; intros; split;
+ [ apply Rle_trans with c; assumption | assumption ].
+left; assumption.
+right; unfold antiderivative in |- *; split.
+intros; apply H1; elim H3; intros; split;
+ [ apply Rle_trans with c; assumption | assumption ].
+right; assumption.
+left; unfold antiderivative in |- *; split.
+intros; apply H; elim H3; intros; split;
+ [ apply Rle_trans with b; assumption | assumption ].
+left; assumption.
Qed.
-Lemma NewtonInt_P7 : (f:R->R;a,b,c:R) ``a<b`` -> ``b<c`` -> (Newton_integrable f a b) -> (Newton_integrable f b c) -> (Newton_integrable f a c).
-Unfold Newton_integrable; Intros f a b c Hab Hbc X X0; Elim X; Clear X; Intros F0 H0; Elim X0; Clear X0; Intros F1 H1; Pose g := [x:R](Cases (total_order_Rle x b) of (leftT _) => (F0 x) | (rightT _) => ``(F1 x)+((F0 b)-(F1 b))`` end); Apply existTT with g; Left; Unfold g; Apply antiderivative_P2.
-Elim H0; Intro.
-Assumption.
-Unfold antiderivative in H; Elim H; Clear H; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H2 Hab)).
-Elim H1; Intro.
-Assumption.
-Unfold antiderivative in H; Elim H; Clear H; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H2 Hbc)).
+Lemma NewtonInt_P7 :
+ forall (f:R -> R) (a b c:R),
+ a < b ->
+ b < c ->
+ Newton_integrable f a b ->
+ Newton_integrable f b c -> Newton_integrable f a c.
+unfold Newton_integrable in |- *; intros f a b c Hab Hbc X X0; elim X;
+ clear X; intros F0 H0; elim X0; clear X0; intros F1 H1;
+ pose
+ (g :=
+ fun x:R =>
+ match Rle_dec x b with
+ | left _ => F0 x
+ | right _ => F1 x + (F0 b - F1 b)
+ end); apply existT with g; left; unfold g in |- *;
+ apply antiderivative_P2.
+elim H0; intro.
+assumption.
+unfold antiderivative in H; elim H; clear H; intros;
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 Hab)).
+elim H1; intro.
+assumption.
+unfold antiderivative in H; elim H; clear H; intros;
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 Hbc)).
Qed.
-Lemma NewtonInt_P8 : (f:(R->R); a,b,c:R) (Newton_integrable f a b) -> (Newton_integrable f b c) -> (Newton_integrable f a c).
-Intros.
-Elim X; Intros F0 H0.
-Elim X0; Intros F1 H1.
-Case (total_order_T a b); Intro.
-Elim s; Intro.
-Case (total_order_T b c); Intro.
-Elim s0; Intro.
+Lemma NewtonInt_P8 :
+ forall (f:R -> R) (a b c:R),
+ Newton_integrable f a b ->
+ Newton_integrable f b c -> Newton_integrable f a c.
+intros.
+elim X; intros F0 H0.
+elim X0; intros F1 H1.
+case (total_order_T a b); intro.
+elim s; intro.
+case (total_order_T b c); intro.
+elim s0; intro.
(* a<b & b<c *)
-Unfold Newton_integrable; Apply existTT with [x:R](Cases (total_order_Rle x b) of (leftT _) => (F0 x) | (rightT _) => ``(F1 x)+((F0 b)-(F1 b))`` end).
-Elim H0; Intro.
-Elim H1; Intro.
-Left; Apply antiderivative_P2; Assumption.
-Unfold antiderivative in H2; Elim H2; Clear H2; Intros _ H2.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H2 a1)).
-Unfold antiderivative in H; Elim H; Clear H; Intros _ H.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H a0)).
+unfold Newton_integrable in |- *;
+ apply existT with
+ (fun x:R =>
+ match Rle_dec x b with
+ | left _ => F0 x
+ | right _ => F1 x + (F0 b - F1 b)
+ end).
+elim H0; intro.
+elim H1; intro.
+left; apply antiderivative_P2; assumption.
+unfold antiderivative in H2; elim H2; clear H2; intros _ H2.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a1)).
+unfold antiderivative in H; elim H; clear H; intros _ H.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H a0)).
(* a<b & b=c *)
-Rewrite b0 in X; Apply X.
+rewrite b0 in X; apply X.
(* a<b & b>c *)
-Case (total_order_T a c); Intro.
-Elim s0; Intro.
-Unfold Newton_integrable; Apply existTT with F0.
-Left.
-Elim H1; Intro.
-Unfold antiderivative in H; Elim H; Clear H; Intros _ H.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r)).
-Elim H0; Intro.
-Assert H3 := (antiderivative_P3 f F0 F1 a b c H2 H).
-Elim H3; Intro.
-Unfold antiderivative in H4; Elim H4; Clear H4; Intros _ H4.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H4 a1)).
-Assumption.
-Unfold antiderivative in H2; Elim H2; Clear H2; Intros _ H2.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H2 a0)).
-Rewrite b0; Apply NewtonInt_P1.
-Unfold Newton_integrable; Apply existTT with F1.
-Right.
-Elim H1; Intro.
-Unfold antiderivative in H; Elim H; Clear H; Intros _ H.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r)).
-Elim H0; Intro.
-Assert H3 := (antiderivative_P3 f F0 F1 a b c H2 H).
-Elim H3; Intro.
-Assumption.
-Unfold antiderivative in H4; Elim H4; Clear H4; Intros _ H4.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H4 r0)).
-Unfold antiderivative in H2; Elim H2; Clear H2; Intros _ H2.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H2 a0)).
+case (total_order_T a c); intro.
+elim s0; intro.
+unfold Newton_integrable in |- *; apply existT with F0.
+left.
+elim H1; intro.
+unfold antiderivative in H; elim H; clear H; intros _ H.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)).
+elim H0; intro.
+assert (H3 := antiderivative_P3 f F0 F1 a b c H2 H).
+elim H3; intro.
+unfold antiderivative in H4; elim H4; clear H4; intros _ H4.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 a1)).
+assumption.
+unfold antiderivative in H2; elim H2; clear H2; intros _ H2.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a0)).
+rewrite b0; apply NewtonInt_P1.
+unfold Newton_integrable in |- *; apply existT with F1.
+right.
+elim H1; intro.
+unfold antiderivative in H; elim H; clear H; intros _ H.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)).
+elim H0; intro.
+assert (H3 := antiderivative_P3 f F0 F1 a b c H2 H).
+elim H3; intro.
+assumption.
+unfold antiderivative in H4; elim H4; clear H4; intros _ H4.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 r0)).
+unfold antiderivative in H2; elim H2; clear H2; intros _ H2.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a0)).
(* a=b *)
-Rewrite b0; Apply X0.
-Case (total_order_T b c); Intro.
-Elim s; Intro.
+rewrite b0; apply X0.
+case (total_order_T b c); intro.
+elim s; intro.
(* a>b & b<c *)
-Case (total_order_T a c); Intro.
-Elim s0; Intro.
-Unfold Newton_integrable; Apply existTT with F1.
-Left.
-Elim H1; Intro.
+case (total_order_T a c); intro.
+elim s0; intro.
+unfold Newton_integrable in |- *; apply existT with F1.
+left.
+elim H1; intro.
(*****************)
-Elim H0; Intro.
-Unfold antiderivative in H2; Elim H2; Clear H2; Intros _ H2.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H2 r)).
-Assert H3 := (antiderivative_P4 f F0 F1 b a c H2 H).
-Elim H3; Intro.
-Assumption.
-Unfold antiderivative in H4; Elim H4; Clear H4; Intros _ H4.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H4 a1)).
-Unfold antiderivative in H; Elim H; Clear H; Intros _ H.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H a0)).
-Rewrite b0; Apply NewtonInt_P1.
-Unfold Newton_integrable; Apply existTT with F0.
-Right.
-Elim H0; Intro.
-Unfold antiderivative in H; Elim H; Clear H; Intros _ H.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r)).
-Elim H1; Intro.
-Assert H3 := (antiderivative_P4 f F0 F1 b a c H H2).
-Elim H3; Intro.
-Unfold antiderivative in H4; Elim H4; Clear H4; Intros _ H4.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H4 r0)).
-Assumption.
-Unfold antiderivative in H2; Elim H2; Clear H2; Intros _ H2.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H2 a0)).
+elim H0; intro.
+unfold antiderivative in H2; elim H2; clear H2; intros _ H2.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 r)).
+assert (H3 := antiderivative_P4 f F0 F1 b a c H2 H).
+elim H3; intro.
+assumption.
+unfold antiderivative in H4; elim H4; clear H4; intros _ H4.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 a1)).
+unfold antiderivative in H; elim H; clear H; intros _ H.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H a0)).
+rewrite b0; apply NewtonInt_P1.
+unfold Newton_integrable in |- *; apply existT with F0.
+right.
+elim H0; intro.
+unfold antiderivative in H; elim H; clear H; intros _ H.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)).
+elim H1; intro.
+assert (H3 := antiderivative_P4 f F0 F1 b a c H H2).
+elim H3; intro.
+unfold antiderivative in H4; elim H4; clear H4; intros _ H4.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 r0)).
+assumption.
+unfold antiderivative in H2; elim H2; clear H2; intros _ H2.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a0)).
(* a>b & b=c *)
-Rewrite b0 in X; Apply X.
+rewrite b0 in X; apply X.
(* a>b & b>c *)
-Assert X1 := (NewtonInt_P3 f a b X).
-Assert X2 := (NewtonInt_P3 f b c X0).
-Apply NewtonInt_P3.
-Apply NewtonInt_P7 with b; Assumption.
+assert (X1 := NewtonInt_P3 f a b X).
+assert (X2 := NewtonInt_P3 f b c X0).
+apply NewtonInt_P3.
+apply NewtonInt_P7 with b; assumption.
Defined.
(* Chasles' relation *)
-Lemma NewtonInt_P9 : (f:R->R;a,b,c:R;pr1:(Newton_integrable f a b);pr2:(Newton_integrable f b c)) ``(NewtonInt f a c (NewtonInt_P8 f a b c pr1 pr2))==(NewtonInt f a b pr1)+(NewtonInt f b c pr2)``.
-Intros; Unfold NewtonInt.
-Case (NewtonInt_P8 f a b c pr1 pr2); Intros.
-Case pr1; Intros.
-Case pr2; Intros.
-Case (total_order_T a b); Intro.
-Elim s; Intro.
-Case (total_order_T b c); Intro.
-Elim s0; Intro.
+Lemma NewtonInt_P9 :
+ forall (f:R -> R) (a b c:R) (pr1:Newton_integrable f a b)
+ (pr2:Newton_integrable f b c),
+ NewtonInt f a c (NewtonInt_P8 f a b c pr1 pr2) =
+ NewtonInt f a b pr1 + NewtonInt f b c pr2.
+intros; unfold NewtonInt in |- *.
+case (NewtonInt_P8 f a b c pr1 pr2); intros.
+case pr1; intros.
+case pr2; intros.
+case (total_order_T a b); intro.
+elim s; intro.
+case (total_order_T b c); intro.
+elim s0; intro.
(* a<b & b<c *)
-Elim o0; Intro.
-Elim o1; Intro.
-Elim o; Intro.
-Assert H2 := (antiderivative_P2 f x0 x1 a b c H H0).
-Assert H3 := (antiderivative_Ucte f x [x:R]
- Cases (total_order_Rle x b) of
- (leftT _) => (x0 x)
- | (rightT _) => ``(x1 x)+((x0 b)-(x1 b))``
- end a c H1 H2).
-Elim H3; Intros.
-Assert H5 : ``a<=a<=c``.
-Split; [Right; Reflexivity | Left; Apply Rlt_trans with b; Assumption].
-Assert H6 : ``a<=c<=c``.
-Split; [Left; Apply Rlt_trans with b; Assumption | Right; Reflexivity].
-Rewrite (H4 ? H5); Rewrite (H4 ? H6).
-Case (total_order_Rle a b); Intro.
-Case (total_order_Rle c b); Intro.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r0 a1)).
-Ring.
-Elim n; Left; Assumption.
-Unfold antiderivative in H1; Elim H1; Clear H1; Intros _ H1.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H1 (Rlt_trans ? ? ? a0 a1))).
-Unfold antiderivative in H0; Elim H0; Clear H0; Intros _ H0.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H0 a1)).
-Unfold antiderivative in H; Elim H; Clear H; Intros _ H.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H a0)).
+elim o0; intro.
+elim o1; intro.
+elim o; intro.
+assert (H2 := antiderivative_P2 f x0 x1 a b c H H0).
+assert
+ (H3 :=
+ antiderivative_Ucte f x
+ (fun x:R =>
+ match Rle_dec x b with
+ | left _ => x0 x
+ | right _ => x1 x + (x0 b - x1 b)
+ end) a c H1 H2).
+elim H3; intros.
+assert (H5 : a <= a <= c).
+split; [ right; reflexivity | left; apply Rlt_trans with b; assumption ].
+assert (H6 : a <= c <= c).
+split; [ left; apply Rlt_trans with b; assumption | right; reflexivity ].
+rewrite (H4 _ H5); rewrite (H4 _ H6).
+case (Rle_dec a b); intro.
+case (Rle_dec c b); intro.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 a1)).
+ring.
+elim n; left; assumption.
+unfold antiderivative in H1; elim H1; clear H1; intros _ H1.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 (Rlt_trans _ _ _ a0 a1))).
+unfold antiderivative in H0; elim H0; clear H0; intros _ H0.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 a1)).
+unfold antiderivative in H; elim H; clear H; intros _ H.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H a0)).
(* a<b & b=c *)
-Rewrite <- b0.
-Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or.
-Rewrite <- b0 in o.
-Elim o0; Intro.
-Elim o; Intro.
-Assert H1 := (antiderivative_Ucte f x x0 a b H0 H).
-Elim H1; Intros.
-Rewrite (H2 b).
-Rewrite (H2 a).
-Ring.
-Split; [Right; Reflexivity | Left; Assumption].
-Split; [Left; Assumption | Right; Reflexivity].
-Unfold antiderivative in H0; Elim H0; Clear H0; Intros _ H0.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H0 a0)).
-Unfold antiderivative in H; Elim H; Clear H; Intros _ H.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H a0)).
+rewrite <- b0.
+unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rplus_0_r.
+rewrite <- b0 in o.
+elim o0; intro.
+elim o; intro.
+assert (H1 := antiderivative_Ucte f x x0 a b H0 H).
+elim H1; intros.
+rewrite (H2 b).
+rewrite (H2 a).
+ring.
+split; [ right; reflexivity | left; assumption ].
+split; [ left; assumption | right; reflexivity ].
+unfold antiderivative in H0; elim H0; clear H0; intros _ H0.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 a0)).
+unfold antiderivative in H; elim H; clear H; intros _ H.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H a0)).
(* a<b & b>c *)
-Elim o1; Intro.
-Unfold antiderivative in H; Elim H; Clear H; Intros _ H.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r)).
-Elim o0; Intro.
-Elim o; Intro.
-Assert H2 := (antiderivative_P2 f x x1 a c b H1 H).
-Assert H3 := (antiderivative_Ucte ? ? ? a b H0 H2).
-Elim H3; Intros.
-Rewrite (H4 a).
-Rewrite (H4 b).
-Case (total_order_Rle b c); Intro.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r0 r)).
-Case (total_order_Rle a c); Intro.
-Ring.
-Elim n0; Unfold antiderivative in H1; Elim H1; Intros; Assumption.
-Split; [Left; Assumption | Right; Reflexivity].
-Split; [Right; Reflexivity | Left; Assumption].
-Assert H2 := (antiderivative_P2 ? ? ? ? ? ? H1 H0).
-Assert H3 := (antiderivative_Ucte ? ? ? c b H H2).
-Elim H3; Intros.
-Rewrite (H4 c).
-Rewrite (H4 b).
-Case (total_order_Rle b a); Intro.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r0 a0)).
-Case (total_order_Rle c a); Intro.
-Ring.
-Elim n0; Unfold antiderivative in H1; Elim H1; Intros; Assumption.
-Split; [Left; Assumption | Right; Reflexivity].
-Split; [Right; Reflexivity | Left; Assumption].
-Unfold antiderivative in H0; Elim H0; Clear H0; Intros _ H0.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H0 a0)).
+elim o1; intro.
+unfold antiderivative in H; elim H; clear H; intros _ H.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)).
+elim o0; intro.
+elim o; intro.
+assert (H2 := antiderivative_P2 f x x1 a c b H1 H).
+assert (H3 := antiderivative_Ucte _ _ _ a b H0 H2).
+elim H3; intros.
+rewrite (H4 a).
+rewrite (H4 b).
+case (Rle_dec b c); intro.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 r)).
+case (Rle_dec a c); intro.
+ring.
+elim n0; unfold antiderivative in H1; elim H1; intros; assumption.
+split; [ left; assumption | right; reflexivity ].
+split; [ right; reflexivity | left; assumption ].
+assert (H2 := antiderivative_P2 _ _ _ _ _ _ H1 H0).
+assert (H3 := antiderivative_Ucte _ _ _ c b H H2).
+elim H3; intros.
+rewrite (H4 c).
+rewrite (H4 b).
+case (Rle_dec b a); intro.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 a0)).
+case (Rle_dec c a); intro.
+ring.
+elim n0; unfold antiderivative in H1; elim H1; intros; assumption.
+split; [ left; assumption | right; reflexivity ].
+split; [ right; reflexivity | left; assumption ].
+unfold antiderivative in H0; elim H0; clear H0; intros _ H0.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 a0)).
(* a=b *)
-Rewrite b0 in o; Rewrite b0.
-Elim o; Intro.
-Elim o1; Intro.
-Assert H1 := (antiderivative_Ucte ? ? ? b c H H0).
-Elim H1; Intros.
-Assert H3 : ``b<=c``.
-Unfold antiderivative in H; Elim H; Intros; Assumption.
-Rewrite (H2 b).
-Rewrite (H2 c).
-Ring.
-Split; [Assumption | Right; Reflexivity].
-Split; [Right; Reflexivity | Assumption].
-Assert H1 : ``b==c``.
-Unfold antiderivative in H H0; Elim H; Elim H0; Intros; Apply Rle_antisym; Assumption.
-Rewrite H1; Ring.
-Elim o1; Intro.
-Assert H1 : ``b==c``.
-Unfold antiderivative in H H0; Elim H; Elim H0; Intros; Apply Rle_antisym; Assumption.
-Rewrite H1; Ring.
-Assert H1 := (antiderivative_Ucte ? ? ? c b H H0).
-Elim H1; Intros.
-Assert H3 : ``c<=b``.
-Unfold antiderivative in H; Elim H; Intros; Assumption.
-Rewrite (H2 c).
-Rewrite (H2 b).
-Ring.
-Split; [Assumption | Right; Reflexivity].
-Split; [Right; Reflexivity | Assumption].
+rewrite b0 in o; rewrite b0.
+elim o; intro.
+elim o1; intro.
+assert (H1 := antiderivative_Ucte _ _ _ b c H H0).
+elim H1; intros.
+assert (H3 : b <= c).
+unfold antiderivative in H; elim H; intros; assumption.
+rewrite (H2 b).
+rewrite (H2 c).
+ring.
+split; [ assumption | right; reflexivity ].
+split; [ right; reflexivity | assumption ].
+assert (H1 : b = c).
+unfold antiderivative in H, H0; elim H; elim H0; intros; apply Rle_antisym;
+ assumption.
+rewrite H1; ring.
+elim o1; intro.
+assert (H1 : b = c).
+unfold antiderivative in H, H0; elim H; elim H0; intros; apply Rle_antisym;
+ assumption.
+rewrite H1; ring.
+assert (H1 := antiderivative_Ucte _ _ _ c b H H0).
+elim H1; intros.
+assert (H3 : c <= b).
+unfold antiderivative in H; elim H; intros; assumption.
+rewrite (H2 c).
+rewrite (H2 b).
+ring.
+split; [ assumption | right; reflexivity ].
+split; [ right; reflexivity | assumption ].
(* a>b & b<c *)
-Case (total_order_T b c); Intro.
-Elim s; Intro.
-Elim o0; Intro.
-Unfold antiderivative in H; Elim H; Clear H; Intros _ H.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r)).
-Elim o1; Intro.
-Elim o; Intro.
-Assert H2 := (antiderivative_P2 ? ? ? ? ? ? H H1).
-Assert H3 := (antiderivative_Ucte ? ? ? b c H0 H2).
-Elim H3; Intros.
-Rewrite (H4 b).
-Rewrite (H4 c).
-Case (total_order_Rle b a); Intro.
-Case (total_order_Rle c a); Intro.
-Assert H5 : ``a==c``.
-Unfold antiderivative in H1; Elim H1; Intros; Apply Rle_antisym; Assumption.
-Rewrite H5; Ring.
-Ring.
-Elim n; Left; Assumption.
-Split; [Left; Assumption | Right; Reflexivity].
-Split; [Right; Reflexivity | Left; Assumption].
-Assert H2 := (antiderivative_P2 ? ? ? ? ? ? H0 H1).
-Assert H3 := (antiderivative_Ucte ? ? ? b a H H2).
-Elim H3; Intros.
-Rewrite (H4 a).
-Rewrite (H4 b).
-Case (total_order_Rle b c); Intro.
-Case (total_order_Rle a c); Intro.
-Assert H5 : ``a==c``.
-Unfold antiderivative in H1; Elim H1; Intros; Apply Rle_antisym; Assumption.
-Rewrite H5; Ring.
-Ring.
-Elim n; Left; Assumption.
-Split; [Right; Reflexivity | Left; Assumption].
-Split; [Left; Assumption | Right; Reflexivity].
-Unfold antiderivative in H0; Elim H0; Clear H0; Intros _ H0.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H0 a0)).
+case (total_order_T b c); intro.
+elim s; intro.
+elim o0; intro.
+unfold antiderivative in H; elim H; clear H; intros _ H.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)).
+elim o1; intro.
+elim o; intro.
+assert (H2 := antiderivative_P2 _ _ _ _ _ _ H H1).
+assert (H3 := antiderivative_Ucte _ _ _ b c H0 H2).
+elim H3; intros.
+rewrite (H4 b).
+rewrite (H4 c).
+case (Rle_dec b a); intro.
+case (Rle_dec c a); intro.
+assert (H5 : a = c).
+unfold antiderivative in H1; elim H1; intros; apply Rle_antisym; assumption.
+rewrite H5; ring.
+ring.
+elim n; left; assumption.
+split; [ left; assumption | right; reflexivity ].
+split; [ right; reflexivity | left; assumption ].
+assert (H2 := antiderivative_P2 _ _ _ _ _ _ H0 H1).
+assert (H3 := antiderivative_Ucte _ _ _ b a H H2).
+elim H3; intros.
+rewrite (H4 a).
+rewrite (H4 b).
+case (Rle_dec b c); intro.
+case (Rle_dec a c); intro.
+assert (H5 : a = c).
+unfold antiderivative in H1; elim H1; intros; apply Rle_antisym; assumption.
+rewrite H5; ring.
+ring.
+elim n; left; assumption.
+split; [ right; reflexivity | left; assumption ].
+split; [ left; assumption | right; reflexivity ].
+unfold antiderivative in H0; elim H0; clear H0; intros _ H0.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 a0)).
(* a>b & b=c *)
-Rewrite <- b0.
-Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or.
-Rewrite <- b0 in o.
-Elim o0; Intro.
-Unfold antiderivative in H; Elim H; Clear H; Intros _ H.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r)).
-Elim o; Intro.
-Unfold antiderivative in H0; Elim H0; Clear H0; Intros _ H0.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H0 r)).
-Assert H1 := (antiderivative_Ucte f x x0 b a H0 H).
-Elim H1; Intros.
-Rewrite (H2 b).
-Rewrite (H2 a).
-Ring.
-Split; [Left; Assumption | Right; Reflexivity].
-Split; [Right; Reflexivity | Left; Assumption].
+rewrite <- b0.
+unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rplus_0_r.
+rewrite <- b0 in o.
+elim o0; intro.
+unfold antiderivative in H; elim H; clear H; intros _ H.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)).
+elim o; intro.
+unfold antiderivative in H0; elim H0; clear H0; intros _ H0.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 r)).
+assert (H1 := antiderivative_Ucte f x x0 b a H0 H).
+elim H1; intros.
+rewrite (H2 b).
+rewrite (H2 a).
+ring.
+split; [ left; assumption | right; reflexivity ].
+split; [ right; reflexivity | left; assumption ].
(* a>b & b>c *)
-Elim o0; Intro.
-Unfold antiderivative in H; Elim H; Clear H; Intros _ H.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r)).
-Elim o1; Intro.
-Unfold antiderivative in H0; Elim H0; Clear H0; Intros _ H0.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H0 r0)).
-Elim o; Intro.
-Unfold antiderivative in H1; Elim H1; Clear H1; Intros _ H1.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H1 (Rlt_trans ? ? ? r0 r))).
-Assert H2 := (antiderivative_P2 ? ? ? ? ? ? H0 H).
-Assert H3 := (antiderivative_Ucte ? ? ? c a H1 H2).
-Elim H3; Intros.
-Assert H5 : ``c<=a``.
-Unfold antiderivative in H1; Elim H1; Intros; Assumption.
-Rewrite (H4 c).
-Rewrite (H4 a).
-Case (total_order_Rle a b); Intro.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r1 r)).
-Case (total_order_Rle c b); Intro.
-Ring.
-Elim n0; Left; Assumption.
-Split; [Assumption | Right; Reflexivity].
-Split; [Right; Reflexivity | Assumption].
+elim o0; intro.
+unfold antiderivative in H; elim H; clear H; intros _ H.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)).
+elim o1; intro.
+unfold antiderivative in H0; elim H0; clear H0; intros _ H0.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 r0)).
+elim o; intro.
+unfold antiderivative in H1; elim H1; clear H1; intros _ H1.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 (Rlt_trans _ _ _ r0 r))).
+assert (H2 := antiderivative_P2 _ _ _ _ _ _ H0 H).
+assert (H3 := antiderivative_Ucte _ _ _ c a H1 H2).
+elim H3; intros.
+assert (H5 : c <= a).
+unfold antiderivative in H1; elim H1; intros; assumption.
+rewrite (H4 c).
+rewrite (H4 a).
+case (Rle_dec a b); intro.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r1 r)).
+case (Rle_dec c b); intro.
+ring.
+elim n0; left; assumption.
+split; [ assumption | right; reflexivity ].
+split; [ right; reflexivity | assumption ].
Qed.
-
diff --git a/theories/Reals/PSeries_reg.v b/theories/Reals/PSeries_reg.v
index 2576d9275..4111377b7 100644
--- a/theories/Reals/PSeries_reg.v
+++ b/theories/Reals/PSeries_reg.v
@@ -8,187 +8,252 @@
(*i $Id$ i*)
-Require Rbase.
-Require Rfunctions.
-Require SeqSeries.
-Require Ranalysis1.
-Require Max.
-Require Even.
-V7only [Import R_scope.]. Open Local Scope R_scope.
+Require Import Rbase.
+Require Import Rfunctions.
+Require Import SeqSeries.
+Require Import Ranalysis1.
+Require Import Max.
+Require Import Even. Open Local Scope R_scope.
-Definition Boule [x:R;r:posreal] : R -> Prop := [y:R]``(Rabsolu (y-x))<r``.
+Definition Boule (x:R) (r:posreal) (y:R) : Prop := Rabs (y - x) < r.
(* Uniform convergence *)
-Definition CVU [fn:nat->R->R;f:R->R;x:R;r:posreal] : Prop := (eps:R)``0<eps``->(EX N:nat | (n:nat;y:R) (le N n)->(Boule x r y)->``(Rabsolu ((f y)-(fn n y)))<eps``).
+Definition CVU (fn:nat -> R -> R) (f:R -> R) (x:R)
+ (r:posreal) : Prop :=
+ forall eps:R,
+ 0 < eps ->
+ exists N : nat
+ | (forall (n:nat) (y:R),
+ (N <= n)%nat -> Boule x r y -> Rabs (f y - fn n y) < eps).
(* Normal convergence *)
-Definition CVN_r [fn:nat->R->R;r:posreal] : Type := (SigT ? [An:nat->R](sigTT R [l:R]((Un_cv [n:nat](sum_f_R0 [k:nat](Rabsolu (An k)) n) l)/\((n:nat)(y:R)(Boule R0 r y)->(Rle (Rabsolu (fn n y)) (An n)))))).
+Definition CVN_r (fn:nat -> R -> R) (r:posreal) : Type :=
+ sigT
+ (fun An:nat -> R =>
+ sigT
+ (fun l:R =>
+ Un_cv (fun n:nat => sum_f_R0 (fun k:nat => Rabs (An k)) n) l /\
+ (forall (n:nat) (y:R), Boule 0 r y -> Rabs (fn n y) <= An n))).
-Definition CVN_R [fn:nat->R->R] : Type := (r:posreal) (CVN_r fn r).
+Definition CVN_R (fn:nat -> R -> R) : Type := forall r:posreal, CVN_r fn r.
-Definition SFL [fn:nat->R->R;cv:(x:R)(sigTT ? [l:R](Un_cv [N:nat](SP fn N x) l))] : R-> R := [y:R](Cases (cv y) of (existTT a b) => a end).
+Definition SFL (fn:nat -> R -> R)
+ (cv:forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l))
+ (y:R) : R := match cv y with
+ | existT a b => a
+ end.
(* In a complete space, normal convergence implies uniform convergence *)
-Lemma CVN_CVU : (fn:nat->R->R;cv:(x:R)(sigTT ? [l:R](Un_cv [N:nat](SP fn N x) l));r:posreal) (CVN_r fn r) -> (CVU [n:nat](SP fn n) (SFL fn cv) ``0`` r).
-Intros; Unfold CVU; Intros.
-Unfold CVN_r in X.
-Elim X; Intros An X0.
-Elim X0; Intros s H0.
-Elim H0; Intros.
-Cut (Un_cv [n:nat](Rminus (sum_f_R0 [k:nat]``(Rabsolu (An k))`` n) s) R0).
-Intro; Unfold Un_cv in H3.
-Elim (H3 eps H); Intros N0 H4.
-Exists N0; Intros.
-Apply Rle_lt_trans with (Rabsolu (Rminus (sum_f_R0 [k:nat]``(Rabsolu (An k))`` n) s)).
-Rewrite <- (Rabsolu_Ropp (Rminus (sum_f_R0 [k:nat]``(Rabsolu (An k))`` n) s)); Rewrite Ropp_distr3; Rewrite (Rabsolu_right (Rminus s (sum_f_R0 [k:nat]``(Rabsolu (An k))`` n))).
-EApply sum_maj1.
-Unfold SFL; Case (cv y); Intro.
-Trivial.
-Apply H1.
-Intro; Elim H0; Intros.
-Rewrite (Rabsolu_right (An n0)).
-Apply H8; Apply H6.
-Apply Rle_sym1; Apply Rle_trans with (Rabsolu (fn n0 y)).
-Apply Rabsolu_pos.
-Apply H8; Apply H6.
-Apply Rle_sym1; Apply Rle_anti_compatibility with (sum_f_R0 [k:nat](Rabsolu (An k)) n).
-Rewrite Rplus_Or; Unfold Rminus; Rewrite (Rplus_sym s); Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Ol; Apply sum_incr.
-Apply H1.
-Intro; Apply Rabsolu_pos.
-Unfold R_dist in H4; Unfold Rminus in H4; Rewrite Ropp_O in H4.
-Assert H7 := (H4 n H5).
-Rewrite Rplus_Or in H7; Apply H7.
-Unfold Un_cv in H1; Unfold Un_cv; Intros.
-Elim (H1? H3); Intros.
-Exists x; Intros.
-Unfold R_dist; Unfold R_dist in H4.
-Rewrite minus_R0; Apply H4; Assumption.
+Lemma CVN_CVU :
+ forall (fn:nat -> R -> R)
+ (cv:forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l))
+ (r:posreal), CVN_r fn r -> CVU (fun n:nat => SP fn n) (SFL fn cv) 0 r.
+intros; unfold CVU in |- *; intros.
+unfold CVN_r in X.
+elim X; intros An X0.
+elim X0; intros s H0.
+elim H0; intros.
+cut (Un_cv (fun n:nat => sum_f_R0 (fun k:nat => Rabs (An k)) n - s) 0).
+intro; unfold Un_cv in H3.
+elim (H3 eps H); intros N0 H4.
+exists N0; intros.
+apply Rle_lt_trans with (Rabs (sum_f_R0 (fun k:nat => Rabs (An k)) n - s)).
+rewrite <- (Rabs_Ropp (sum_f_R0 (fun k:nat => Rabs (An k)) n - s));
+ rewrite Ropp_minus_distr';
+ rewrite (Rabs_right (s - sum_f_R0 (fun k:nat => Rabs (An k)) n)).
+eapply sum_maj1.
+unfold SFL in |- *; case (cv y); intro.
+trivial.
+apply H1.
+intro; elim H0; intros.
+rewrite (Rabs_right (An n0)).
+apply H8; apply H6.
+apply Rle_ge; apply Rle_trans with (Rabs (fn n0 y)).
+apply Rabs_pos.
+apply H8; apply H6.
+apply Rle_ge;
+ apply Rplus_le_reg_l with (sum_f_R0 (fun k:nat => Rabs (An k)) n).
+rewrite Rplus_0_r; unfold Rminus in |- *; rewrite (Rplus_comm s);
+ rewrite <- Rplus_assoc; rewrite Rplus_opp_r; rewrite Rplus_0_l;
+ apply sum_incr.
+apply H1.
+intro; apply Rabs_pos.
+unfold R_dist in H4; unfold Rminus in H4; rewrite Ropp_0 in H4.
+assert (H7 := H4 n H5).
+rewrite Rplus_0_r in H7; apply H7.
+unfold Un_cv in H1; unfold Un_cv in |- *; intros.
+elim (H1 _ H3); intros.
+exists x; intros.
+unfold R_dist in |- *; unfold R_dist in H4.
+rewrite Rminus_0_r; apply H4; assumption.
Qed.
(* Each limit of a sequence of functions which converges uniformly is continue *)
-Lemma CVU_continuity : (fn:nat->R->R;f:R->R;x:R;r:posreal) (CVU fn f x r) -> ((n:nat)(y:R) (Boule x r y)->(continuity_pt (fn n) y)) -> ((y:R) (Boule x r y) -> (continuity_pt f y)).
-Intros; Unfold continuity_pt; Unfold continue_in; Unfold limit1_in; Unfold limit_in; Simpl; Unfold R_dist; Intros.
-Unfold CVU in H.
-Cut ``0<eps/3``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]].
-Elim (H ? H3); Intros N0 H4.
-Assert H5 := (H0 N0 y H1).
-Cut (EXT del : posreal | (h:R) ``(Rabsolu h)<del`` -> (Boule x r ``y+h``) ).
-Intro.
-Elim H6; Intros del1 H7.
-Unfold continuity_pt in H5; Unfold continue_in in H5; Unfold limit1_in in H5; Unfold limit_in in H5; Simpl in H5; Unfold R_dist in H5.
-Elim (H5 ? H3); Intros del2 H8.
-Pose del := (Rmin del1 del2).
-Exists del; Intros.
-Split.
-Unfold del; Unfold Rmin; Case (total_order_Rle del1 del2); Intro.
-Apply (cond_pos del1).
-Elim H8; Intros; Assumption.
-Intros; Apply Rle_lt_trans with ``(Rabsolu ((f x0)-(fn N0 x0)))+(Rabsolu ((fn N0 x0)-(f y)))``.
-Replace ``(f x0)-(f y)`` with ``((f x0)-(fn N0 x0))+((fn N0 x0)-(f y))``; [Apply Rabsolu_triang | Ring].
-Apply Rle_lt_trans with ``(Rabsolu ((f x0)-(fn N0 x0)))+(Rabsolu ((fn N0 x0)-(fn N0 y)))+(Rabsolu ((fn N0 y)-(f y)))``.
-Rewrite Rplus_assoc; Apply Rle_compatibility.
-Replace ``(fn N0 x0)-(f y)`` with ``((fn N0 x0)-(fn N0 y))+((fn N0 y)-(f y))``; [Apply Rabsolu_triang | Ring].
-Replace ``eps`` with ``eps/3+eps/3+eps/3``.
-Repeat Apply Rplus_lt.
-Apply H4.
-Apply le_n.
-Replace x0 with ``y+(x0-y)``; [Idtac | Ring]; Apply H7.
-Elim H9; Intros.
-Apply Rlt_le_trans with del.
-Assumption.
-Unfold del; Apply Rmin_l.
-Elim H8; Intros.
-Apply H11.
-Split.
-Elim H9; Intros; Assumption.
-Elim H9; Intros; Apply Rlt_le_trans with del.
-Assumption.
-Unfold del; Apply Rmin_r.
-Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr3; Apply H4.
-Apply le_n.
-Assumption.
-Apply r_Rmult_mult with ``3``.
-Do 2 Rewrite Rmult_Rplus_distr; Unfold Rdiv; Rewrite <- Rmult_assoc; Rewrite Rinv_r_simpl_m.
-Ring.
-DiscrR.
-DiscrR.
-Cut ``0<r-(Rabsolu (x-y))``.
-Intro; Exists (mkposreal ? H6).
-Simpl; Intros.
-Unfold Boule; Replace ``y+h-x`` with ``h+(y-x)``; [Idtac | Ring]; Apply Rle_lt_trans with ``(Rabsolu h)+(Rabsolu (y-x))``.
-Apply Rabsolu_triang.
-Apply Rlt_anti_compatibility with ``-(Rabsolu (x-y))``.
-Rewrite <- (Rabsolu_Ropp ``y-x``); Rewrite Ropp_distr3.
-Replace ``-(Rabsolu (x-y))+r`` with ``r-(Rabsolu (x-y))``.
-Replace ``-(Rabsolu (x-y))+((Rabsolu h)+(Rabsolu (x-y)))`` with (Rabsolu h).
-Apply H7.
-Ring.
-Ring.
-Unfold Boule in H1; Rewrite <- (Rabsolu_Ropp ``x-y``); Rewrite Ropp_distr3; Apply Rlt_anti_compatibility with ``(Rabsolu (y-x))``.
-Rewrite Rplus_Or; Replace ``(Rabsolu (y-x))+(r-(Rabsolu (y-x)))`` with ``(pos r)``; [Apply H1 | Ring].
+Lemma CVU_continuity :
+ forall (fn:nat -> R -> R) (f:R -> R) (x:R) (r:posreal),
+ CVU fn f x r ->
+ (forall (n:nat) (y:R), Boule x r y -> continuity_pt (fn n) y) ->
+ forall y:R, Boule x r y -> continuity_pt f y.
+intros; unfold continuity_pt in |- *; unfold continue_in in |- *;
+ unfold limit1_in in |- *; unfold limit_in in |- *;
+ simpl in |- *; unfold R_dist in |- *; intros.
+unfold CVU in H.
+cut (0 < eps / 3);
+ [ intro
+ | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ].
+elim (H _ H3); intros N0 H4.
+assert (H5 := H0 N0 y H1).
+cut ( exists del : posreal | (forall h:R, Rabs h < del -> Boule x r (y + h))).
+intro.
+elim H6; intros del1 H7.
+unfold continuity_pt in H5; unfold continue_in in H5; unfold limit1_in in H5;
+ unfold limit_in in H5; simpl in H5; unfold R_dist in H5.
+elim (H5 _ H3); intros del2 H8.
+pose (del := Rmin del1 del2).
+exists del; intros.
+split.
+unfold del in |- *; unfold Rmin in |- *; case (Rle_dec del1 del2); intro.
+apply (cond_pos del1).
+elim H8; intros; assumption.
+intros;
+ apply Rle_lt_trans with (Rabs (f x0 - fn N0 x0) + Rabs (fn N0 x0 - f y)).
+replace (f x0 - f y) with (f x0 - fn N0 x0 + (fn N0 x0 - f y));
+ [ apply Rabs_triang | ring ].
+apply Rle_lt_trans with
+ (Rabs (f x0 - fn N0 x0) + Rabs (fn N0 x0 - fn N0 y) + Rabs (fn N0 y - f y)).
+rewrite Rplus_assoc; apply Rplus_le_compat_l.
+replace (fn N0 x0 - f y) with (fn N0 x0 - fn N0 y + (fn N0 y - f y));
+ [ apply Rabs_triang | ring ].
+replace eps with (eps / 3 + eps / 3 + eps / 3).
+repeat apply Rplus_lt_compat.
+apply H4.
+apply le_n.
+replace x0 with (y + (x0 - y)); [ idtac | ring ]; apply H7.
+elim H9; intros.
+apply Rlt_le_trans with del.
+assumption.
+unfold del in |- *; apply Rmin_l.
+elim H8; intros.
+apply H11.
+split.
+elim H9; intros; assumption.
+elim H9; intros; apply Rlt_le_trans with del.
+assumption.
+unfold del in |- *; apply Rmin_r.
+rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr'; apply H4.
+apply le_n.
+assumption.
+apply Rmult_eq_reg_l with 3.
+do 2 rewrite Rmult_plus_distr_l; unfold Rdiv in |- *; rewrite <- Rmult_assoc;
+ rewrite Rinv_r_simpl_m.
+ring.
+discrR.
+discrR.
+cut (0 < r - Rabs (x - y)).
+intro; exists (mkposreal _ H6).
+simpl in |- *; intros.
+unfold Boule in |- *; replace (y + h - x) with (h + (y - x));
+ [ idtac | ring ]; apply Rle_lt_trans with (Rabs h + Rabs (y - x)).
+apply Rabs_triang.
+apply Rplus_lt_reg_r with (- Rabs (x - y)).
+rewrite <- (Rabs_Ropp (y - x)); rewrite Ropp_minus_distr'.
+replace (- Rabs (x - y) + r) with (r - Rabs (x - y)).
+replace (- Rabs (x - y) + (Rabs h + Rabs (x - y))) with (Rabs h).
+apply H7.
+ring.
+ring.
+unfold Boule in H1; rewrite <- (Rabs_Ropp (x - y)); rewrite Ropp_minus_distr';
+ apply Rplus_lt_reg_r with (Rabs (y - x)).
+rewrite Rplus_0_r; replace (Rabs (y - x) + (r - Rabs (y - x))) with (pos r);
+ [ apply H1 | ring ].
Qed.
(**********)
-Lemma continuity_pt_finite_SF : (fn:nat->R->R;N:nat;x:R) ((n:nat)(le n N)->(continuity_pt (fn n) x)) -> (continuity_pt [y:R](sum_f_R0 [k:nat]``(fn k y)`` N) x).
-Intros; Induction N.
-Simpl; Apply (H O); Apply le_n.
-Simpl; Replace [y:R](Rplus (sum_f_R0 [k:nat](fn k y) N) (fn (S N) y)) with (plus_fct [y:R](sum_f_R0 [k:nat](fn k y) N) [y:R](fn (S N) y)); [Idtac | Reflexivity].
-Apply continuity_pt_plus.
-Apply HrecN.
-Intros; Apply H.
-Apply le_trans with N; [Assumption | Apply le_n_Sn].
-Apply (H (S N)); Apply le_n.
+Lemma continuity_pt_finite_SF :
+ forall (fn:nat -> R -> R) (N:nat) (x:R),
+ (forall n:nat, (n <= N)%nat -> continuity_pt (fn n) x) ->
+ continuity_pt (fun y:R => sum_f_R0 (fun k:nat => fn k y) N) x.
+intros; induction N as [| N HrecN].
+simpl in |- *; apply (H 0%nat); apply le_n.
+simpl in |- *;
+ replace (fun y:R => sum_f_R0 (fun k:nat => fn k y) N + fn (S N) y) with
+ ((fun y:R => sum_f_R0 (fun k:nat => fn k y) N) + (fun y:R => fn (S N) y))%F;
+ [ idtac | reflexivity ].
+apply continuity_pt_plus.
+apply HrecN.
+intros; apply H.
+apply le_trans with N; [ assumption | apply le_n_Sn ].
+apply (H (S N)); apply le_n.
Qed.
(* Continuity and normal convergence *)
-Lemma SFL_continuity_pt : (fn:nat->R->R;cv:(x:R)(sigTT ? [l:R](Un_cv [N:nat](SP fn N x) l));r:posreal) (CVN_r fn r) -> ((n:nat)(y:R) (Boule ``0`` r y) -> (continuity_pt (fn n) y)) -> ((y:R) (Boule ``0`` r y) -> (continuity_pt (SFL fn cv) y)).
-Intros; EApply CVU_continuity.
-Apply CVN_CVU.
-Apply X.
-Intros; Unfold SP; Apply continuity_pt_finite_SF.
-Intros; Apply H.
-Apply H1.
-Apply H0.
+Lemma SFL_continuity_pt :
+ forall (fn:nat -> R -> R)
+ (cv:forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l))
+ (r:posreal),
+ CVN_r fn r ->
+ (forall (n:nat) (y:R), Boule 0 r y -> continuity_pt (fn n) y) ->
+ forall y:R, Boule 0 r y -> continuity_pt (SFL fn cv) y.
+intros; eapply CVU_continuity.
+apply CVN_CVU.
+apply X.
+intros; unfold SP in |- *; apply continuity_pt_finite_SF.
+intros; apply H.
+apply H1.
+apply H0.
Qed.
-Lemma SFL_continuity : (fn:nat->R->R;cv:(x:R)(sigTT ? [l:R](Un_cv [N:nat](SP fn N x) l))) (CVN_R fn) -> ((n:nat)(continuity (fn n))) -> (continuity (SFL fn cv)).
-Intros; Unfold continuity; Intro.
-Cut ``0<(Rabsolu x)+1``; [Intro | Apply ge0_plus_gt0_is_gt0; [Apply Rabsolu_pos | Apply Rlt_R0_R1]].
-Cut (Boule ``0`` (mkposreal ? H0) x).
-Intro; EApply SFL_continuity_pt with (mkposreal ? H0).
-Apply X.
-Intros; Apply (H n y).
-Apply H1.
-Unfold Boule; Simpl; Rewrite minus_R0; Pattern 1 (Rabsolu x); Rewrite <- Rplus_Or; Apply Rlt_compatibility; Apply Rlt_R0_R1.
+Lemma SFL_continuity :
+ forall (fn:nat -> R -> R)
+ (cv:forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l)),
+ CVN_R fn -> (forall n:nat, continuity (fn n)) -> continuity (SFL fn cv).
+intros; unfold continuity in |- *; intro.
+cut (0 < Rabs x + 1);
+ [ intro | apply Rplus_le_lt_0_compat; [ apply Rabs_pos | apply Rlt_0_1 ] ].
+cut (Boule 0 (mkposreal _ H0) x).
+intro; eapply SFL_continuity_pt with (mkposreal _ H0).
+apply X.
+intros; apply (H n y).
+apply H1.
+unfold Boule in |- *; simpl in |- *; rewrite Rminus_0_r;
+ pattern (Rabs x) at 1 in |- *; rewrite <- Rplus_0_r;
+ apply Rplus_lt_compat_l; apply Rlt_0_1.
Qed.
(* As R is complete, normal convergence implies that (fn) is simply-uniformly convergent *)
-Lemma CVN_R_CVS : (fn:nat->R->R) (CVN_R fn) -> ((x:R)(sigTT ? [l:R](Un_cv [N:nat](SP fn N x) l))).
-Intros; Apply R_complete.
-Unfold SP; Pose An := [N:nat](fn N x).
-Change (Cauchy_crit_series An).
-Apply cauchy_abs.
-Unfold Cauchy_crit_series; Apply CV_Cauchy.
-Unfold CVN_R in X; Cut ``0<(Rabsolu x)+1``.
-Intro; Assert H0 := (X (mkposreal ? H)).
-Unfold CVN_r in H0; Elim H0; Intros Bn H1.
-Elim H1; Intros l H2.
-Elim H2; Intros.
-Apply Rseries_CV_comp with Bn.
-Intro; Split.
-Apply Rabsolu_pos.
-Unfold An; Apply H4; Unfold Boule; Simpl; Rewrite minus_R0.
-Pattern 1 (Rabsolu x); Rewrite <- Rplus_Or; Apply Rlt_compatibility; Apply Rlt_R0_R1.
-Apply existTT with l.
-Cut (n:nat)``0<=(Bn n)``.
-Intro; Unfold Un_cv in H3; Unfold Un_cv; Intros.
-Elim (H3 ? H6); Intros.
-Exists x0; Intros.
-Replace (sum_f_R0 Bn n) with (sum_f_R0 [k:nat](Rabsolu (Bn k)) n).
-Apply H7; Assumption.
-Apply sum_eq; Intros; Apply Rabsolu_right; Apply Rle_sym1; Apply H5.
-Intro; Apply Rle_trans with (Rabsolu (An n)).
-Apply Rabsolu_pos.
-Unfold An; Apply H4; Unfold Boule; Simpl; Rewrite minus_R0; Pattern 1 (Rabsolu x); Rewrite <- Rplus_Or; Apply Rlt_compatibility; Apply Rlt_R0_R1.
-Apply ge0_plus_gt0_is_gt0; [Apply Rabsolu_pos | Apply Rlt_R0_R1].
-Qed.
+Lemma CVN_R_CVS :
+ forall fn:nat -> R -> R,
+ CVN_R fn -> forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l).
+intros; apply R_complete.
+unfold SP in |- *; pose (An := fun N:nat => fn N x).
+change (Cauchy_crit_series An) in |- *.
+apply cauchy_abs.
+unfold Cauchy_crit_series in |- *; apply CV_Cauchy.
+unfold CVN_R in X; cut (0 < Rabs x + 1).
+intro; assert (H0 := X (mkposreal _ H)).
+unfold CVN_r in H0; elim H0; intros Bn H1.
+elim H1; intros l H2.
+elim H2; intros.
+apply Rseries_CV_comp with Bn.
+intro; split.
+apply Rabs_pos.
+unfold An in |- *; apply H4; unfold Boule in |- *; simpl in |- *;
+ rewrite Rminus_0_r.
+pattern (Rabs x) at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
+ apply Rlt_0_1.
+apply existT with l.
+cut (forall n:nat, 0 <= Bn n).
+intro; unfold Un_cv in H3; unfold Un_cv in |- *; intros.
+elim (H3 _ H6); intros.
+exists x0; intros.
+replace (sum_f_R0 Bn n) with (sum_f_R0 (fun k:nat => Rabs (Bn k)) n).
+apply H7; assumption.
+apply sum_eq; intros; apply Rabs_right; apply Rle_ge; apply H5.
+intro; apply Rle_trans with (Rabs (An n)).
+apply Rabs_pos.
+unfold An in |- *; apply H4; unfold Boule in |- *; simpl in |- *;
+ rewrite Rminus_0_r; pattern (Rabs x) at 1 in |- *;
+ rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; apply Rlt_0_1.
+apply Rplus_le_lt_0_compat; [ apply Rabs_pos | apply Rlt_0_1 ].
+Qed. \ No newline at end of file
diff --git a/theories/Reals/PartSum.v b/theories/Reals/PartSum.v
index 090680cf1..c12aea9df 100644
--- a/theories/Reals/PartSum.v
+++ b/theories/Reals/PartSum.v
@@ -8,469 +8,596 @@
(*i $Id$ i*)
-Require Rbase.
-Require Rfunctions.
-Require Rseries.
-Require Rcomplete.
-Require Max.
-V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
+Require Import Rbase.
+Require Import Rfunctions.
+Require Import Rseries.
+Require Import Rcomplete.
+Require Import Max.
Open Local Scope R_scope.
-Lemma tech1 : (An:nat->R;N:nat) ((n:nat)``(le n N)``->``0<(An n)``) -> ``0 < (sum_f_R0 An N)``.
-Intros; Induction N.
-Simpl; Apply H; Apply le_n.
-Simpl; Apply gt0_plus_gt0_is_gt0.
-Apply HrecN; Intros; Apply H; Apply le_S; Assumption.
-Apply H; Apply le_n.
+Lemma tech1 :
+ forall (An:nat -> R) (N:nat),
+ (forall n:nat, (n <= N)%nat -> 0 < An n) -> 0 < sum_f_R0 An N.
+intros; induction N as [| N HrecN].
+simpl in |- *; apply H; apply le_n.
+simpl in |- *; apply Rplus_lt_0_compat.
+apply HrecN; intros; apply H; apply le_S; assumption.
+apply H; apply le_n.
Qed.
(* Chasles' relation *)
-Lemma tech2 : (An:nat->R;m,n:nat) (lt m n) -> (sum_f_R0 An n) == (Rplus (sum_f_R0 An m) (sum_f_R0 [i:nat]``(An (plus (S m) i))`` (minus n (S m)))).
-Intros; Induction n.
-Elim (lt_n_O ? H).
-Cut (lt m n)\/m=n.
-Intro; Elim H0; Intro.
-Replace (sum_f_R0 An (S n)) with ``(sum_f_R0 An n)+(An (S n))``; [Idtac | Reflexivity].
-Replace (minus (S n) (S m)) with (S (minus n (S m))).
-Replace (sum_f_R0 [i:nat](An (plus (S m) i)) (S (minus n (S m)))) with (Rplus (sum_f_R0 [i:nat](An (plus (S m) i)) (minus n (S m))) (An (plus (S m) (S (minus n (S m)))))); [Idtac | Reflexivity].
-Replace (plus (S m) (S (minus n (S m)))) with (S n).
-Rewrite (Hrecn H1).
-Ring.
-Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Do 2 Rewrite S_INR; Rewrite minus_INR.
-Rewrite S_INR; Ring.
-Apply lt_le_S; Assumption.
-Apply INR_eq; Rewrite S_INR; Repeat Rewrite minus_INR.
-Repeat Rewrite S_INR; Ring.
-Apply le_n_S; Apply lt_le_weak; Assumption.
-Apply lt_le_S; Assumption.
-Rewrite H1; Rewrite <- minus_n_n; Simpl.
-Replace (plus n O) with n; [Reflexivity | Ring].
-Inversion H.
-Right; Reflexivity.
-Left; Apply lt_le_trans with (S m); [Apply lt_n_Sn | Assumption].
+Lemma tech2 :
+ forall (An:nat -> R) (m n:nat),
+ (m < n)%nat ->
+ sum_f_R0 An n =
+ sum_f_R0 An m + sum_f_R0 (fun i:nat => An (S m + i)%nat) (n - S m).
+intros; induction n as [| n Hrecn].
+elim (lt_n_O _ H).
+cut ((m < n)%nat \/ m = n).
+intro; elim H0; intro.
+replace (sum_f_R0 An (S n)) with (sum_f_R0 An n + An (S n));
+ [ idtac | reflexivity ].
+replace (S n - S m)%nat with (S (n - S m)).
+replace (sum_f_R0 (fun i:nat => An (S m + i)%nat) (S (n - S m))) with
+ (sum_f_R0 (fun i:nat => An (S m + i)%nat) (n - S m) +
+ An (S m + S (n - S m))%nat); [ idtac | reflexivity ].
+replace (S m + S (n - S m))%nat with (S n).
+rewrite (Hrecn H1).
+ring.
+apply INR_eq; rewrite S_INR; rewrite plus_INR; do 2 rewrite S_INR;
+ rewrite minus_INR.
+rewrite S_INR; ring.
+apply lt_le_S; assumption.
+apply INR_eq; rewrite S_INR; repeat rewrite minus_INR.
+repeat rewrite S_INR; ring.
+apply le_n_S; apply lt_le_weak; assumption.
+apply lt_le_S; assumption.
+rewrite H1; rewrite <- minus_n_n; simpl in |- *.
+replace (n + 0)%nat with n; [ reflexivity | ring ].
+inversion H.
+right; reflexivity.
+left; apply lt_le_trans with (S m); [ apply lt_n_Sn | assumption ].
Qed.
(* Sum of geometric sequences *)
-Lemma tech3 : (k:R;N:nat) ``k<>1`` -> (sum_f_R0 [i:nat](pow k i) N)==``(1-(pow k (S N)))/(1-k)``.
-Intros; Cut ``1-k<>0``.
-Intro; Induction N.
-Simpl; Rewrite Rmult_1r; Unfold Rdiv; Rewrite <- Rinv_r_sym.
-Reflexivity.
-Apply H0.
-Replace (sum_f_R0 ([i:nat](pow k i)) (S N)) with (Rplus (sum_f_R0 [i:nat](pow k i) N) (pow k (S N))); [Idtac | Reflexivity]; Rewrite HrecN; Replace ``(1-(pow k (S N)))/(1-k)+(pow k (S N))`` with ``((1-(pow k (S N)))+(1-k)*(pow k (S N)))/(1-k)``.
-Apply r_Rmult_mult with ``1-k``.
-Unfold Rdiv; Do 2 Rewrite <- (Rmult_sym ``/(1-k)``); Repeat Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [ Do 2 Rewrite Rmult_1l; Simpl; Ring | Apply H0].
-Apply H0.
-Unfold Rdiv; Rewrite Rmult_Rplus_distrl; Rewrite (Rmult_sym ``1-k``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Reflexivity.
-Apply H0.
-Apply Rminus_eq_contra; Red; Intro; Elim H; Symmetry; Assumption.
+Lemma tech3 :
+ forall (k:R) (N:nat),
+ k <> 1 -> sum_f_R0 (fun i:nat => k ^ i) N = (1 - k ^ S N) / (1 - k).
+intros; cut (1 - k <> 0).
+intro; induction N as [| N HrecN].
+simpl in |- *; rewrite Rmult_1_r; unfold Rdiv in |- *; rewrite <- Rinv_r_sym.
+reflexivity.
+apply H0.
+replace (sum_f_R0 (fun i:nat => k ^ i) (S N)) with
+ (sum_f_R0 (fun i:nat => k ^ i) N + k ^ S N); [ idtac | reflexivity ];
+ rewrite HrecN;
+ replace ((1 - k ^ S N) / (1 - k) + k ^ S N) with
+ ((1 - k ^ S N + (1 - k) * k ^ S N) / (1 - k)).
+apply Rmult_eq_reg_l with (1 - k).
+unfold Rdiv in |- *; do 2 rewrite <- (Rmult_comm (/ (1 - k)));
+ repeat rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym;
+ [ do 2 rewrite Rmult_1_l; simpl in |- *; ring | apply H0 ].
+apply H0.
+unfold Rdiv in |- *; rewrite Rmult_plus_distr_r; rewrite (Rmult_comm (1 - k));
+ repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym.
+rewrite Rmult_1_r; reflexivity.
+apply H0.
+apply Rminus_eq_contra; red in |- *; intro; elim H; symmetry in |- *;
+ assumption.
Qed.
-Lemma tech4 : (An:nat->R;k:R;N:nat) ``0<=k`` -> ((i:nat)``(An (S i))<k*(An i)``) -> ``(An N)<=(An O)*(pow k N)``.
-Intros; Induction N.
-Simpl; Right; Ring.
-Apply Rle_trans with ``k*(An N)``.
-Left; Apply (H0 N).
-Replace (S N) with (plus N (1)); [Idtac | Ring].
-Rewrite pow_add; Simpl; Rewrite Rmult_1r; Replace ``(An O)*((pow k N)*k)`` with ``k*((An O)*(pow k N))``; [Idtac | Ring]; Apply Rle_monotony.
-Assumption.
-Apply HrecN.
+Lemma tech4 :
+ forall (An:nat -> R) (k:R) (N:nat),
+ 0 <= k -> (forall i:nat, An (S i) < k * An i) -> An N <= An 0%nat * k ^ N.
+intros; induction N as [| N HrecN].
+simpl in |- *; right; ring.
+apply Rle_trans with (k * An N).
+left; apply (H0 N).
+replace (S N) with (N + 1)%nat; [ idtac | ring ].
+rewrite pow_add; simpl in |- *; rewrite Rmult_1_r;
+ replace (An 0%nat * (k ^ N * k)) with (k * (An 0%nat * k ^ N));
+ [ idtac | ring ]; apply Rmult_le_compat_l.
+assumption.
+apply HrecN.
Qed.
-Lemma tech5 : (An:nat->R;N:nat) (sum_f_R0 An (S N))==``(sum_f_R0 An N)+(An (S N))``.
-Intros; Reflexivity.
+Lemma tech5 :
+ forall (An:nat -> R) (N:nat), sum_f_R0 An (S N) = sum_f_R0 An N + An (S N).
+intros; reflexivity.
Qed.
-Lemma tech6 : (An:nat->R;k:R;N:nat) ``0<=k`` -> ((i:nat)``(An (S i))<k*(An i)``) -> (Rle (sum_f_R0 An N) (Rmult (An O) (sum_f_R0 [i:nat](pow k i) N))).
-Intros; Induction N.
-Simpl; Right; Ring.
-Apply Rle_trans with (Rplus (Rmult (An O) (sum_f_R0 [i:nat](pow k i) N)) (An (S N))).
-Rewrite tech5; Do 2 Rewrite <- (Rplus_sym (An (S N))); Apply Rle_compatibility.
-Apply HrecN.
-Rewrite tech5 ; Rewrite Rmult_Rplus_distr; Apply Rle_compatibility.
-Apply tech4; Assumption.
+Lemma tech6 :
+ forall (An:nat -> R) (k:R) (N:nat),
+ 0 <= k ->
+ (forall i:nat, An (S i) < k * An i) ->
+ sum_f_R0 An N <= An 0%nat * sum_f_R0 (fun i:nat => k ^ i) N.
+intros; induction N as [| N HrecN].
+simpl in |- *; right; ring.
+apply Rle_trans with (An 0%nat * sum_f_R0 (fun i:nat => k ^ i) N + An (S N)).
+rewrite tech5; do 2 rewrite <- (Rplus_comm (An (S N)));
+ apply Rplus_le_compat_l.
+apply HrecN.
+rewrite tech5; rewrite Rmult_plus_distr_l; apply Rplus_le_compat_l.
+apply tech4; assumption.
Qed.
-Lemma tech7 : (r1,r2:R) ``r1<>0`` -> ``r2<>0`` -> ``r1<>r2`` -> ``/r1<>/r2``.
-Intros; Red; Intro.
-Assert H3 := (Rmult_mult_r r1 ? ? H2).
-Rewrite <- Rinv_r_sym in H3; [Idtac | Assumption].
-Assert H4 := (Rmult_mult_r r2 ? ? H3).
-Rewrite Rmult_1r in H4; Rewrite <- Rmult_assoc in H4.
-Rewrite Rinv_r_simpl_m in H4; [Idtac | Assumption].
-Elim H1; Symmetry; Assumption.
+Lemma tech7 : forall r1 r2:R, r1 <> 0 -> r2 <> 0 -> r1 <> r2 -> / r1 <> / r2.
+intros; red in |- *; intro.
+assert (H3 := Rmult_eq_compat_l r1 _ _ H2).
+rewrite <- Rinv_r_sym in H3; [ idtac | assumption ].
+assert (H4 := Rmult_eq_compat_l r2 _ _ H3).
+rewrite Rmult_1_r in H4; rewrite <- Rmult_assoc in H4.
+rewrite Rinv_r_simpl_m in H4; [ idtac | assumption ].
+elim H1; symmetry in |- *; assumption.
Qed.
-Lemma tech11 : (An,Bn,Cn:nat->R;N:nat) ((i:nat) (An i)==``(Bn i)-(Cn i)``) -> (sum_f_R0 An N)==``(sum_f_R0 Bn N)-(sum_f_R0 Cn N)``.
-Intros; Induction N.
-Simpl; Apply H.
-Do 3 Rewrite tech5; Rewrite HrecN; Rewrite (H (S N)); Ring.
+Lemma tech11 :
+ forall (An Bn Cn:nat -> R) (N:nat),
+ (forall i:nat, An i = Bn i - Cn i) ->
+ sum_f_R0 An N = sum_f_R0 Bn N - sum_f_R0 Cn N.
+intros; induction N as [| N HrecN].
+simpl in |- *; apply H.
+do 3 rewrite tech5; rewrite HrecN; rewrite (H (S N)); ring.
Qed.
-Lemma tech12 : (An:nat->R;x:R;l:R) (Un_cv [N:nat](sum_f_R0 [i:nat]``(An i)*(pow x i)`` N) l) -> (Pser An x l).
-Intros; Unfold Pser; Unfold infinit_sum; Unfold Un_cv in H; Assumption.
+Lemma tech12 :
+ forall (An:nat -> R) (x l:R),
+ Un_cv (fun N:nat => sum_f_R0 (fun i:nat => An i * x ^ i) N) l ->
+ Pser An x l.
+intros; unfold Pser in |- *; unfold infinit_sum in |- *; unfold Un_cv in H;
+ assumption.
Qed.
-Lemma scal_sum : (An:nat->R;N:nat;x:R) (Rmult x (sum_f_R0 An N))==(sum_f_R0 [i:nat]``(An i)*x`` N).
-Intros; Induction N.
-Simpl; Ring.
-Do 2 Rewrite tech5.
-Rewrite Rmult_Rplus_distr; Rewrite <- HrecN; Ring.
+Lemma scal_sum :
+ forall (An:nat -> R) (N:nat) (x:R),
+ x * sum_f_R0 An N = sum_f_R0 (fun i:nat => An i * x) N.
+intros; induction N as [| N HrecN].
+simpl in |- *; ring.
+do 2 rewrite tech5.
+rewrite Rmult_plus_distr_l; rewrite <- HrecN; ring.
Qed.
-Lemma decomp_sum : (An:nat->R;N:nat) (lt O N) -> (sum_f_R0 An N)==(Rplus (An O) (sum_f_R0 [i:nat](An (S i)) (pred N))).
-Intros; Induction N.
-Elim (lt_n_n ? H).
-Cut (lt O N)\/N=O.
-Intro; Elim H0; Intro.
-Cut (S (pred N))=(pred (S N)).
-Intro; Rewrite <- H2.
-Do 2 Rewrite tech5.
-Replace (S (S (pred N))) with (S N).
-Rewrite (HrecN H1); Ring.
-Rewrite H2; Simpl; Reflexivity.
-Assert H2 := (O_or_S N).
-Elim H2; Intros.
-Elim a; Intros.
-Rewrite <- p.
-Simpl; Reflexivity.
-Rewrite <- b in H1; Elim (lt_n_n ? H1).
-Rewrite H1; Simpl; Reflexivity.
-Inversion H.
-Right; Reflexivity.
-Left; Apply lt_le_trans with (1); [Apply lt_O_Sn | Assumption].
+Lemma decomp_sum :
+ forall (An:nat -> R) (N:nat),
+ (0 < N)%nat ->
+ sum_f_R0 An N = An 0%nat + sum_f_R0 (fun i:nat => An (S i)) (pred N).
+intros; induction N as [| N HrecN].
+elim (lt_irrefl _ H).
+cut ((0 < N)%nat \/ N = 0%nat).
+intro; elim H0; intro.
+cut (S (pred N) = pred (S N)).
+intro; rewrite <- H2.
+do 2 rewrite tech5.
+replace (S (S (pred N))) with (S N).
+rewrite (HrecN H1); ring.
+rewrite H2; simpl in |- *; reflexivity.
+assert (H2 := O_or_S N).
+elim H2; intros.
+elim a; intros.
+rewrite <- p.
+simpl in |- *; reflexivity.
+rewrite <- b in H1; elim (lt_irrefl _ H1).
+rewrite H1; simpl in |- *; reflexivity.
+inversion H.
+right; reflexivity.
+left; apply lt_le_trans with 1%nat; [ apply lt_O_Sn | assumption ].
Qed.
-Lemma plus_sum : (An,Bn:nat->R;N:nat) (sum_f_R0 [i:nat]``(An i)+(Bn i)`` N)==``(sum_f_R0 An N)+(sum_f_R0 Bn N)``.
-Intros; Induction N.
-Simpl; Ring.
-Do 3 Rewrite tech5; Rewrite HrecN; Ring.
+Lemma plus_sum :
+ forall (An Bn:nat -> R) (N:nat),
+ sum_f_R0 (fun i:nat => An i + Bn i) N = sum_f_R0 An N + sum_f_R0 Bn N.
+intros; induction N as [| N HrecN].
+simpl in |- *; ring.
+do 3 rewrite tech5; rewrite HrecN; ring.
Qed.
-Lemma sum_eq : (An,Bn:nat->R;N:nat) ((i:nat)(le i N)->(An i)==(Bn i)) -> (sum_f_R0 An N)==(sum_f_R0 Bn N).
-Intros; Induction N.
-Simpl; Apply H; Apply le_n.
-Do 2 Rewrite tech5; Rewrite HrecN.
-Rewrite (H (S N)); [Reflexivity | Apply le_n].
-Intros; Apply H; Apply le_trans with N; [Assumption | Apply le_n_Sn].
+Lemma sum_eq :
+ forall (An Bn:nat -> R) (N:nat),
+ (forall i:nat, (i <= N)%nat -> An i = Bn i) ->
+ sum_f_R0 An N = sum_f_R0 Bn N.
+intros; induction N as [| N HrecN].
+simpl in |- *; apply H; apply le_n.
+do 2 rewrite tech5; rewrite HrecN.
+rewrite (H (S N)); [ reflexivity | apply le_n ].
+intros; apply H; apply le_trans with N; [ assumption | apply le_n_Sn ].
Qed.
(* Unicity of the limit defined by convergent series *)
-Lemma unicity_sum : (An:nat->R;l1,l2:R) (infinit_sum An l1) -> (infinit_sum An l2) -> l1 == l2.
-Unfold infinit_sum; Intros.
-Case (Req_EM l1 l2); Intro.
-Assumption.
-Cut ``0<(Rabsolu ((l1-l2)/2))``; [Intro | Apply Rabsolu_pos_lt].
-Elim (H ``(Rabsolu ((l1-l2)/2))`` H2); Intros.
-Elim (H0 ``(Rabsolu ((l1-l2)/2))`` H2); Intros.
-Pose N := (max x0 x); Cut (ge N x0).
-Cut (ge N x).
-Intros; Assert H7 := (H3 N H5); Assert H8 := (H4 N H6).
-Cut ``(Rabsolu (l1-l2)) <= (R_dist (sum_f_R0 An N) l1) + (R_dist (sum_f_R0 An N) l2)``.
-Intro; Assert H10 := (Rplus_lt ? ? ? ? H7 H8); Assert H11 := (Rle_lt_trans ? ? ? H9 H10); Unfold Rdiv in H11; Rewrite Rabsolu_mult in H11.
-Cut ``(Rabsolu (/2))==/2``.
-Intro; Rewrite H12 in H11; Assert H13 := double_var; Unfold Rdiv in H13; Rewrite <- H13 in H11.
-Elim (Rlt_antirefl ? H11).
-Apply Rabsolu_right; Left; Change ``0</2``; Apply Rlt_Rinv; Cut ~(O=(2)); [Intro H20; Generalize (lt_INR_0 (2) (neq_O_lt (2) H20)); Unfold INR; Intro; Assumption | Discriminate].
-Unfold R_dist; Rewrite <- (Rabsolu_Ropp ``(sum_f_R0 An N)-l1``); Rewrite Ropp_distr3.
-Replace ``l1-l2`` with ``((l1-(sum_f_R0 An N)))+((sum_f_R0 An N)-l2)``; [Idtac | Ring].
-Apply Rabsolu_triang.
-Unfold ge; Unfold N; Apply le_max_r.
-Unfold ge; Unfold N; Apply le_max_l.
-Unfold Rdiv; Apply prod_neq_R0.
-Apply Rminus_eq_contra; Assumption.
-Apply Rinv_neq_R0; DiscrR.
+Lemma uniqueness_sum :
+ forall (An:nat -> R) (l1 l2:R),
+ infinit_sum An l1 -> infinit_sum An l2 -> l1 = l2.
+unfold infinit_sum in |- *; intros.
+case (Req_dec l1 l2); intro.
+assumption.
+cut (0 < Rabs ((l1 - l2) / 2)); [ intro | apply Rabs_pos_lt ].
+elim (H (Rabs ((l1 - l2) / 2)) H2); intros.
+elim (H0 (Rabs ((l1 - l2) / 2)) H2); intros.
+pose (N := max x0 x); cut (N >= x0)%nat.
+cut (N >= x)%nat.
+intros; assert (H7 := H3 N H5); assert (H8 := H4 N H6).
+cut (Rabs (l1 - l2) <= R_dist (sum_f_R0 An N) l1 + R_dist (sum_f_R0 An N) l2).
+intro; assert (H10 := Rplus_lt_compat _ _ _ _ H7 H8);
+ assert (H11 := Rle_lt_trans _ _ _ H9 H10); unfold Rdiv in H11;
+ rewrite Rabs_mult in H11.
+cut (Rabs (/ 2) = / 2).
+intro; rewrite H12 in H11; assert (H13 := double_var); unfold Rdiv in H13;
+ rewrite <- H13 in H11.
+elim (Rlt_irrefl _ H11).
+apply Rabs_right; left; change (0 < / 2) in |- *; apply Rinv_0_lt_compat;
+ cut (0%nat <> 2%nat);
+ [ intro H20; generalize (lt_INR_0 2 (neq_O_lt 2 H20)); unfold INR in |- *;
+ intro; assumption
+ | discriminate ].
+unfold R_dist in |- *; rewrite <- (Rabs_Ropp (sum_f_R0 An N - l1));
+ rewrite Ropp_minus_distr'.
+replace (l1 - l2) with (l1 - sum_f_R0 An N + (sum_f_R0 An N - l2));
+ [ idtac | ring ].
+apply Rabs_triang.
+unfold ge in |- *; unfold N in |- *; apply le_max_r.
+unfold ge in |- *; unfold N in |- *; apply le_max_l.
+unfold Rdiv in |- *; apply prod_neq_R0.
+apply Rminus_eq_contra; assumption.
+apply Rinv_neq_0_compat; discrR.
Qed.
-Lemma minus_sum : (An,Bn:nat->R;N:nat) (sum_f_R0 [i:nat]``(An i)-(Bn i)`` N)==``(sum_f_R0 An N)-(sum_f_R0 Bn N)``.
-Intros; Induction N.
-Simpl; Ring.
-Do 3 Rewrite tech5; Rewrite HrecN; Ring.
+Lemma minus_sum :
+ forall (An Bn:nat -> R) (N:nat),
+ sum_f_R0 (fun i:nat => An i - Bn i) N = sum_f_R0 An N - sum_f_R0 Bn N.
+intros; induction N as [| N HrecN].
+simpl in |- *; ring.
+do 3 rewrite tech5; rewrite HrecN; ring.
Qed.
-Lemma sum_decomposition : (An:nat->R;N:nat) (Rplus (sum_f_R0 [l:nat](An (mult (2) l)) (S N)) (sum_f_R0 [l:nat](An (S (mult (2) l))) N))==(sum_f_R0 An (mult (2) (S N))).
-Intros.
-Induction N.
-Simpl; Ring.
-Rewrite tech5.
-Rewrite (tech5 [l:nat](An (S (mult (2) l))) N).
-Replace (mult (2) (S (S N))) with (S (S (mult (2) (S N)))).
-Rewrite (tech5 An (S (mult (2) (S N)))).
-Rewrite (tech5 An (mult (2) (S N))).
-Rewrite <- HrecN.
-Ring.
-Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR;Repeat Rewrite S_INR.
-Ring.
+Lemma sum_decomposition :
+ forall (An:nat -> R) (N:nat),
+ sum_f_R0 (fun l:nat => An (2 * l)%nat) (S N) +
+ sum_f_R0 (fun l:nat => An (S (2 * l))) N = sum_f_R0 An (2 * S N).
+intros.
+induction N as [| N HrecN].
+simpl in |- *; ring.
+rewrite tech5.
+rewrite (tech5 (fun l:nat => An (S (2 * l))) N).
+replace (2 * S (S N))%nat with (S (S (2 * S N))).
+rewrite (tech5 An (S (2 * S N))).
+rewrite (tech5 An (2 * S N)).
+rewrite <- HrecN.
+ring.
+apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR.
+ring.
Qed.
-Lemma sum_Rle : (An,Bn:nat->R;N:nat) ((n:nat)(le n N)->``(An n)<=(Bn n)``) -> ``(sum_f_R0 An N)<=(sum_f_R0 Bn N)``.
-Intros.
-Induction N.
-Simpl; Apply H.
-Apply le_n.
-Do 2 Rewrite tech5.
-Apply Rle_trans with ``(sum_f_R0 An N)+(Bn (S N))``.
-Apply Rle_compatibility.
-Apply H.
-Apply le_n.
-Do 2 Rewrite <- (Rplus_sym ``(Bn (S N))``).
-Apply Rle_compatibility.
-Apply HrecN.
-Intros; Apply H.
-Apply le_trans with N; [Assumption | Apply le_n_Sn].
+Lemma sum_Rle :
+ forall (An Bn:nat -> R) (N:nat),
+ (forall n:nat, (n <= N)%nat -> An n <= Bn n) ->
+ sum_f_R0 An N <= sum_f_R0 Bn N.
+intros.
+induction N as [| N HrecN].
+simpl in |- *; apply H.
+apply le_n.
+do 2 rewrite tech5.
+apply Rle_trans with (sum_f_R0 An N + Bn (S N)).
+apply Rplus_le_compat_l.
+apply H.
+apply le_n.
+do 2 rewrite <- (Rplus_comm (Bn (S N))).
+apply Rplus_le_compat_l.
+apply HrecN.
+intros; apply H.
+apply le_trans with N; [ assumption | apply le_n_Sn ].
Qed.
-Lemma sum_Rabsolu : (An:nat->R;N:nat) (Rle (Rabsolu (sum_f_R0 An N)) (sum_f_R0 [l:nat](Rabsolu (An l)) N)).
-Intros.
-Induction N.
-Simpl.
-Right; Reflexivity.
-Do 2 Rewrite tech5.
-Apply Rle_trans with ``(Rabsolu (sum_f_R0 An N))+(Rabsolu (An (S N)))``.
-Apply Rabsolu_triang.
-Do 2 Rewrite <- (Rplus_sym (Rabsolu (An (S N)))).
-Apply Rle_compatibility.
-Apply HrecN.
+Lemma Rsum_abs :
+ forall (An:nat -> R) (N:nat),
+ Rabs (sum_f_R0 An N) <= sum_f_R0 (fun l:nat => Rabs (An l)) N.
+intros.
+induction N as [| N HrecN].
+simpl in |- *.
+right; reflexivity.
+do 2 rewrite tech5.
+apply Rle_trans with (Rabs (sum_f_R0 An N) + Rabs (An (S N))).
+apply Rabs_triang.
+do 2 rewrite <- (Rplus_comm (Rabs (An (S N)))).
+apply Rplus_le_compat_l.
+apply HrecN.
Qed.
-Lemma sum_cte : (x:R;N:nat) (sum_f_R0 [_:nat]x N) == ``x*(INR (S N))``.
-Intros.
-Induction N.
-Simpl; Ring.
-Rewrite tech5.
-Rewrite HrecN; Repeat Rewrite S_INR; Ring.
+Lemma sum_cte :
+ forall (x:R) (N:nat), sum_f_R0 (fun _:nat => x) N = x * INR (S N).
+intros.
+induction N as [| N HrecN].
+simpl in |- *; ring.
+rewrite tech5.
+rewrite HrecN; repeat rewrite S_INR; ring.
Qed.
(**********)
-Lemma sum_growing : (An,Bn:nat->R;N:nat) ((n:nat)``(An n)<=(Bn n)``)->``(sum_f_R0 An N)<=(sum_f_R0 Bn N)``.
-Intros.
-Induction N.
-Simpl; Apply H.
-Do 2 Rewrite tech5.
-Apply Rle_trans with ``(sum_f_R0 An N)+(Bn (S N))``.
-Apply Rle_compatibility; Apply H.
-Do 2 Rewrite <- (Rplus_sym (Bn (S N))).
-Apply Rle_compatibility; Apply HrecN.
+Lemma sum_growing :
+ forall (An Bn:nat -> R) (N:nat),
+ (forall n:nat, An n <= Bn n) -> sum_f_R0 An N <= sum_f_R0 Bn N.
+intros.
+induction N as [| N HrecN].
+simpl in |- *; apply H.
+do 2 rewrite tech5.
+apply Rle_trans with (sum_f_R0 An N + Bn (S N)).
+apply Rplus_le_compat_l; apply H.
+do 2 rewrite <- (Rplus_comm (Bn (S N))).
+apply Rplus_le_compat_l; apply HrecN.
Qed.
(**********)
-Lemma Rabsolu_triang_gen : (An:nat->R;N:nat) (Rle (Rabsolu (sum_f_R0 An N)) (sum_f_R0 [i:nat](Rabsolu (An i)) N)).
-Intros.
-Induction N.
-Simpl.
-Right; Reflexivity.
-Do 2 Rewrite tech5.
-Apply Rle_trans with ``(Rabsolu ((sum_f_R0 An N)))+(Rabsolu (An (S N)))``.
-Apply Rabsolu_triang.
-Do 2 Rewrite <- (Rplus_sym (Rabsolu (An (S N)))).
-Apply Rle_compatibility; Apply HrecN.
+Lemma Rabs_triang_gen :
+ forall (An:nat -> R) (N:nat),
+ Rabs (sum_f_R0 An N) <= sum_f_R0 (fun i:nat => Rabs (An i)) N.
+intros.
+induction N as [| N HrecN].
+simpl in |- *.
+right; reflexivity.
+do 2 rewrite tech5.
+apply Rle_trans with (Rabs (sum_f_R0 An N) + Rabs (An (S N))).
+apply Rabs_triang.
+do 2 rewrite <- (Rplus_comm (Rabs (An (S N)))).
+apply Rplus_le_compat_l; apply HrecN.
Qed.
(**********)
-Lemma cond_pos_sum : (An:nat->R;N:nat) ((n:nat)``0<=(An n)``) -> ``0<=(sum_f_R0 An N)``.
-Intros.
-Induction N.
-Simpl; Apply H.
-Rewrite tech5.
-Apply ge0_plus_ge0_is_ge0.
-Apply HrecN.
-Apply H.
+Lemma cond_pos_sum :
+ forall (An:nat -> R) (N:nat),
+ (forall n:nat, 0 <= An n) -> 0 <= sum_f_R0 An N.
+intros.
+induction N as [| N HrecN].
+simpl in |- *; apply H.
+rewrite tech5.
+apply Rplus_le_le_0_compat.
+apply HrecN.
+apply H.
Qed.
(* Cauchy's criterion for series *)
-Definition Cauchy_crit_series [An:nat->R] : Prop := (Cauchy_crit [N:nat](sum_f_R0 An N)).
+Definition Cauchy_crit_series (An:nat -> R) : Prop :=
+ Cauchy_crit (fun N:nat => sum_f_R0 An N).
(* If (|An|) satisfies the Cauchy's criterion for series, then (An) too *)
-Lemma cauchy_abs : (An:nat->R) (Cauchy_crit_series [i:nat](Rabsolu (An i))) -> (Cauchy_crit_series An).
-Unfold Cauchy_crit_series; Unfold Cauchy_crit.
-Intros.
-Elim (H eps H0); Intros.
-Exists x.
-Intros.
-Cut (Rle (R_dist (sum_f_R0 An n) (sum_f_R0 An m)) (R_dist (sum_f_R0 [i:nat](Rabsolu (An i)) n) (sum_f_R0 [i:nat](Rabsolu (An i)) m))).
-Intro.
-Apply Rle_lt_trans with (R_dist (sum_f_R0 [i:nat](Rabsolu (An i)) n) (sum_f_R0 [i:nat](Rabsolu (An i)) m)).
-Assumption.
-Apply H1; Assumption.
-Assert H4 := (lt_eq_lt_dec n m).
-Elim H4; Intro.
-Elim a; Intro.
-Rewrite (tech2 An n m); [Idtac | Assumption].
-Rewrite (tech2 [i:nat](Rabsolu (An i)) n m); [Idtac | Assumption].
-Unfold R_dist.
-Unfold Rminus.
-Do 2 Rewrite Ropp_distr1.
-Do 2 Rewrite <- Rplus_assoc.
-Do 2 Rewrite Rplus_Ropp_r.
-Do 2 Rewrite Rplus_Ol.
-Do 2 Rewrite Rabsolu_Ropp.
-Rewrite (Rabsolu_right (sum_f_R0 [i:nat](Rabsolu (An (plus (S n) i))) (minus m (S n)))).
-Pose Bn:=[i:nat](An (plus (S n) i)).
-Replace [i:nat](Rabsolu (An (plus (S n) i))) with [i:nat](Rabsolu (Bn i)).
-Apply Rabsolu_triang_gen.
-Unfold Bn; Reflexivity.
-Apply Rle_sym1.
-Apply cond_pos_sum.
-Intro; Apply Rabsolu_pos.
-Rewrite b.
-Unfold R_dist.
-Unfold Rminus; Do 2 Rewrite Rplus_Ropp_r.
-Rewrite Rabsolu_R0; Right; Reflexivity.
-Rewrite (tech2 An m n); [Idtac | Assumption].
-Rewrite (tech2 [i:nat](Rabsolu (An i)) m n); [Idtac | Assumption].
-Unfold R_dist.
-Unfold Rminus.
-Do 2 Rewrite Rplus_assoc.
-Rewrite (Rplus_sym (sum_f_R0 An m)).
-Rewrite (Rplus_sym (sum_f_R0 [i:nat](Rabsolu (An i)) m)).
-Do 2 Rewrite Rplus_assoc.
-Do 2 Rewrite Rplus_Ropp_l.
-Do 2 Rewrite Rplus_Or.
-Rewrite (Rabsolu_right (sum_f_R0 [i:nat](Rabsolu (An (plus (S m) i))) (minus n (S m)))).
-Pose Bn:=[i:nat](An (plus (S m) i)).
-Replace [i:nat](Rabsolu (An (plus (S m) i))) with [i:nat](Rabsolu (Bn i)).
-Apply Rabsolu_triang_gen.
-Unfold Bn; Reflexivity.
-Apply Rle_sym1.
-Apply cond_pos_sum.
-Intro; Apply Rabsolu_pos.
+Lemma cauchy_abs :
+ forall An:nat -> R,
+ Cauchy_crit_series (fun i:nat => Rabs (An i)) -> Cauchy_crit_series An.
+unfold Cauchy_crit_series in |- *; unfold Cauchy_crit in |- *.
+intros.
+elim (H eps H0); intros.
+exists x.
+intros.
+cut
+ (R_dist (sum_f_R0 An n) (sum_f_R0 An m) <=
+ R_dist (sum_f_R0 (fun i:nat => Rabs (An i)) n)
+ (sum_f_R0 (fun i:nat => Rabs (An i)) m)).
+intro.
+apply Rle_lt_trans with
+ (R_dist (sum_f_R0 (fun i:nat => Rabs (An i)) n)
+ (sum_f_R0 (fun i:nat => Rabs (An i)) m)).
+assumption.
+apply H1; assumption.
+assert (H4 := lt_eq_lt_dec n m).
+elim H4; intro.
+elim a; intro.
+rewrite (tech2 An n m); [ idtac | assumption ].
+rewrite (tech2 (fun i:nat => Rabs (An i)) n m); [ idtac | assumption ].
+unfold R_dist in |- *.
+unfold Rminus in |- *.
+do 2 rewrite Ropp_plus_distr.
+do 2 rewrite <- Rplus_assoc.
+do 2 rewrite Rplus_opp_r.
+do 2 rewrite Rplus_0_l.
+do 2 rewrite Rabs_Ropp.
+rewrite
+ (Rabs_right (sum_f_R0 (fun i:nat => Rabs (An (S n + i)%nat)) (m - S n)))
+ .
+pose (Bn := fun i:nat => An (S n + i)%nat).
+replace (fun i:nat => Rabs (An (S n + i)%nat)) with
+ (fun i:nat => Rabs (Bn i)).
+apply Rabs_triang_gen.
+unfold Bn in |- *; reflexivity.
+apply Rle_ge.
+apply cond_pos_sum.
+intro; apply Rabs_pos.
+rewrite b.
+unfold R_dist in |- *.
+unfold Rminus in |- *; do 2 rewrite Rplus_opp_r.
+rewrite Rabs_R0; right; reflexivity.
+rewrite (tech2 An m n); [ idtac | assumption ].
+rewrite (tech2 (fun i:nat => Rabs (An i)) m n); [ idtac | assumption ].
+unfold R_dist in |- *.
+unfold Rminus in |- *.
+do 2 rewrite Rplus_assoc.
+rewrite (Rplus_comm (sum_f_R0 An m)).
+rewrite (Rplus_comm (sum_f_R0 (fun i:nat => Rabs (An i)) m)).
+do 2 rewrite Rplus_assoc.
+do 2 rewrite Rplus_opp_l.
+do 2 rewrite Rplus_0_r.
+rewrite
+ (Rabs_right (sum_f_R0 (fun i:nat => Rabs (An (S m + i)%nat)) (n - S m)))
+ .
+pose (Bn := fun i:nat => An (S m + i)%nat).
+replace (fun i:nat => Rabs (An (S m + i)%nat)) with
+ (fun i:nat => Rabs (Bn i)).
+apply Rabs_triang_gen.
+unfold Bn in |- *; reflexivity.
+apply Rle_ge.
+apply cond_pos_sum.
+intro; apply Rabs_pos.
Qed.
(**********)
-Lemma cv_cauchy_1 : (An:nat->R) (sigTT R [l:R](Un_cv [N:nat](sum_f_R0 An N) l)) -> (Cauchy_crit_series An).
-Intros.
-Elim X; Intros.
-Unfold Un_cv in p.
-Unfold Cauchy_crit_series; Unfold Cauchy_crit.
-Intros.
-Cut ``0<eps/2``.
-Intro.
-Elim (p ``eps/2`` H0); Intros.
-Exists x0.
-Intros.
-Apply Rle_lt_trans with ``(R_dist (sum_f_R0 An n) x)+(R_dist (sum_f_R0 An m) x)``.
-Unfold R_dist.
-Replace ``(sum_f_R0 An n)-(sum_f_R0 An m)`` with ``((sum_f_R0 An n)-x)+ -((sum_f_R0 An m)-x)``; [Idtac | Ring].
-Rewrite <- (Rabsolu_Ropp ``(sum_f_R0 An m)-x``).
-Apply Rabsolu_triang.
-Apply Rlt_le_trans with ``eps/2+eps/2``.
-Apply Rplus_lt.
-Apply H1; Assumption.
-Apply H1; Assumption.
-Right; Symmetry; Apply double_var.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
+Lemma cv_cauchy_1 :
+ forall An:nat -> R,
+ sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l) ->
+ Cauchy_crit_series An.
+intros.
+elim X; intros.
+unfold Un_cv in p.
+unfold Cauchy_crit_series in |- *; unfold Cauchy_crit in |- *.
+intros.
+cut (0 < eps / 2).
+intro.
+elim (p (eps / 2) H0); intros.
+exists x0.
+intros.
+apply Rle_lt_trans with (R_dist (sum_f_R0 An n) x + R_dist (sum_f_R0 An m) x).
+unfold R_dist in |- *.
+replace (sum_f_R0 An n - sum_f_R0 An m) with
+ (sum_f_R0 An n - x + - (sum_f_R0 An m - x)); [ idtac | ring ].
+rewrite <- (Rabs_Ropp (sum_f_R0 An m - x)).
+apply Rabs_triang.
+apply Rlt_le_trans with (eps / 2 + eps / 2).
+apply Rplus_lt_compat.
+apply H1; assumption.
+apply H1; assumption.
+right; symmetry in |- *; apply double_var.
+unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
Qed.
-Lemma cv_cauchy_2 : (An:nat->R) (Cauchy_crit_series An) -> (sigTT R [l:R](Un_cv [N:nat](sum_f_R0 An N) l)).
-Intros.
-Apply R_complete.
-Unfold Cauchy_crit_series in H.
-Exact H.
+Lemma cv_cauchy_2 :
+ forall An:nat -> R,
+ Cauchy_crit_series An ->
+ sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l).
+intros.
+apply R_complete.
+unfold Cauchy_crit_series in H.
+exact H.
Qed.
(**********)
-Lemma sum_eq_R0 : (An:nat->R;N:nat) ((n:nat)(le n N)->``(An n)==0``) -> (sum_f_R0 An N)==R0.
-Intros; Induction N.
-Simpl; Apply H; Apply le_n.
-Rewrite tech5; Rewrite HrecN; [Rewrite Rplus_Ol; Apply H; Apply le_n | Intros; Apply H; Apply le_trans with N; [Assumption | Apply le_n_Sn]].
+Lemma sum_eq_R0 :
+ forall (An:nat -> R) (N:nat),
+ (forall n:nat, (n <= N)%nat -> An n = 0) -> sum_f_R0 An N = 0.
+intros; induction N as [| N HrecN].
+simpl in |- *; apply H; apply le_n.
+rewrite tech5; rewrite HrecN;
+ [ rewrite Rplus_0_l; apply H; apply le_n
+ | intros; apply H; apply le_trans with N; [ assumption | apply le_n_Sn ] ].
Qed.
-Definition SP [fn:nat->R->R;N:nat] : R->R := [x:R](sum_f_R0 [k:nat]``(fn k x)`` N).
+Definition SP (fn:nat -> R -> R) (N:nat) (x:R) : R :=
+ sum_f_R0 (fun k:nat => fn k x) N.
(**********)
-Lemma sum_incr : (An:nat->R;N:nat;l:R) (Un_cv [n:nat](sum_f_R0 An n) l) -> ((n:nat)``0<=(An n)``) -> ``(sum_f_R0 An N)<=l``.
-Intros; Case (total_order_T (sum_f_R0 An N) l); Intro.
-Elim s; Intro.
-Left; Apply a.
-Right; Apply b.
-Cut (Un_growing [n:nat](sum_f_R0 An n)).
-Intro; Pose l1 := (sum_f_R0 An N).
-Fold l1 in r.
-Unfold Un_cv in H; Cut ``0<l1-l``.
-Intro; Elim (H ? H2); Intros.
-Pose N0 := (max x N); Cut (ge N0 x).
-Intro; Assert H5 := (H3 N0 H4).
-Cut ``l1<=(sum_f_R0 An N0)``.
-Intro; Unfold R_dist in H5; Rewrite Rabsolu_right in H5.
-Cut ``(sum_f_R0 An N0)<l1``.
-Intro; Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? H7 H6)).
-Apply Rlt_anti_compatibility with ``-l``.
-Do 2 Rewrite (Rplus_sym ``-l``).
-Apply H5.
-Apply Rle_sym1; Apply Rle_anti_compatibility with l.
-Rewrite Rplus_Or; Replace ``l+((sum_f_R0 An N0)-l)`` with (sum_f_R0 An N0); [Idtac | Ring]; Apply Rle_trans with l1.
-Left; Apply r.
-Apply H6.
-Unfold l1; Apply Rle_sym2; Apply (growing_prop [k:nat](sum_f_R0 An k)).
-Apply H1.
-Unfold ge N0; Apply le_max_r.
-Unfold ge N0; Apply le_max_l.
-Apply Rlt_anti_compatibility with l; Rewrite Rplus_Or; Replace ``l+(l1-l)`` with l1; [Apply r | Ring].
-Unfold Un_growing; Intro; Simpl; Pattern 1 (sum_f_R0 An n); Rewrite <- Rplus_Or; Apply Rle_compatibility; Apply H0.
+Lemma sum_incr :
+ forall (An:nat -> R) (N:nat) (l:R),
+ Un_cv (fun n:nat => sum_f_R0 An n) l ->
+ (forall n:nat, 0 <= An n) -> sum_f_R0 An N <= l.
+intros; case (total_order_T (sum_f_R0 An N) l); intro.
+elim s; intro.
+left; apply a.
+right; apply b.
+cut (Un_growing (fun n:nat => sum_f_R0 An n)).
+intro; pose (l1 := sum_f_R0 An N).
+fold l1 in r.
+unfold Un_cv in H; cut (0 < l1 - l).
+intro; elim (H _ H2); intros.
+pose (N0 := max x N); cut (N0 >= x)%nat.
+intro; assert (H5 := H3 N0 H4).
+cut (l1 <= sum_f_R0 An N0).
+intro; unfold R_dist in H5; rewrite Rabs_right in H5.
+cut (sum_f_R0 An N0 < l1).
+intro; elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H7 H6)).
+apply Rplus_lt_reg_r with (- l).
+do 2 rewrite (Rplus_comm (- l)).
+apply H5.
+apply Rle_ge; apply Rplus_le_reg_l with l.
+rewrite Rplus_0_r; replace (l + (sum_f_R0 An N0 - l)) with (sum_f_R0 An N0);
+ [ idtac | ring ]; apply Rle_trans with l1.
+left; apply r.
+apply H6.
+unfold l1 in |- *; apply Rge_le;
+ apply (growing_prop (fun k:nat => sum_f_R0 An k)).
+apply H1.
+unfold ge, N0 in |- *; apply le_max_r.
+unfold ge, N0 in |- *; apply le_max_l.
+apply Rplus_lt_reg_r with l; rewrite Rplus_0_r;
+ replace (l + (l1 - l)) with l1; [ apply r | ring ].
+unfold Un_growing in |- *; intro; simpl in |- *;
+ pattern (sum_f_R0 An n) at 1 in |- *; rewrite <- Rplus_0_r;
+ apply Rplus_le_compat_l; apply H0.
Qed.
(**********)
-Lemma sum_cv_maj : (An:nat->R;fn:nat->R->R;x,l1,l2:R) (Un_cv [n:nat](SP fn n x) l1) -> (Un_cv [n:nat](sum_f_R0 An n) l2) -> ((n:nat)``(Rabsolu (fn n x))<=(An n)``) -> ``(Rabsolu l1)<=l2``.
-Intros; Case (total_order_T (Rabsolu l1) l2); Intro.
-Elim s; Intro.
-Left; Apply a.
-Right; Apply b.
-Cut (n0:nat)``(Rabsolu (SP fn n0 x))<=(sum_f_R0 An n0)``.
-Intro; Cut ``0<((Rabsolu l1)-l2)/2``.
-Intro; Unfold Un_cv in H H0.
-Elim (H ? H3); Intros Na H4.
-Elim (H0 ? H3); Intros Nb H5.
-Pose N := (max Na Nb).
-Unfold R_dist in H4 H5.
-Cut ``(Rabsolu ((sum_f_R0 An N)-l2))<((Rabsolu l1)-l2)/2``.
-Intro; Cut ``(Rabsolu ((Rabsolu l1)-(Rabsolu (SP fn N x))))<((Rabsolu l1)-l2)/2``.
-Intro; Cut ``(sum_f_R0 An N)<((Rabsolu l1)+l2)/2``.
-Intro; Cut ``((Rabsolu l1)+l2)/2<(Rabsolu (SP fn N x))``.
-Intro; Cut ``(sum_f_R0 An N)<(Rabsolu (SP fn N x))``.
-Intro; Assert H11 := (H2 N).
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H11 H10)).
-Apply Rlt_trans with ``((Rabsolu l1)+l2)/2``; Assumption.
-Case (case_Rabsolu ``(Rabsolu l1)-(Rabsolu (SP fn N x))``); Intro.
-Apply Rlt_trans with (Rabsolu l1).
-Apply Rlt_monotony_contra with ``2``.
-Sup0.
-Unfold Rdiv; Rewrite (Rmult_sym ``2``); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Rewrite double; Apply Rlt_compatibility; Apply r.
-DiscrR.
-Apply (Rminus_lt ? ? r0).
-Rewrite (Rabsolu_right ? r0) in H7.
-Apply Rlt_anti_compatibility with ``((Rabsolu l1)-l2)/2-(Rabsolu (SP fn N x))``.
-Replace ``((Rabsolu l1)-l2)/2-(Rabsolu (SP fn N x))+((Rabsolu l1)+l2)/2`` with ``(Rabsolu l1)-(Rabsolu (SP fn N x))``.
-Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Apply H7.
-Unfold Rdiv; Rewrite Rmult_Rplus_distrl; Rewrite <- (Rmult_sym ``/2``); Rewrite Rminus_distr; Repeat Rewrite (Rmult_sym ``/2``); Pattern 1 (Rabsolu l1); Rewrite double_var; Unfold Rdiv; Ring.
-Case (case_Rabsolu ``(sum_f_R0 An N)-l2``); Intro.
-Apply Rlt_trans with l2.
-Apply (Rminus_lt ? ? r0).
-Apply Rlt_monotony_contra with ``2``.
-Sup0.
-Rewrite (double l2); Unfold Rdiv; Rewrite (Rmult_sym ``2``); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Rewrite (Rplus_sym (Rabsolu l1)); Apply Rlt_compatibility; Apply r.
-DiscrR.
-Rewrite (Rabsolu_right ? r0) in H6; Apply Rlt_anti_compatibility with ``-l2``.
-Replace ``-l2+((Rabsolu l1)+l2)/2`` with ``((Rabsolu l1)-l2)/2``.
-Rewrite Rplus_sym; Apply H6.
-Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite Rminus_distr; Rewrite Rmult_Rplus_distrl; Pattern 2 l2; Rewrite double_var; Repeat Rewrite (Rmult_sym ``/2``); Rewrite Ropp_distr1; Unfold Rdiv; Ring.
-Apply Rle_lt_trans with ``(Rabsolu ((SP fn N x)-l1))``.
-Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr3; Apply Rabsolu_triang_inv2.
-Apply H4; Unfold ge N; Apply le_max_l.
-Apply H5; Unfold ge N; Apply le_max_r.
-Unfold Rdiv; Apply Rmult_lt_pos.
-Apply Rlt_anti_compatibility with l2.
-Rewrite Rplus_Or; Replace ``l2+((Rabsolu l1)-l2)`` with (Rabsolu l1); [Apply r | Ring].
-Apply Rlt_Rinv; Sup0.
-Intros; Induction n0.
-Unfold SP; Simpl; Apply H1.
-Unfold SP; Simpl.
-Apply Rle_trans with (Rplus (Rabsolu (sum_f_R0 [k:nat](fn k x) n0)) (Rabsolu (fn (S n0) x))).
-Apply Rabsolu_triang.
-Apply Rle_trans with ``(sum_f_R0 An n0)+(Rabsolu (fn (S n0) x))``.
-Do 2 Rewrite <- (Rplus_sym (Rabsolu (fn (S n0) x))).
-Apply Rle_compatibility; Apply Hrecn0.
-Apply Rle_compatibility; Apply H1.
-Qed.
+Lemma sum_cv_maj :
+ forall (An:nat -> R) (fn:nat -> R -> R) (x l1 l2:R),
+ Un_cv (fun n:nat => SP fn n x) l1 ->
+ Un_cv (fun n:nat => sum_f_R0 An n) l2 ->
+ (forall n:nat, Rabs (fn n x) <= An n) -> Rabs l1 <= l2.
+intros; case (total_order_T (Rabs l1) l2); intro.
+elim s; intro.
+left; apply a.
+right; apply b.
+cut (forall n0:nat, Rabs (SP fn n0 x) <= sum_f_R0 An n0).
+intro; cut (0 < (Rabs l1 - l2) / 2).
+intro; unfold Un_cv in H, H0.
+elim (H _ H3); intros Na H4.
+elim (H0 _ H3); intros Nb H5.
+pose (N := max Na Nb).
+unfold R_dist in H4, H5.
+cut (Rabs (sum_f_R0 An N - l2) < (Rabs l1 - l2) / 2).
+intro; cut (Rabs (Rabs l1 - Rabs (SP fn N x)) < (Rabs l1 - l2) / 2).
+intro; cut (sum_f_R0 An N < (Rabs l1 + l2) / 2).
+intro; cut ((Rabs l1 + l2) / 2 < Rabs (SP fn N x)).
+intro; cut (sum_f_R0 An N < Rabs (SP fn N x)).
+intro; assert (H11 := H2 N).
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H11 H10)).
+apply Rlt_trans with ((Rabs l1 + l2) / 2); assumption.
+case (Rcase_abs (Rabs l1 - Rabs (SP fn N x))); intro.
+apply Rlt_trans with (Rabs l1).
+apply Rmult_lt_reg_l with 2.
+prove_sup0.
+unfold Rdiv in |- *; rewrite (Rmult_comm 2); rewrite Rmult_assoc;
+ rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r; rewrite double; apply Rplus_lt_compat_l; apply r.
+discrR.
+apply (Rminus_lt _ _ r0).
+rewrite (Rabs_right _ r0) in H7.
+apply Rplus_lt_reg_r with ((Rabs l1 - l2) / 2 - Rabs (SP fn N x)).
+replace ((Rabs l1 - l2) / 2 - Rabs (SP fn N x) + (Rabs l1 + l2) / 2) with
+ (Rabs l1 - Rabs (SP fn N x)).
+unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_l;
+ rewrite Rplus_0_r; apply H7.
+unfold Rdiv in |- *; rewrite Rmult_plus_distr_r;
+ rewrite <- (Rmult_comm (/ 2)); rewrite Rmult_minus_distr_l;
+ repeat rewrite (Rmult_comm (/ 2)); pattern (Rabs l1) at 1 in |- *;
+ rewrite double_var; unfold Rdiv in |- *; ring.
+case (Rcase_abs (sum_f_R0 An N - l2)); intro.
+apply Rlt_trans with l2.
+apply (Rminus_lt _ _ r0).
+apply Rmult_lt_reg_l with 2.
+prove_sup0.
+rewrite (double l2); unfold Rdiv in |- *; rewrite (Rmult_comm 2);
+ rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r; rewrite (Rplus_comm (Rabs l1)); apply Rplus_lt_compat_l;
+ apply r.
+discrR.
+rewrite (Rabs_right _ r0) in H6; apply Rplus_lt_reg_r with (- l2).
+replace (- l2 + (Rabs l1 + l2) / 2) with ((Rabs l1 - l2) / 2).
+rewrite Rplus_comm; apply H6.
+unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2));
+ rewrite Rmult_minus_distr_l; rewrite Rmult_plus_distr_r;
+ pattern l2 at 2 in |- *; rewrite double_var;
+ repeat rewrite (Rmult_comm (/ 2)); rewrite Ropp_plus_distr;
+ unfold Rdiv in |- *; ring.
+apply Rle_lt_trans with (Rabs (SP fn N x - l1)).
+rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr'; apply Rabs_triang_inv2.
+apply H4; unfold ge, N in |- *; apply le_max_l.
+apply H5; unfold ge, N in |- *; apply le_max_r.
+unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+apply Rplus_lt_reg_r with l2.
+rewrite Rplus_0_r; replace (l2 + (Rabs l1 - l2)) with (Rabs l1);
+ [ apply r | ring ].
+apply Rinv_0_lt_compat; prove_sup0.
+intros; induction n0 as [| n0 Hrecn0].
+unfold SP in |- *; simpl in |- *; apply H1.
+unfold SP in |- *; simpl in |- *.
+apply Rle_trans with
+ (Rabs (sum_f_R0 (fun k:nat => fn k x) n0) + Rabs (fn (S n0) x)).
+apply Rabs_triang.
+apply Rle_trans with (sum_f_R0 An n0 + Rabs (fn (S n0) x)).
+do 2 rewrite <- (Rplus_comm (Rabs (fn (S n0) x))).
+apply Rplus_le_compat_l; apply Hrecn0.
+apply Rplus_le_compat_l; apply H1.
+Qed. \ No newline at end of file
diff --git a/theories/Reals/RIneq.v b/theories/Reals/RIneq.v
index 12644ae37..5534cde45 100644
--- a/theories/Reals/RIneq.v
+++ b/theories/Reals/RIneq.v
@@ -14,83 +14,84 @@
Require Export Raxioms.
Require Export ZArithRing.
-Require Omega.
+Require Import Omega.
Require Export Field.
Open Local Scope Z_scope.
Open Local Scope R_scope.
-Implicit Variable Type r:R.
+Implicit Type r : R.
(***************************************************************************)
(** Instantiating Ring tactic on reals *)
(***************************************************************************)
-Lemma RTheory : (Ring_Theory Rplus Rmult R1 R0 Ropp [x,y:R]false).
- Split.
- Exact Rplus_sym.
- Symmetry; Apply Rplus_assoc.
- Exact Rmult_sym.
- Symmetry; Apply Rmult_assoc.
- Intro; Apply Rplus_Ol.
- Intro; Apply Rmult_1l.
- Exact Rplus_Ropp_r.
- Intros.
- Rewrite Rmult_sym.
- Rewrite (Rmult_sym n p).
- Rewrite (Rmult_sym m p).
- Apply Rmult_Rplus_distr.
- Intros; Contradiction.
+Lemma RTheory : Ring_Theory Rplus Rmult 1 0 Ropp (fun x y:R => false).
+ split.
+ exact Rplus_comm.
+ symmetry in |- *; apply Rplus_assoc.
+ exact Rmult_comm.
+ symmetry in |- *; apply Rmult_assoc.
+ intro; apply Rplus_0_l.
+ intro; apply Rmult_1_l.
+ exact Rplus_opp_r.
+ intros.
+ rewrite Rmult_comm.
+ rewrite (Rmult_comm n p).
+ rewrite (Rmult_comm m p).
+ apply Rmult_plus_distr_l.
+ intros; contradiction.
Defined.
-Add Field R Rplus Rmult R1 R0 Ropp [x,y:R]false Rinv RTheory Rinv_l
- with minus:=Rminus div:=Rdiv.
+Add Field R Rplus Rmult 1 0 Ropp (fun x y:R => false) Rinv RTheory Rinv_l
+ with minus := Rminus div := Rdiv.
(**************************************************************************)
(** Relation between orders and equality *)
(**************************************************************************)
(**********)
-Lemma Rlt_antirefl:(r:R)~``r<r``.
- Generalize Rlt_antisym. Intuition EAuto.
+Lemma Rlt_irrefl : forall r, ~ r < r.
+ generalize Rlt_asym. intuition eauto.
Qed.
-Hints Resolve Rlt_antirefl : real.
+Hint Resolve Rlt_irrefl: real.
-Lemma Rle_refl : (x:R) ``x<=x``.
-Intro; Right; Reflexivity.
+Lemma Rle_refl : forall r, r <= r.
+intro; right; reflexivity.
Qed.
-Lemma Rlt_not_eq:(r1,r2:R)``r1<r2``->``r1<>r2``.
- Red; Intros r1 r2 H H0; Apply (Rlt_antirefl r1).
- Pattern 2 r1; Rewrite H0; Trivial.
+Lemma Rlt_not_eq : forall r1 r2, r1 < r2 -> r1 <> r2.
+ red in |- *; intros r1 r2 H H0; apply (Rlt_irrefl r1).
+ pattern r1 at 2 in |- *; rewrite H0; trivial.
Qed.
-Lemma Rgt_not_eq:(r1,r2:R)``r1>r2``->``r1<>r2``.
-Intros; Apply sym_not_eqT; Apply Rlt_not_eq; Auto with real.
+Lemma Rgt_not_eq : forall r1 r2, r1 > r2 -> r1 <> r2.
+intros; apply sym_not_eq; apply Rlt_not_eq; auto with real.
Qed.
(**********)
-Lemma imp_not_Req:(r1,r2:R)(``r1<r2``\/ ``r1>r2``) -> ``r1<>r2``.
-Generalize Rlt_not_eq Rgt_not_eq. Intuition EAuto.
+Lemma Rlt_dichotomy_converse : forall r1 r2, r1 < r2 \/ r1 > r2 -> r1 <> r2.
+generalize Rlt_not_eq Rgt_not_eq. intuition eauto.
Qed.
-Hints Resolve imp_not_Req : real.
+Hint Resolve Rlt_dichotomy_converse: real.
(** Reasoning by case on equalities and order *)
(**********)
-Lemma Req_EM:(r1,r2:R)(r1==r2)\/``r1<>r2``.
-Intros ; Generalize (total_order_T r1 r2) imp_not_Req ; Intuition EAuto 3.
+Lemma Req_dec : forall r1 r2, r1 = r2 \/ r1 <> r2.
+intros; generalize (total_order_T r1 r2) Rlt_dichotomy_converse;
+ intuition eauto 3.
Qed.
-Hints Resolve Req_EM : real.
+Hint Resolve Req_dec: real.
(**********)
-Lemma total_order:(r1,r2:R)``r1<r2``\/(r1==r2)\/``r1>r2``.
-Intros;Generalize (total_order_T r1 r2);Tauto.
+Lemma Rtotal_order : forall r1 r2, r1 < r2 \/ r1 = r2 \/ r1 > r2.
+intros; generalize (total_order_T r1 r2); tauto.
Qed.
(**********)
-Lemma not_Req:(r1,r2:R)``r1<>r2``->(``r1<r2``\/``r1>r2``).
-Intros; Generalize (total_order_T r1 r2) ; Tauto.
+Lemma Rdichotomy : forall r1 r2, r1 <> r2 -> r1 < r2 \/ r1 > r2.
+intros; generalize (total_order_T r1 r2); tauto.
Qed.
@@ -99,152 +100,154 @@ Qed.
(*********************************************************************************)
(**********)
-Lemma Rlt_le:(r1,r2:R)``r1<r2``-> ``r1<=r2``.
-Intros ; Red ; Tauto.
+Lemma Rlt_le : forall r1 r2, r1 < r2 -> r1 <= r2.
+intros; red in |- *; tauto.
Qed.
-Hints Resolve Rlt_le : real.
+Hint Resolve Rlt_le: real.
(**********)
-Lemma Rle_ge : (r1,r2:R)``r1<=r2`` -> ``r2>=r1``.
-NewDestruct 1; Red; Auto with real.
+Lemma Rle_ge : forall r1 r2, r1 <= r2 -> r2 >= r1.
+destruct 1; red in |- *; auto with real.
Qed.
-Hints Immediate Rle_ge : real.
+Hint Immediate Rle_ge: real.
(**********)
-Lemma Rge_le : (r1,r2:R)``r1>=r2`` -> ``r2<=r1``.
-NewDestruct 1; Red; Auto with real.
+Lemma Rge_le : forall r1 r2, r1 >= r2 -> r2 <= r1.
+destruct 1; red in |- *; auto with real.
Qed.
-Hints Resolve Rge_le : real.
+Hint Resolve Rge_le: real.
(**********)
-Lemma not_Rle:(r1,r2:R)~``r1<=r2`` -> ``r2<r1``.
-Intros r1 r2 ; Generalize (total_order r1 r2) ; Unfold Rle; Tauto.
+Lemma Rnot_le_lt : forall r1 r2, ~ r1 <= r2 -> r2 < r1.
+intros r1 r2; generalize (Rtotal_order r1 r2); unfold Rle in |- *; tauto.
Qed.
-Hints Immediate not_Rle : real.
+Hint Immediate Rnot_le_lt: real.
-Lemma not_Rge:(r1,r2:R)~``r1>=r2`` -> ``r1<r2``.
-Intros; Apply not_Rle; Auto with real.
+Lemma Rnot_ge_lt : forall r1 r2, ~ r1 >= r2 -> r1 < r2.
+intros; apply Rnot_le_lt; auto with real.
Qed.
(**********)
-Lemma Rlt_le_not:(r1,r2:R)``r2<r1`` -> ~``r1<=r2``.
-Generalize Rlt_antisym imp_not_Req ; Unfold Rle.
-Intuition EAuto 3.
+Lemma Rlt_not_le : forall r1 r2, r2 < r1 -> ~ r1 <= r2.
+generalize Rlt_asym Rlt_dichotomy_converse; unfold Rle in |- *.
+intuition eauto 3.
Qed.
-Lemma Rle_not:(r1,r2:R)``r1>r2`` -> ~``r1<=r2``.
-Proof Rlt_le_not.
+Lemma Rgt_not_le : forall r1 r2, r1 > r2 -> ~ r1 <= r2.
+Proof Rlt_not_le.
-Hints Immediate Rlt_le_not : real.
+Hint Immediate Rlt_not_le: real.
-Lemma Rle_not_lt: (r1, r2:R) ``r2 <= r1`` -> ~``r1<r2``.
-Intros r1 r2. Generalize (Rlt_antisym r1 r2) (imp_not_Req r1 r2).
-Unfold Rle; Intuition.
+Lemma Rle_not_lt : forall r1 r2, r2 <= r1 -> ~ r1 < r2.
+intros r1 r2. generalize (Rlt_asym r1 r2) (Rlt_dichotomy_converse r1 r2).
+unfold Rle in |- *; intuition.
Qed.
(**********)
-Lemma Rlt_ge_not:(r1,r2:R)``r1<r2`` -> ~``r1>=r2``.
-Generalize Rlt_le_not. Unfold Rle Rge. Intuition EAuto 3.
+Lemma Rlt_not_ge : forall r1 r2, r1 < r2 -> ~ r1 >= r2.
+generalize Rlt_not_le. unfold Rle, Rge in |- *. intuition eauto 3.
Qed.
-Hints Immediate Rlt_ge_not : real.
+Hint Immediate Rlt_not_ge: real.
(**********)
-Lemma eq_Rle:(r1,r2:R)r1==r2->``r1<=r2``.
-Unfold Rle; Tauto.
+Lemma Req_le : forall r1 r2, r1 = r2 -> r1 <= r2.
+unfold Rle in |- *; tauto.
Qed.
-Hints Immediate eq_Rle : real.
+Hint Immediate Req_le: real.
-Lemma eq_Rge:(r1,r2:R)r1==r2->``r1>=r2``.
-Unfold Rge; Tauto.
+Lemma Req_ge : forall r1 r2, r1 = r2 -> r1 >= r2.
+unfold Rge in |- *; tauto.
Qed.
-Hints Immediate eq_Rge : real.
+Hint Immediate Req_ge: real.
-Lemma eq_Rle_sym:(r1,r2:R)r2==r1->``r1<=r2``.
-Unfold Rle; Auto.
+Lemma Req_le_sym : forall r1 r2, r2 = r1 -> r1 <= r2.
+unfold Rle in |- *; auto.
Qed.
-Hints Immediate eq_Rle_sym : real.
+Hint Immediate Req_le_sym: real.
-Lemma eq_Rge_sym:(r1,r2:R)r2==r1->``r1>=r2``.
-Unfold Rge; Auto.
+Lemma Req_ge_sym : forall r1 r2, r2 = r1 -> r1 >= r2.
+unfold Rge in |- *; auto.
Qed.
-Hints Immediate eq_Rge_sym : real.
+Hint Immediate Req_ge_sym: real.
-Lemma Rle_antisym : (r1,r2:R)``r1<=r2`` -> ``r2<=r1``-> r1==r2.
-Intros r1 r2; Generalize (Rlt_antisym r1 r2) ; Unfold Rle ; Intuition.
+Lemma Rle_antisym : forall r1 r2, r1 <= r2 -> r2 <= r1 -> r1 = r2.
+intros r1 r2; generalize (Rlt_asym r1 r2); unfold Rle in |- *; intuition.
Qed.
-Hints Resolve Rle_antisym : real.
+Hint Resolve Rle_antisym: real.
(**********)
-Lemma Rle_le_eq:(r1,r2:R)(``r1<=r2``/\``r2<=r1``)<->(r1==r2).
-Intuition.
+Lemma Rle_le_eq : forall r1 r2, r1 <= r2 /\ r2 <= r1 <-> r1 = r2.
+intuition.
Qed.
-Lemma Rlt_rew : (x,x',y,y':R)``x==x'``->``x'<y'`` -> `` y' == y`` -> ``x < y``.
-Intros x x' y y'; Intros; Replace x with x'; Replace y with y'; Assumption.
+Lemma Rlt_eq_compat :
+ forall r1 r2 r3 r4, r1 = r2 -> r2 < r4 -> r4 = r3 -> r1 < r3.
+intros x x' y y'; intros; replace x with x'; replace y with y'; assumption.
Qed.
(**********)
-Lemma Rle_trans:(r1,r2,r3:R) ``r1<=r2``->``r2<=r3``->``r1<=r3``.
-Generalize trans_eqT Rlt_trans Rlt_rew.
-Unfold Rle.
-Intuition EAuto 2.
+Lemma Rle_trans : forall r1 r2 r3, r1 <= r2 -> r2 <= r3 -> r1 <= r3.
+generalize trans_eq Rlt_trans Rlt_eq_compat.
+unfold Rle in |- *.
+intuition eauto 2.
Qed.
(**********)
-Lemma Rle_lt_trans:(r1,r2,r3:R)``r1<=r2``->``r2<r3``->``r1<r3``.
-Generalize Rlt_trans Rlt_rew.
-Unfold Rle.
-Intuition EAuto 2.
+Lemma Rle_lt_trans : forall r1 r2 r3, r1 <= r2 -> r2 < r3 -> r1 < r3.
+generalize Rlt_trans Rlt_eq_compat.
+unfold Rle in |- *.
+intuition eauto 2.
Qed.
(**********)
-Lemma Rlt_le_trans:(r1,r2,r3:R)``r1<r2``->``r2<=r3``->``r1<r3``.
-Generalize Rlt_trans Rlt_rew; Unfold Rle; Intuition EAuto 2.
+Lemma Rlt_le_trans : forall r1 r2 r3, r1 < r2 -> r2 <= r3 -> r1 < r3.
+generalize Rlt_trans Rlt_eq_compat; unfold Rle in |- *; intuition eauto 2.
Qed.
(** Decidability of the order *)
-Lemma total_order_Rlt:(r1,r2:R)(sumboolT ``r1<r2`` ~(``r1<r2``)).
-Intros;Generalize (total_order_T r1 r2) (imp_not_Req r1 r2) ; Intuition.
+Lemma Rlt_dec : forall r1 r2, {r1 < r2} + {~ r1 < r2}.
+intros; generalize (total_order_T r1 r2) (Rlt_dichotomy_converse r1 r2);
+ intuition.
Qed.
(**********)
-Lemma total_order_Rle:(r1,r2:R)(sumboolT ``r1<=r2`` ~(``r1<=r2``)).
-Intros r1 r2.
-Generalize (total_order_T r1 r2) (imp_not_Req r1 r2).
-Intuition EAuto 4 with real.
+Lemma Rle_dec : forall r1 r2, {r1 <= r2} + {~ r1 <= r2}.
+intros r1 r2.
+generalize (total_order_T r1 r2) (Rlt_dichotomy_converse r1 r2).
+intuition eauto 4 with real.
Qed.
(**********)
-Lemma total_order_Rgt:(r1,r2:R)(sumboolT ``r1>r2`` ~(``r1>r2``)).
-Intros;Unfold Rgt;Intros;Apply total_order_Rlt.
+Lemma Rgt_dec : forall r1 r2, {r1 > r2} + {~ r1 > r2}.
+intros; unfold Rgt in |- *; intros; apply Rlt_dec.
Qed.
(**********)
-Lemma total_order_Rge:(r1,r2:R)(sumboolT (``r1>=r2``) ~(``r1>=r2``)).
-Intros;Generalize (total_order_Rle r2 r1);Intuition.
+Lemma Rge_dec : forall r1 r2, {r1 >= r2} + {~ r1 >= r2}.
+intros; generalize (Rle_dec r2 r1); intuition.
Qed.
-Lemma total_order_Rlt_Rle:(r1,r2:R)(sumboolT ``r1<r2`` ``r2<=r1``).
-Intros;Generalize (total_order_T r1 r2); Intuition.
+Lemma Rlt_le_dec : forall r1 r2, {r1 < r2} + {r2 <= r1}.
+intros; generalize (total_order_T r1 r2); intuition.
Qed.
-Lemma Rle_or_lt: (n, m:R)(Rle n m) \/ (Rlt m n).
-Intros n m; Elim (total_order_Rlt_Rle m n);Auto with real.
+Lemma Rle_or_lt : forall r1 r2, r1 <= r2 \/ r2 < r1.
+intros n m; elim (Rlt_le_dec m n); auto with real.
Qed.
-Lemma total_order_Rle_Rlt_eq :(r1,r2:R)``r1<=r2``->
- (sumboolT ``r1<r2`` ``r1==r2``).
-Intros r1 r2 H;Generalize (total_order_T r1 r2); Intuition.
+Lemma Rle_lt_or_eq_dec : forall r1 r2, r1 <= r2 -> {r1 < r2} + {r1 = r2}.
+intros r1 r2 H; generalize (total_order_T r1 r2); intuition.
Qed.
(**********)
-Lemma inser_trans_R:(n,m,p,q:R)``n<=m<p``-> (sumboolT ``n<=m<q`` ``q<=m<p``).
-Intros n m p q; Intros; Generalize (total_order_Rlt_Rle m q); Intuition.
+Lemma inser_trans_R :
+ forall r1 r2 r3 r4, r1 <= r2 < r3 -> {r1 <= r2 < r4} + {r4 <= r2 < r3}.
+intros n m p q; intros; generalize (Rlt_le_dec m q); intuition.
Qed.
(****************************************************************)
@@ -255,53 +258,51 @@ Qed.
(** Addition *)
(*********************************************************)
-Lemma Rplus_ne:(r:R)``r+0==r``/\``0+r==r``.
-Intro;Split;Ring.
+Lemma Rplus_ne : forall r, r + 0 = r /\ 0 + r = r.
+intro; split; ring.
Qed.
-Hints Resolve Rplus_ne : real v62.
+Hint Resolve Rplus_ne: real v62.
-Lemma Rplus_Or:(r:R)``r+0==r``.
-Intro; Ring.
+Lemma Rplus_0_r : forall r, r + 0 = r.
+intro; ring.
Qed.
-Hints Resolve Rplus_Or : real.
+Hint Resolve Rplus_0_r: real.
(**********)
-Lemma Rplus_Ropp_l:(r:R)``(-r)+r==0``.
- Intro; Ring.
+Lemma Rplus_opp_l : forall r, - r + r = 0.
+ intro; ring.
Qed.
-Hints Resolve Rplus_Ropp_l : real.
+Hint Resolve Rplus_opp_l: real.
(**********)
-Lemma Rplus_Ropp:(x,y:R)``x+y==0``->``y== -x``.
- Intros x y H; Replace y with ``(-x+x)+y``;
- [ Rewrite -> Rplus_assoc; Rewrite -> H; Ring
- | Ring ].
+Lemma Rplus_opp_r_uniq : forall r1 r2, r1 + r2 = 0 -> r2 = - r1.
+ intros x y H; replace y with (- x + x + y);
+ [ rewrite Rplus_assoc; rewrite H; ring | ring ].
Qed.
(*i New i*)
-Hint eqT_R_congr : real := Resolve (congr_eqT R).
+Hint Resolve (f_equal (A:=R)): real.
-Lemma Rplus_plus_r:(r,r1,r2:R)(r1==r2)->``r+r1==r+r2``.
- Auto with real.
+Lemma Rplus_eq_compat_l : forall r r1 r2, r1 = r2 -> r + r1 = r + r2.
+ auto with real.
Qed.
-(*i Old i*)Hints Resolve Rplus_plus_r : v62.
+(*i Old i*)Hint Resolve Rplus_eq_compat_l: v62.
(**********)
-Lemma r_Rplus_plus:(r,r1,r2:R)``r+r1==r+r2``->r1==r2.
- Intros; Transitivity ``(-r+r)+r1``.
- Ring.
- Transitivity ``(-r+r)+r2``.
- Repeat Rewrite -> Rplus_assoc; Rewrite <- H; Reflexivity.
- Ring.
+Lemma Rplus_eq_reg_l : forall r r1 r2, r + r1 = r + r2 -> r1 = r2.
+ intros; transitivity (- r + r + r1).
+ ring.
+ transitivity (- r + r + r2).
+ repeat rewrite Rplus_assoc; rewrite <- H; reflexivity.
+ ring.
Qed.
-Hints Resolve r_Rplus_plus : real.
+Hint Resolve Rplus_eq_reg_l: real.
(**********)
-Lemma Rplus_ne_i:(r,b:R)``r+b==r`` -> ``b==0``.
- Intros r b; Pattern 2 r; Replace r with ``r+0``;
- EAuto with real.
+Lemma Rplus_0_r_uniq : forall r r1, r + r1 = r -> r1 = 0.
+ intros r b; pattern r at 2 in |- *; replace r with (r + 0); eauto with real.
Qed.
(***********************************************************)
@@ -309,119 +310,119 @@ Qed.
(***********************************************************)
(**********)
-Lemma Rinv_r:(r:R)``r<>0``->``r* (/r)==1``.
- Intros; Rewrite -> Rmult_sym; Auto with real.
+Lemma Rinv_r : forall r, r <> 0 -> r * / r = 1.
+ intros; rewrite Rmult_comm; auto with real.
Qed.
-Hints Resolve Rinv_r : real.
+Hint Resolve Rinv_r: real.
-Lemma Rinv_l_sym:(r:R)``r<>0``->``1==(/r) * r``.
- Symmetry; Auto with real.
+Lemma Rinv_l_sym : forall r, r <> 0 -> 1 = / r * r.
+ symmetry in |- *; auto with real.
Qed.
-Lemma Rinv_r_sym:(r:R)``r<>0``->``1==r* (/r)``.
- Symmetry; Auto with real.
+Lemma Rinv_r_sym : forall r, r <> 0 -> 1 = r * / r.
+ symmetry in |- *; auto with real.
Qed.
-Hints Resolve Rinv_l_sym Rinv_r_sym : real.
+Hint Resolve Rinv_l_sym Rinv_r_sym: real.
(**********)
-Lemma Rmult_Or :(r:R) ``r*0==0``.
-Intro; Ring.
+Lemma Rmult_0_r : forall r, r * 0 = 0.
+intro; ring.
Qed.
-Hints Resolve Rmult_Or : real v62.
+Hint Resolve Rmult_0_r: real v62.
(**********)
-Lemma Rmult_Ol:(r:R) ``0*r==0``.
-Intro; Ring.
+Lemma Rmult_0_l : forall r, 0 * r = 0.
+intro; ring.
Qed.
-Hints Resolve Rmult_Ol : real v62.
+Hint Resolve Rmult_0_l: real v62.
(**********)
-Lemma Rmult_ne:(r:R)``r*1==r``/\``1*r==r``.
-Intro;Split;Ring.
+Lemma Rmult_ne : forall r, r * 1 = r /\ 1 * r = r.
+intro; split; ring.
Qed.
-Hints Resolve Rmult_ne : real v62.
+Hint Resolve Rmult_ne: real v62.
(**********)
-Lemma Rmult_1r:(r:R)(``r*1==r``).
-Intro; Ring.
+Lemma Rmult_1_r : forall r, r * 1 = r.
+intro; ring.
Qed.
-Hints Resolve Rmult_1r : real.
+Hint Resolve Rmult_1_r: real.
(**********)
-Lemma Rmult_mult_r:(r,r1,r2:R)r1==r2->``r*r1==r*r2``.
- Auto with real.
+Lemma Rmult_eq_compat_l : forall r r1 r2, r1 = r2 -> r * r1 = r * r2.
+ auto with real.
Qed.
-(*i OLD i*)Hints Resolve Rmult_mult_r : v62.
+(*i OLD i*)Hint Resolve Rmult_eq_compat_l: v62.
(**********)
-Lemma r_Rmult_mult:(r,r1,r2:R)(``r*r1==r*r2``)->``r<>0``->(r1==r2).
- Intros; Transitivity ``(/r * r)*r1``.
- Rewrite Rinv_l; Auto with real.
- Transitivity ``(/r * r)*r2``.
- Repeat Rewrite Rmult_assoc; Rewrite H; Trivial.
- Rewrite Rinv_l; Auto with real.
+Lemma Rmult_eq_reg_l : forall r r1 r2, r * r1 = r * r2 -> r <> 0 -> r1 = r2.
+ intros; transitivity (/ r * r * r1).
+ rewrite Rinv_l; auto with real.
+ transitivity (/ r * r * r2).
+ repeat rewrite Rmult_assoc; rewrite H; trivial.
+ rewrite Rinv_l; auto with real.
Qed.
(**********)
-Lemma without_div_Od:(r1,r2:R)``r1*r2==0`` -> ``r1==0`` \/ ``r2==0``.
- Intros; Case (Req_EM r1 ``0``); [Intro Hz | Intro Hnotz].
- Auto.
- Right; Apply r_Rmult_mult with r1; Trivial.
- Rewrite H; Auto with real.
+Lemma Rmult_integral : forall r1 r2, r1 * r2 = 0 -> r1 = 0 \/ r2 = 0.
+ intros; case (Req_dec r1 0); [ intro Hz | intro Hnotz ].
+ auto.
+ right; apply Rmult_eq_reg_l with r1; trivial.
+ rewrite H; auto with real.
Qed.
(**********)
-Lemma without_div_Oi:(r1,r2:R) ``r1==0``\/``r2==0`` -> ``r1*r2==0``.
- Intros r1 r2 [H | H]; Rewrite H; Auto with real.
+Lemma Rmult_eq_0_compat : forall r1 r2, r1 = 0 \/ r2 = 0 -> r1 * r2 = 0.
+ intros r1 r2 [H| H]; rewrite H; auto with real.
Qed.
-Hints Resolve without_div_Oi : real.
+Hint Resolve Rmult_eq_0_compat: real.
(**********)
-Lemma without_div_Oi1:(r1,r2:R) ``r1==0`` -> ``r1*r2==0``.
- Auto with real.
+Lemma Rmult_eq_0_compat_r : forall r1 r2, r1 = 0 -> r1 * r2 = 0.
+ auto with real.
Qed.
(**********)
-Lemma without_div_Oi2:(r1,r2:R) ``r2==0`` -> ``r1*r2==0``.
- Auto with real.
+Lemma Rmult_eq_0_compat_l : forall r1 r2, r2 = 0 -> r1 * r2 = 0.
+ auto with real.
Qed.
(**********)
-Lemma without_div_O_contr:(r1,r2:R)``r1*r2<>0`` -> ``r1<>0`` /\ ``r2<>0``.
-Intros r1 r2 H; Split; Red; Intro; Apply H; Auto with real.
+Lemma Rmult_neq_0_reg : forall r1 r2, r1 * r2 <> 0 -> r1 <> 0 /\ r2 <> 0.
+intros r1 r2 H; split; red in |- *; intro; apply H; auto with real.
Qed.
(**********)
-Lemma mult_non_zero :(r1,r2:R)``r1<>0`` /\ ``r2<>0`` -> ``r1*r2<>0``.
-Red; Intros r1 r2 (H1,H2) H.
-Case (without_div_Od r1 r2); Auto with real.
+Lemma Rmult_integral_contrapositive :
+ forall r1 r2, r1 <> 0 /\ r2 <> 0 -> r1 * r2 <> 0.
+red in |- *; intros r1 r2 [H1 H2] H.
+case (Rmult_integral r1 r2); auto with real.
Qed.
-Hints Resolve mult_non_zero : real.
+Hint Resolve Rmult_integral_contrapositive: real.
(**********)
-Lemma Rmult_Rplus_distrl:
- (r1,r2,r3:R) ``(r1+r2)*r3 == (r1*r3)+(r2*r3)``.
-Intros; Ring.
+Lemma Rmult_plus_distr_r :
+ forall r1 r2 r3, (r1 + r2) * r3 = r1 * r3 + r2 * r3.
+intros; ring.
Qed.
(** Square function *)
(***********)
-Definition Rsqr:R->R:=[r:R]``r*r``.
-V7only[Notation "x ²" := (Rsqr x) (at level 2,left associativity).].
+Definition Rsqr r : R := r * r.
(***********)
-Lemma Rsqr_O:(Rsqr ``0``)==``0``.
- Unfold Rsqr; Auto with real.
+Lemma Rsqr_0 : Rsqr 0 = 0.
+ unfold Rsqr in |- *; auto with real.
Qed.
(***********)
-Lemma Rsqr_r_R0:(r:R)(Rsqr r)==``0``->``r==0``.
-Unfold Rsqr;Intros;Elim (without_div_Od r r H);Trivial.
+Lemma Rsqr_0_uniq : forall r, Rsqr r = 0 -> r = 0.
+unfold Rsqr in |- *; intros; elim (Rmult_integral r r H); trivial.
Qed.
(*********************************************************)
@@ -429,736 +430,725 @@ Qed.
(*********************************************************)
(**********)
-Lemma eq_Ropp:(r1,r2:R)(r1==r2)->``-r1 == -r2``.
- Auto with real.
+Lemma Ropp_eq_compat : forall r1 r2, r1 = r2 -> - r1 = - r2.
+ auto with real.
Qed.
-Hints Resolve eq_Ropp : real.
+Hint Resolve Ropp_eq_compat: real.
(**********)
-Lemma Ropp_O:``-0==0``.
- Ring.
+Lemma Ropp_0 : -0 = 0.
+ ring.
Qed.
-Hints Resolve Ropp_O : real v62.
+Hint Resolve Ropp_0: real v62.
(**********)
-Lemma eq_RoppO:(r:R)``r==0``-> ``-r==0``.
- Intros; Rewrite -> H; Auto with real.
+Lemma Ropp_eq_0_compat : forall r, r = 0 -> - r = 0.
+ intros; rewrite H; auto with real.
Qed.
-Hints Resolve eq_RoppO : real.
+Hint Resolve Ropp_eq_0_compat: real.
(**********)
-Lemma Ropp_Ropp:(r:R)``-(-r)==r``.
- Intro; Ring.
+Lemma Ropp_involutive : forall r, - - r = r.
+ intro; ring.
Qed.
-Hints Resolve Ropp_Ropp : real.
+Hint Resolve Ropp_involutive: real.
(*********)
-Lemma Ropp_neq:(r:R)``r<>0``->``-r<>0``.
-Red;Intros r H H0.
-Apply H.
-Transitivity ``-(-r)``; Auto with real.
+Lemma Ropp_neq_0_compat : forall r, r <> 0 -> - r <> 0.
+red in |- *; intros r H H0.
+apply H.
+transitivity (- - r); auto with real.
Qed.
-Hints Resolve Ropp_neq : real.
+Hint Resolve Ropp_neq_0_compat: real.
(**********)
-Lemma Ropp_distr1:(r1,r2:R)``-(r1+r2)==(-r1 + -r2)``.
- Intros; Ring.
+Lemma Ropp_plus_distr : forall r1 r2, - (r1 + r2) = - r1 + - r2.
+ intros; ring.
Qed.
-Hints Resolve Ropp_distr1 : real.
+Hint Resolve Ropp_plus_distr: real.
(** Opposite and multiplication *)
-Lemma Ropp_mul1:(r1,r2:R)``(-r1)*r2 == -(r1*r2)``.
- Intros; Ring.
+Lemma Ropp_mult_distr_l_reverse : forall r1 r2, - r1 * r2 = - (r1 * r2).
+ intros; ring.
Qed.
-Hints Resolve Ropp_mul1 : real.
+Hint Resolve Ropp_mult_distr_l_reverse: real.
(**********)
-Lemma Ropp_mul2:(r1,r2:R)``(-r1)*(-r2)==r1*r2``.
- Intros; Ring.
+Lemma Rmult_opp_opp : forall r1 r2, - r1 * - r2 = r1 * r2.
+ intros; ring.
Qed.
-Hints Resolve Ropp_mul2 : real.
+Hint Resolve Rmult_opp_opp: real.
-Lemma Ropp_mul3 : (r1,r2:R) ``r1*(-r2) == -(r1*r2)``.
-Intros; Rewrite <- Ropp_mul1; Ring.
+Lemma Ropp_mult_distr_r_reverse : forall r1 r2, r1 * - r2 = - (r1 * r2).
+intros; rewrite <- Ropp_mult_distr_l_reverse; ring.
Qed.
(** Substraction *)
-Lemma minus_R0:(r:R)``r-0==r``.
-Intro;Ring.
+Lemma Rminus_0_r : forall r, r - 0 = r.
+intro; ring.
Qed.
-Hints Resolve minus_R0 : real.
+Hint Resolve Rminus_0_r: real.
-Lemma Rminus_Ropp:(r:R)``0-r==-r``.
-Intro;Ring.
+Lemma Rminus_0_l : forall r, 0 - r = - r.
+intro; ring.
Qed.
-Hints Resolve Rminus_Ropp : real.
+Hint Resolve Rminus_0_l: real.
(**********)
-Lemma Ropp_distr2:(r1,r2:R)``-(r1-r2)==r2-r1``.
- Intros; Ring.
+Lemma Ropp_minus_distr : forall r1 r2, - (r1 - r2) = r2 - r1.
+ intros; ring.
Qed.
-Hints Resolve Ropp_distr2 : real.
+Hint Resolve Ropp_minus_distr: real.
-Lemma Ropp_distr3:(r1,r2:R)``-(r2-r1)==r1-r2``.
-Intros; Ring.
+Lemma Ropp_minus_distr' : forall r1 r2, - (r2 - r1) = r1 - r2.
+intros; ring.
Qed.
-Hints Resolve Ropp_distr3 : real.
+Hint Resolve Ropp_minus_distr': real.
(**********)
-Lemma eq_Rminus:(r1,r2:R)(r1==r2)->``r1-r2==0``.
- Intros; Rewrite H; Ring.
+Lemma Rminus_diag_eq : forall r1 r2, r1 = r2 -> r1 - r2 = 0.
+ intros; rewrite H; ring.
Qed.
-Hints Resolve eq_Rminus : real.
+Hint Resolve Rminus_diag_eq: real.
(**********)
-Lemma Rminus_eq:(r1,r2:R)``r1-r2==0`` -> r1==r2.
- Intros r1 r2; Unfold Rminus; Rewrite -> Rplus_sym; Intro.
- Rewrite <- (Ropp_Ropp r2); Apply (Rplus_Ropp (Ropp r2) r1 H).
+Lemma Rminus_diag_uniq : forall r1 r2, r1 - r2 = 0 -> r1 = r2.
+ intros r1 r2; unfold Rminus in |- *; rewrite Rplus_comm; intro.
+ rewrite <- (Ropp_involutive r2); apply (Rplus_opp_r_uniq (- r2) r1 H).
Qed.
-Hints Immediate Rminus_eq : real.
+Hint Immediate Rminus_diag_uniq: real.
-Lemma Rminus_eq_right:(r1,r2:R)``r2-r1==0`` -> r1==r2.
-Intros;Generalize (Rminus_eq r2 r1 H);Clear H;Intro H;Rewrite H;Ring.
+Lemma Rminus_diag_uniq_sym : forall r1 r2, r2 - r1 = 0 -> r1 = r2.
+intros; generalize (Rminus_diag_uniq r2 r1 H); clear H; intro H; rewrite H;
+ ring.
Qed.
-Hints Immediate Rminus_eq_right : real.
+Hint Immediate Rminus_diag_uniq_sym: real.
-Lemma Rplus_Rminus: (p,q:R)``p+(q-p)``==q.
-Intros; Ring.
+Lemma Rplus_minus : forall r1 r2, r1 + (r2 - r1) = r2.
+intros; ring.
Qed.
-Hints Resolve Rplus_Rminus:real.
+Hint Resolve Rplus_minus: real.
(**********)
-Lemma Rminus_eq_contra:(r1,r2:R)``r1<>r2``->``r1-r2<>0``.
-Red; Intros r1 r2 H H0.
-Apply H; Auto with real.
+Lemma Rminus_eq_contra : forall r1 r2, r1 <> r2 -> r1 - r2 <> 0.
+red in |- *; intros r1 r2 H H0.
+apply H; auto with real.
Qed.
-Hints Resolve Rminus_eq_contra : real.
+Hint Resolve Rminus_eq_contra: real.
-Lemma Rminus_not_eq:(r1,r2:R)``r1-r2<>0``->``r1<>r2``.
-Red; Intros; Elim H; Apply eq_Rminus; Auto.
+Lemma Rminus_not_eq : forall r1 r2, r1 - r2 <> 0 -> r1 <> r2.
+red in |- *; intros; elim H; apply Rminus_diag_eq; auto.
Qed.
-Hints Resolve Rminus_not_eq : real.
+Hint Resolve Rminus_not_eq: real.
-Lemma Rminus_not_eq_right:(r1,r2:R)``r2-r1<>0`` -> ``r1<>r2``.
-Red; Intros;Elim H;Rewrite H0; Ring.
+Lemma Rminus_not_eq_right : forall r1 r2, r2 - r1 <> 0 -> r1 <> r2.
+red in |- *; intros; elim H; rewrite H0; ring.
Qed.
-Hints Resolve Rminus_not_eq_right : real.
+Hint Resolve Rminus_not_eq_right: real.
-V7only [Notation not_sym := (sym_not_eq R).].
(**********)
-Lemma Rminus_distr: (x,y,z:R) ``x*(y-z)==(x*y) - (x*z)``.
-Intros; Ring.
+Lemma Rmult_minus_distr_l :
+ forall r1 r2 r3, r1 * (r2 - r3) = r1 * r2 - r1 * r3.
+intros; ring.
Qed.
(** Inverse *)
-Lemma Rinv_R1:``/1==1``.
-Field;Auto with real.
+Lemma Rinv_1 : / 1 = 1.
+field; auto with real.
Qed.
-Hints Resolve Rinv_R1 : real.
+Hint Resolve Rinv_1: real.
(*********)
-Lemma Rinv_neq_R0:(r:R)``r<>0``->``(/r)<>0``.
-Red; Intros; Apply R1_neq_R0.
-Replace ``1`` with ``(/r) * r``; Auto with real.
+Lemma Rinv_neq_0_compat : forall r, r <> 0 -> / r <> 0.
+red in |- *; intros; apply R1_neq_R0.
+replace 1 with (/ r * r); auto with real.
Qed.
-Hints Resolve Rinv_neq_R0 : real.
+Hint Resolve Rinv_neq_0_compat: real.
(*********)
-Lemma Rinv_Rinv:(r:R)``r<>0``->``/(/r)==r``.
-Intros;Field;Auto with real.
+Lemma Rinv_involutive : forall r, r <> 0 -> / / r = r.
+intros; field; auto with real.
Qed.
-Hints Resolve Rinv_Rinv : real.
+Hint Resolve Rinv_involutive: real.
(*********)
-Lemma Rinv_Rmult:(r1,r2:R)``r1<>0``->``r2<>0``->``/(r1*r2)==(/r1)*(/r2)``.
-Intros;Field;Auto with real.
+Lemma Rinv_mult_distr :
+ forall r1 r2, r1 <> 0 -> r2 <> 0 -> / (r1 * r2) = / r1 * / r2.
+intros; field; auto with real.
Qed.
(*********)
-Lemma Ropp_Rinv:(r:R)``r<>0``->``-(/r)==/(-r)``.
-Intros;Field;Auto with real.
+Lemma Ropp_inv_permute : forall r, r <> 0 -> - / r = / - r.
+intros; field; auto with real.
Qed.
-Lemma Rinv_r_simpl_r : (r1,r2:R)``r1<>0``->``r1*(/r1)*r2==r2``.
-Intros; Transitivity ``1*r2``; Auto with real.
-Rewrite Rinv_r; Auto with real.
+Lemma Rinv_r_simpl_r : forall r1 r2, r1 <> 0 -> r1 * / r1 * r2 = r2.
+intros; transitivity (1 * r2); auto with real.
+rewrite Rinv_r; auto with real.
Qed.
-Lemma Rinv_r_simpl_l : (r1,r2:R)``r1<>0``->``r2*r1*(/r1)==r2``.
-Intros; Transitivity ``r2*1``; Auto with real.
-Transitivity ``r2*(r1*/r1)``; Auto with real.
+Lemma Rinv_r_simpl_l : forall r1 r2, r1 <> 0 -> r2 * r1 * / r1 = r2.
+intros; transitivity (r2 * 1); auto with real.
+transitivity (r2 * (r1 * / r1)); auto with real.
Qed.
-Lemma Rinv_r_simpl_m : (r1,r2:R)``r1<>0``->``r1*r2*(/r1)==r2``.
-Intros; Transitivity ``r2*1``; Auto with real.
-Transitivity ``r2*(r1*/r1)``; Auto with real.
-Ring.
+Lemma Rinv_r_simpl_m : forall r1 r2, r1 <> 0 -> r1 * r2 * / r1 = r2.
+intros; transitivity (r2 * 1); auto with real.
+transitivity (r2 * (r1 * / r1)); auto with real.
+ring.
Qed.
-Hints Resolve Rinv_r_simpl_l Rinv_r_simpl_r Rinv_r_simpl_m : real.
+Hint Resolve Rinv_r_simpl_l Rinv_r_simpl_r Rinv_r_simpl_m: real.
(*********)
-Lemma Rinv_Rmult_simpl:(a,b,c:R)``a<>0``->``(a*(/b))*(c*(/a))==c*(/b)``.
-Intros a b c; Intros.
-Transitivity ``(a*/a)*(c*(/b))``; Auto with real.
-Ring.
+Lemma Rinv_mult_simpl :
+ forall r1 r2 r3, r1 <> 0 -> r1 * / r2 * (r3 * / r1) = r3 * / r2.
+intros a b c; intros.
+transitivity (a * / a * (c * / b)); auto with real.
+ring.
Qed.
(** Order and addition *)
-Lemma Rlt_compatibility_r:(r,r1,r2:R)``r1<r2``->``r1+r<r2+r``.
-Intros.
-Rewrite (Rplus_sym r1 r); Rewrite (Rplus_sym r2 r); Auto with real.
+Lemma Rplus_lt_compat_r : forall r r1 r2, r1 < r2 -> r1 + r < r2 + r.
+intros.
+rewrite (Rplus_comm r1 r); rewrite (Rplus_comm r2 r); auto with real.
Qed.
-Hints Resolve Rlt_compatibility_r : real.
+Hint Resolve Rplus_lt_compat_r: real.
(**********)
-Lemma Rlt_anti_compatibility: (r,r1,r2:R)``r+r1 < r+r2`` -> ``r1<r2``.
-Intros; Cut ``(-r+r)+r1 < (-r+r)+r2``.
-Rewrite -> Rplus_Ropp_l.
-Elim (Rplus_ne r1); Elim (Rplus_ne r2); Intros; Rewrite <- H3;
- Rewrite <- H1; Auto with zarith real.
-Rewrite -> Rplus_assoc; Rewrite -> Rplus_assoc;
- Apply (Rlt_compatibility ``-r`` ``r+r1`` ``r+r2`` H).
+Lemma Rplus_lt_reg_r : forall r r1 r2, r + r1 < r + r2 -> r1 < r2.
+intros; cut (- r + r + r1 < - r + r + r2).
+rewrite Rplus_opp_l.
+elim (Rplus_ne r1); elim (Rplus_ne r2); intros; rewrite <- H3; rewrite <- H1;
+ auto with zarith real.
+rewrite Rplus_assoc; rewrite Rplus_assoc;
+ apply (Rplus_lt_compat_l (- r) (r + r1) (r + r2) H).
Qed.
(**********)
-Lemma Rle_compatibility:(r,r1,r2:R)``r1<=r2`` -> ``r+r1 <= r+r2 ``.
-Unfold Rle; Intros; Elim H; Intro.
-Left; Apply (Rlt_compatibility r r1 r2 H0).
-Right; Rewrite <- H0; Auto with zarith real.
+Lemma Rplus_le_compat_l : forall r r1 r2, r1 <= r2 -> r + r1 <= r + r2.
+unfold Rle in |- *; intros; elim H; intro.
+left; apply (Rplus_lt_compat_l r r1 r2 H0).
+right; rewrite <- H0; auto with zarith real.
Qed.
(**********)
-Lemma Rle_compatibility_r:(r,r1,r2:R)``r1<=r2`` -> ``r1+r<=r2+r``.
-Unfold Rle; Intros; Elim H; Intro.
-Left; Apply (Rlt_compatibility_r r r1 r2 H0).
-Right; Rewrite <- H0; Auto with real.
+Lemma Rplus_le_compat_r : forall r r1 r2, r1 <= r2 -> r1 + r <= r2 + r.
+unfold Rle in |- *; intros; elim H; intro.
+left; apply (Rplus_lt_compat_r r r1 r2 H0).
+right; rewrite <- H0; auto with real.
Qed.
-Hints Resolve Rle_compatibility Rle_compatibility_r : real.
+Hint Resolve Rplus_le_compat_l Rplus_le_compat_r: real.
(**********)
-Lemma Rle_anti_compatibility: (r,r1,r2:R)``r+r1<=r+r2`` -> ``r1<=r2``.
-Unfold Rle; Intros; Elim H; Intro.
-Left; Apply (Rlt_anti_compatibility r r1 r2 H0).
-Right; Apply (r_Rplus_plus r r1 r2 H0).
+Lemma Rplus_le_reg_l : forall r r1 r2, r + r1 <= r + r2 -> r1 <= r2.
+unfold Rle in |- *; intros; elim H; intro.
+left; apply (Rplus_lt_reg_r r r1 r2 H0).
+right; apply (Rplus_eq_reg_l r r1 r2 H0).
Qed.
(**********)
-Lemma sum_inequa_Rle_lt:(a,x,b,c,y,d:R)``a<=x`` -> ``x<b`` ->
- ``c<y`` -> ``y<=d`` -> ``a+c < x+y < b+d``.
-Intros;Split.
-Apply Rlt_le_trans with ``a+y``; Auto with real.
-Apply Rlt_le_trans with ``b+y``; Auto with real.
+Lemma sum_inequa_Rle_lt :
+ forall a x b c y d:R,
+ a <= x -> x < b -> c < y -> y <= d -> a + c < x + y < b + d.
+intros; split.
+apply Rlt_le_trans with (a + y); auto with real.
+apply Rlt_le_trans with (b + y); auto with real.
Qed.
(*********)
-Lemma Rplus_lt:(r1,r2,r3,r4:R)``r1<r2`` -> ``r3<r4`` -> ``r1+r3 < r2+r4``.
-Intros; Apply Rlt_trans with ``r2+r3``; Auto with real.
+Lemma Rplus_lt_compat :
+ forall r1 r2 r3 r4, r1 < r2 -> r3 < r4 -> r1 + r3 < r2 + r4.
+intros; apply Rlt_trans with (r2 + r3); auto with real.
Qed.
-Lemma Rplus_le:(r1,r2,r3,r4:R)``r1<=r2`` -> ``r3<=r4`` -> ``r1+r3 <= r2+r4``.
-Intros; Apply Rle_trans with ``r2+r3``; Auto with real.
+Lemma Rplus_le_compat :
+ forall r1 r2 r3 r4, r1 <= r2 -> r3 <= r4 -> r1 + r3 <= r2 + r4.
+intros; apply Rle_trans with (r2 + r3); auto with real.
Qed.
(*********)
-Lemma Rplus_lt_le_lt:(r1,r2,r3,r4:R)``r1<r2`` -> ``r3<=r4`` ->
- ``r1+r3 < r2+r4``.
-Intros; Apply Rlt_le_trans with ``r2+r3``; Auto with real.
+Lemma Rplus_lt_le_compat :
+ forall r1 r2 r3 r4, r1 < r2 -> r3 <= r4 -> r1 + r3 < r2 + r4.
+intros; apply Rlt_le_trans with (r2 + r3); auto with real.
Qed.
(*********)
-Lemma Rplus_le_lt_lt:(r1,r2,r3,r4:R)``r1<=r2`` -> ``r3<r4`` ->
- ``r1+r3 < r2+r4``.
-Intros; Apply Rle_lt_trans with ``r2+r3``; Auto with real.
+Lemma Rplus_le_lt_compat :
+ forall r1 r2 r3 r4, r1 <= r2 -> r3 < r4 -> r1 + r3 < r2 + r4.
+intros; apply Rle_lt_trans with (r2 + r3); auto with real.
Qed.
-Hints Immediate Rplus_lt Rplus_le Rplus_lt_le_lt Rplus_le_lt_lt : real.
+Hint Immediate Rplus_lt_compat Rplus_le_compat Rplus_lt_le_compat
+ Rplus_le_lt_compat: real.
(** Order and Opposite *)
(**********)
-Lemma Rgt_Ropp:(r1,r2:R) ``r1 > r2`` -> ``-r1 < -r2``.
-Unfold Rgt; Intros.
-Apply (Rlt_anti_compatibility ``r2+r1``).
-Replace ``r2+r1+(-r1)`` with r2.
-Replace ``r2+r1+(-r2)`` with r1.
-Trivial.
-Ring.
-Ring.
+Lemma Ropp_gt_lt_contravar : forall r1 r2, r1 > r2 -> - r1 < - r2.
+unfold Rgt in |- *; intros.
+apply (Rplus_lt_reg_r (r2 + r1)).
+replace (r2 + r1 + - r1) with r2.
+replace (r2 + r1 + - r2) with r1.
+trivial.
+ring.
+ring.
Qed.
-Hints Resolve Rgt_Ropp.
+Hint Resolve Ropp_gt_lt_contravar.
(**********)
-Lemma Rlt_Ropp:(r1,r2:R) ``r1 < r2`` -> ``-r1 > -r2``.
-Unfold Rgt; Auto with real.
+Lemma Ropp_lt_gt_contravar : forall r1 r2, r1 < r2 -> - r1 > - r2.
+unfold Rgt in |- *; auto with real.
Qed.
-Hints Resolve Rlt_Ropp : real.
+Hint Resolve Ropp_lt_gt_contravar: real.
-Lemma Ropp_Rlt: (x,y:R) ``-y < -x`` ->``x<y``.
-Intros x y H'.
-Rewrite <- (Ropp_Ropp x); Rewrite <- (Ropp_Ropp y); Auto with real.
+Lemma Ropp_lt_cancel : forall r1 r2, - r2 < - r1 -> r1 < r2.
+intros x y H'.
+rewrite <- (Ropp_involutive x); rewrite <- (Ropp_involutive y);
+ auto with real.
Qed.
-Hints Immediate Ropp_Rlt : real.
+Hint Immediate Ropp_lt_cancel: real.
-Lemma Rlt_Ropp1:(r1,r2:R) ``r2 < r1`` -> ``-r1 < -r2``.
-Auto with real.
+Lemma Ropp_lt_contravar : forall r1 r2, r2 < r1 -> - r1 < - r2.
+auto with real.
Qed.
-Hints Resolve Rlt_Ropp1 : real.
+Hint Resolve Ropp_lt_contravar: real.
(**********)
-Lemma Rle_Ropp:(r1,r2:R) ``r1 <= r2`` -> ``-r1 >= -r2``.
-Unfold Rge; Intros r1 r2 [H|H]; Auto with real.
+Lemma Ropp_le_ge_contravar : forall r1 r2, r1 <= r2 -> - r1 >= - r2.
+unfold Rge in |- *; intros r1 r2 [H| H]; auto with real.
Qed.
-Hints Resolve Rle_Ropp : real.
+Hint Resolve Ropp_le_ge_contravar: real.
-Lemma Ropp_Rle: (x,y:R) ``-y <= -x`` ->``x <= y``.
-Intros x y H.
-Elim H;Auto with real.
-Intro H1;Rewrite <-(Ropp_Ropp x);Rewrite <-(Ropp_Ropp y);Rewrite H1;
- Auto with real.
+Lemma Ropp_le_cancel : forall r1 r2, - r2 <= - r1 -> r1 <= r2.
+intros x y H.
+elim H; auto with real.
+intro H1; rewrite <- (Ropp_involutive x); rewrite <- (Ropp_involutive y);
+ rewrite H1; auto with real.
Qed.
-Hints Immediate Ropp_Rle : real.
+Hint Immediate Ropp_le_cancel: real.
-Lemma Rle_Ropp1:(r1,r2:R) ``r2 <= r1`` -> ``-r1 <= -r2``.
-Intros r1 r2 H;Elim H;Auto with real.
+Lemma Ropp_le_contravar : forall r1 r2, r2 <= r1 -> - r1 <= - r2.
+intros r1 r2 H; elim H; auto with real.
Qed.
-Hints Resolve Rle_Ropp1 : real.
+Hint Resolve Ropp_le_contravar: real.
(**********)
-Lemma Rge_Ropp:(r1,r2:R) ``r1 >= r2`` -> ``-r1 <= -r2``.
-Unfold Rge; Intros r1 r2 [H|H]; Auto with real.
+Lemma Ropp_ge_le_contravar : forall r1 r2, r1 >= r2 -> - r1 <= - r2.
+unfold Rge in |- *; intros r1 r2 [H| H]; auto with real.
Qed.
-Hints Resolve Rge_Ropp : real.
+Hint Resolve Ropp_ge_le_contravar: real.
(**********)
-Lemma Rlt_RO_Ropp:(r:R) ``0 < r`` -> ``0 > -r``.
-Intros; Replace ``0`` with ``-0``; Auto with real.
+Lemma Ropp_0_lt_gt_contravar : forall r, 0 < r -> 0 > - r.
+intros; replace 0 with (-0); auto with real.
Qed.
-Hints Resolve Rlt_RO_Ropp : real.
+Hint Resolve Ropp_0_lt_gt_contravar: real.
(**********)
-Lemma Rgt_RO_Ropp:(r:R) ``0 > r`` -> ``0 < -r``.
-Intros; Replace ``0`` with ``-0``; Auto with real.
+Lemma Ropp_0_gt_lt_contravar : forall r, 0 > r -> 0 < - r.
+intros; replace 0 with (-0); auto with real.
Qed.
-Hints Resolve Rgt_RO_Ropp : real.
+Hint Resolve Ropp_0_gt_lt_contravar: real.
(**********)
-Lemma Rgt_RoppO:(r:R)``r>0``->``(-r)<0``.
-Intros; Rewrite <- Ropp_O; Auto with real.
+Lemma Ropp_lt_gt_0_contravar : forall r, r > 0 -> - r < 0.
+intros; rewrite <- Ropp_0; auto with real.
Qed.
(**********)
-Lemma Rlt_RoppO:(r:R)``r<0``->``-r>0``.
-Intros; Rewrite <- Ropp_O; Auto with real.
+Lemma Ropp_gt_lt_0_contravar : forall r, r < 0 -> - r > 0.
+intros; rewrite <- Ropp_0; auto with real.
Qed.
-Hints Resolve Rgt_RoppO Rlt_RoppO: real.
+Hint Resolve Ropp_lt_gt_0_contravar Ropp_gt_lt_0_contravar: real.
(**********)
-Lemma Rle_RO_Ropp:(r:R) ``0 <= r`` -> ``0 >= -r``.
-Intros; Replace ``0`` with ``-0``; Auto with real.
+Lemma Ropp_0_le_ge_contravar : forall r, 0 <= r -> 0 >= - r.
+intros; replace 0 with (-0); auto with real.
Qed.
-Hints Resolve Rle_RO_Ropp : real.
+Hint Resolve Ropp_0_le_ge_contravar: real.
(**********)
-Lemma Rge_RO_Ropp:(r:R) ``0 >= r`` -> ``0 <= -r``.
-Intros; Replace ``0`` with ``-0``; Auto with real.
+Lemma Ropp_0_ge_le_contravar : forall r, 0 >= r -> 0 <= - r.
+intros; replace 0 with (-0); auto with real.
Qed.
-Hints Resolve Rge_RO_Ropp : real.
+Hint Resolve Ropp_0_ge_le_contravar: real.
(** Order and multiplication *)
-Lemma Rlt_monotony_r:(r,r1,r2:R)``0<r`` -> ``r1 < r2`` -> ``r1*r < r2*r``.
-Intros; Rewrite (Rmult_sym r1 r); Rewrite (Rmult_sym r2 r); Auto with real.
+Lemma Rmult_lt_compat_r : forall r r1 r2, 0 < r -> r1 < r2 -> r1 * r < r2 * r.
+intros; rewrite (Rmult_comm r1 r); rewrite (Rmult_comm r2 r); auto with real.
Qed.
-Hints Resolve Rlt_monotony_r.
+Hint Resolve Rmult_lt_compat_r.
-Lemma Rlt_monotony_contra: (z, x, y:R) ``0<z`` ->``z*x<z*y`` ->``x<y``.
-Intros z x y H H0.
-Case (total_order x y); Intros Eq0; Auto; Elim Eq0; Clear Eq0; Intros Eq0.
- Rewrite Eq0 in H0;ElimType False;Apply (Rlt_antirefl ``z*y``);Auto.
-Generalize (Rlt_monotony z y x H Eq0);Intro;ElimType False;
- Generalize (Rlt_trans ``z*x`` ``z*y`` ``z*x`` H0 H1);Intro;
- Apply (Rlt_antirefl ``z*x``);Auto.
+Lemma Rmult_lt_reg_l : forall r r1 r2, 0 < r -> r * r1 < r * r2 -> r1 < r2.
+intros z x y H H0.
+case (Rtotal_order x y); intros Eq0; auto; elim Eq0; clear Eq0; intros Eq0.
+ rewrite Eq0 in H0; elimtype False; apply (Rlt_irrefl (z * y)); auto.
+generalize (Rmult_lt_compat_l z y x H Eq0); intro; elimtype False;
+ generalize (Rlt_trans (z * x) (z * y) (z * x) H0 H1);
+ intro; apply (Rlt_irrefl (z * x)); auto.
Qed.
-V7only [
-Notation Rlt_monotony_rev := Rlt_monotony_contra.
-].
-Lemma Rlt_anti_monotony:(r,r1,r2:R)``r < 0`` -> ``r1 < r2`` -> ``r*r1 > r*r2``.
-Intros; Replace r with ``-(-r)``; Auto with real.
-Rewrite (Ropp_mul1 ``-r``); Rewrite (Ropp_mul1 ``-r``).
-Apply Rlt_Ropp; Auto with real.
+Lemma Rmult_lt_gt_compat_neg_l :
+ forall r r1 r2, r < 0 -> r1 < r2 -> r * r1 > r * r2.
+intros; replace r with (- - r); auto with real.
+rewrite (Ropp_mult_distr_l_reverse (- r));
+ rewrite (Ropp_mult_distr_l_reverse (- r)).
+apply Ropp_lt_gt_contravar; auto with real.
Qed.
(**********)
-Lemma Rle_monotony:
- (r,r1,r2:R)``0 <= r`` -> ``r1 <= r2`` -> ``r*r1 <= r*r2``.
-Intros r r1 r2 H H0; NewDestruct H; NewDestruct H0; Unfold Rle; Auto with real.
-Right; Rewrite <- H; Do 2 Rewrite Rmult_Ol; Reflexivity.
+Lemma Rmult_le_compat_l :
+ forall r r1 r2, 0 <= r -> r1 <= r2 -> r * r1 <= r * r2.
+intros r r1 r2 H H0; destruct H; destruct H0; unfold Rle in |- *;
+ auto with real.
+right; rewrite <- H; do 2 rewrite Rmult_0_l; reflexivity.
Qed.
-Hints Resolve Rle_monotony : real.
+Hint Resolve Rmult_le_compat_l: real.
-Lemma Rle_monotony_r:
- (r,r1,r2:R)``0 <= r`` -> ``r1 <= r2`` -> ``r1*r <= r2*r``.
-Intros r r1 r2 H;
-Rewrite (Rmult_sym r1 r); Rewrite (Rmult_sym r2 r); Auto with real.
+Lemma Rmult_le_compat_r :
+ forall r r1 r2, 0 <= r -> r1 <= r2 -> r1 * r <= r2 * r.
+intros r r1 r2 H; rewrite (Rmult_comm r1 r); rewrite (Rmult_comm r2 r);
+ auto with real.
Qed.
-Hints Resolve Rle_monotony_r : real.
+Hint Resolve Rmult_le_compat_r: real.
-Lemma Rle_monotony_contra:
- (z, x, y:R) ``0<z`` ->``z*x<=z*y`` ->``x<=y``.
-Intros z x y H H0;Case H0; Auto with real.
-Intros H1; Apply Rlt_le.
-Apply Rlt_monotony_contra with z := z;Auto.
-Intros H1;Replace x with (Rmult (Rinv z) (Rmult z x)); Auto with real.
-Replace y with (Rmult (Rinv z) (Rmult z y)).
- Rewrite H1;Auto with real.
-Rewrite <- Rmult_assoc; Rewrite Rinv_l; Auto with real.
-Rewrite <- Rmult_assoc; Rewrite Rinv_l; Auto with real.
+Lemma Rmult_le_reg_l : forall r r1 r2, 0 < r -> r * r1 <= r * r2 -> r1 <= r2.
+intros z x y H H0; case H0; auto with real.
+intros H1; apply Rlt_le.
+apply Rmult_lt_reg_l with (r := z); auto.
+intros H1; replace x with (/ z * (z * x)); auto with real.
+replace y with (/ z * (z * y)).
+ rewrite H1; auto with real.
+rewrite <- Rmult_assoc; rewrite Rinv_l; auto with real.
+rewrite <- Rmult_assoc; rewrite Rinv_l; auto with real.
Qed.
-Lemma Rle_anti_monotony1
- :(r,r1,r2:R)``r <= 0`` -> ``r1 <= r2`` -> ``r*r2 <= r*r1``.
-Intros; Replace r with ``-(-r)``; Auto with real.
-Do 2 Rewrite (Ropp_mul1 ``-r``).
-Apply Rle_Ropp1; Auto with real.
+Lemma Rmult_le_compat_neg_l :
+ forall r r1 r2, r <= 0 -> r1 <= r2 -> r * r2 <= r * r1.
+intros; replace r with (- - r); auto with real.
+do 2 rewrite (Ropp_mult_distr_l_reverse (- r)).
+apply Ropp_le_contravar; auto with real.
Qed.
-Hints Resolve Rle_anti_monotony1 : real.
+Hint Resolve Rmult_le_compat_neg_l: real.
-Lemma Rle_anti_monotony
- :(r,r1,r2:R)``r <= 0`` -> ``r1 <= r2`` -> ``r*r1 >= r*r2``.
-Intros; Apply Rle_ge; Auto with real.
+Lemma Rmult_le_ge_compat_neg_l :
+ forall r r1 r2, r <= 0 -> r1 <= r2 -> r * r1 >= r * r2.
+intros; apply Rle_ge; auto with real.
Qed.
-Hints Resolve Rle_anti_monotony : real.
+Hint Resolve Rmult_le_ge_compat_neg_l: real.
-Lemma Rle_Rmult_comp:
- (x, y, z, t:R) ``0 <= x`` -> ``0 <= z`` -> ``x <= y`` -> ``z <= t`` ->
- ``x*z <= y*t``.
-Intros x y z t H' H'0 H'1 H'2.
-Apply Rle_trans with r2 := ``x*t``; Auto with real.
-Repeat Rewrite [x:?](Rmult_sym x t).
-Apply Rle_monotony; Auto.
-Apply Rle_trans with z; Auto.
+Lemma Rmult_le_compat :
+ forall r1 r2 r3 r4,
+ 0 <= r1 -> 0 <= r3 -> r1 <= r2 -> r3 <= r4 -> r1 * r3 <= r2 * r4.
+intros x y z t H' H'0 H'1 H'2.
+apply Rle_trans with (r2 := x * t); auto with real.
+repeat rewrite (fun x => Rmult_comm x t).
+apply Rmult_le_compat_l; auto.
+apply Rle_trans with z; auto.
Qed.
-Hints Resolve Rle_Rmult_comp :real.
+Hint Resolve Rmult_le_compat: real.
-Lemma Rmult_lt:(r1,r2,r3,r4:R)``r3>0`` -> ``r2>0`` ->
- `` r1 < r2`` -> ``r3 < r4`` -> ``r1*r3 < r2*r4``.
-Intros; Apply Rlt_trans with ``r2*r3``; Auto with real.
+Lemma Rmult_gt_0_lt_compat :
+ forall r1 r2 r3 r4,
+ r3 > 0 -> r2 > 0 -> r1 < r2 -> r3 < r4 -> r1 * r3 < r2 * r4.
+intros; apply Rlt_trans with (r2 * r3); auto with real.
Qed.
(*********)
-Lemma Rmult_lt_0
- :(r1,r2,r3,r4:R)``r3>=0``->``r2>0``->``r1<r2``->``r3<r4``->``r1*r3<r2*r4``.
-Intros; Apply Rle_lt_trans with ``r2*r3``; Auto with real.
+Lemma Rmult_ge_0_gt_0_lt_compat :
+ forall r1 r2 r3 r4,
+ r3 >= 0 -> r2 > 0 -> r1 < r2 -> r3 < r4 -> r1 * r3 < r2 * r4.
+intros; apply Rle_lt_trans with (r2 * r3); auto with real.
Qed.
(** Order and Substractions *)
-Lemma Rlt_minus:(r1,r2:R)``r1 < r2`` -> ``r1-r2 < 0``.
-Intros; Apply (Rlt_anti_compatibility ``r2``).
-Replace ``r2+(r1-r2)`` with r1.
-Replace ``r2+0`` with r2; Auto with real.
-Ring.
+Lemma Rlt_minus : forall r1 r2, r1 < r2 -> r1 - r2 < 0.
+intros; apply (Rplus_lt_reg_r r2).
+replace (r2 + (r1 - r2)) with r1.
+replace (r2 + 0) with r2; auto with real.
+ring.
Qed.
-Hints Resolve Rlt_minus : real.
+Hint Resolve Rlt_minus: real.
(**********)
-Lemma Rle_minus:(r1,r2:R)``r1 <= r2`` -> ``r1-r2 <= 0``.
-NewDestruct 1; Unfold Rle; Auto with real.
+Lemma Rle_minus : forall r1 r2, r1 <= r2 -> r1 - r2 <= 0.
+destruct 1; unfold Rle in |- *; auto with real.
Qed.
(**********)
-Lemma Rminus_lt:(r1,r2:R)``r1-r2 < 0`` -> ``r1 < r2``.
-Intros; Replace r1 with ``r1-r2+r2``.
-Pattern 3 r2; Replace r2 with ``0+r2``; Auto with real.
-Ring.
+Lemma Rminus_lt : forall r1 r2, r1 - r2 < 0 -> r1 < r2.
+intros; replace r1 with (r1 - r2 + r2).
+pattern r2 at 3 in |- *; replace r2 with (0 + r2); auto with real.
+ring.
Qed.
(**********)
-Lemma Rminus_le:(r1,r2:R)``r1-r2 <= 0`` -> ``r1 <= r2``.
-Intros; Replace r1 with ``r1-r2+r2``.
-Pattern 3 r2; Replace r2 with ``0+r2``; Auto with real.
-Ring.
+Lemma Rminus_le : forall r1 r2, r1 - r2 <= 0 -> r1 <= r2.
+intros; replace r1 with (r1 - r2 + r2).
+pattern r2 at 3 in |- *; replace r2 with (0 + r2); auto with real.
+ring.
Qed.
(**********)
-Lemma tech_Rplus:(r,s:R)``0<=r`` -> ``0<s`` -> ``r+s<>0``.
-Intros; Apply sym_not_eqT; Apply Rlt_not_eq.
-Rewrite Rplus_sym; Replace ``0`` with ``0+0``; Auto with real.
+Lemma tech_Rplus : forall r (s:R), 0 <= r -> 0 < s -> r + s <> 0.
+intros; apply sym_not_eq; apply Rlt_not_eq.
+rewrite Rplus_comm; replace 0 with (0 + 0); auto with real.
Qed.
-Hints Immediate tech_Rplus : real.
+Hint Immediate tech_Rplus: real.
(** Order and the square function *)
-Lemma pos_Rsqr:(r:R)``0<=(Rsqr r)``.
-Intro; Case (total_order_Rlt_Rle r ``0``); Unfold Rsqr; Intro.
-Replace ``r*r`` with ``(-r)*(-r)``; Auto with real.
-Replace ``0`` with ``-r*0``; Auto with real.
-Replace ``0`` with ``0*r``; Auto with real.
+Lemma Rle_0_sqr : forall r, 0 <= Rsqr r.
+intro; case (Rlt_le_dec r 0); unfold Rsqr in |- *; intro.
+replace (r * r) with (- r * - r); auto with real.
+replace 0 with (- r * 0); auto with real.
+replace 0 with (0 * r); auto with real.
Qed.
(***********)
-Lemma pos_Rsqr1:(r:R)``r<>0``->``0<(Rsqr r)``.
-Intros; Case (not_Req r ``0``); Trivial; Unfold Rsqr; Intro.
-Replace ``r*r`` with ``(-r)*(-r)``; Auto with real.
-Replace ``0`` with ``-r*0``; Auto with real.
-Replace ``0`` with ``0*r``; Auto with real.
+Lemma Rlt_0_sqr : forall r, r <> 0 -> 0 < Rsqr r.
+intros; case (Rdichotomy r 0); trivial; unfold Rsqr in |- *; intro.
+replace (r * r) with (- r * - r); auto with real.
+replace 0 with (- r * 0); auto with real.
+replace 0 with (0 * r); auto with real.
Qed.
-Hints Resolve pos_Rsqr pos_Rsqr1 : real.
+Hint Resolve Rle_0_sqr Rlt_0_sqr: real.
(** Zero is less than one *)
-Lemma Rlt_R0_R1:``0<1``.
-Replace ``1`` with ``(Rsqr 1)``; Auto with real.
-Unfold Rsqr; Auto with real.
+Lemma Rlt_0_1 : 0 < 1.
+replace 1 with (Rsqr 1); auto with real.
+unfold Rsqr in |- *; auto with real.
Qed.
-Hints Resolve Rlt_R0_R1 : real.
+Hint Resolve Rlt_0_1: real.
-Lemma Rle_R0_R1:``0<=1``.
-Left.
-Exact Rlt_R0_R1.
+Lemma Rle_0_1 : 0 <= 1.
+left.
+exact Rlt_0_1.
Qed.
(** Order and inverse *)
-Lemma Rlt_Rinv:(r:R)``0<r``->``0</r``.
-Intros; Apply not_Rle; Red; Intros.
-Absurd ``1<=0``; Auto with real.
-Replace ``1`` with ``r*(/r)``; Auto with real.
-Replace ``0`` with ``r*0``; Auto with real.
+Lemma Rinv_0_lt_compat : forall r, 0 < r -> 0 < / r.
+intros; apply Rnot_le_lt; red in |- *; intros.
+absurd (1 <= 0); auto with real.
+replace 1 with (r * / r); auto with real.
+replace 0 with (r * 0); auto with real.
Qed.
-Hints Resolve Rlt_Rinv : real.
+Hint Resolve Rinv_0_lt_compat: real.
(*********)
-Lemma Rlt_Rinv2:(r:R)``r < 0``->``/r < 0``.
-Intros; Apply not_Rle; Red; Intros.
-Absurd ``1<=0``; Auto with real.
-Replace ``1`` with ``r*(/r)``; Auto with real.
-Replace ``0`` with ``r*0``; Auto with real.
+Lemma Rinv_lt_0_compat : forall r, r < 0 -> / r < 0.
+intros; apply Rnot_le_lt; red in |- *; intros.
+absurd (1 <= 0); auto with real.
+replace 1 with (r * / r); auto with real.
+replace 0 with (r * 0); auto with real.
Qed.
-Hints Resolve Rlt_Rinv2 : real.
+Hint Resolve Rinv_lt_0_compat: real.
(*********)
-Lemma Rinv_lt:(r1,r2:R)``0 < r1*r2`` -> ``r1 < r2`` -> ``/r2 < /r1``.
-Intros; Apply Rlt_monotony_rev with ``r1*r2``; Auto with real.
-Case (without_div_O_contr r1 r2 ); Intros; Auto with real.
-Replace ``r1*r2*/r2`` with r1.
-Replace ``r1*r2*/r1`` with r2; Trivial.
-Symmetry; Auto with real.
-Symmetry; Auto with real.
-Qed.
-
-Lemma Rlt_Rinv_R1: (x, y:R) ``1 <= x`` -> ``x<y`` ->``/y< /x``.
-Intros x y H' H'0.
-Cut (Rlt R0 x); [Intros Lt0 | Apply Rlt_le_trans with r2 := R1];
- Auto with real.
-Apply Rlt_monotony_contra with z := x; Auto with real.
-Rewrite (Rmult_sym x (Rinv x)); Rewrite Rinv_l; Auto with real.
-Apply Rlt_monotony_contra with z := y; Auto with real.
-Apply Rlt_trans with r2:=x;Auto.
-Cut ``y*(x*/y)==x``.
-Intro H1;Rewrite H1;Rewrite (Rmult_1r y);Auto.
-Rewrite (Rmult_sym x); Rewrite <- Rmult_assoc; Rewrite (Rmult_sym y (Rinv y));
- Rewrite Rinv_l; Auto with real.
-Apply imp_not_Req; Right.
-Red; Apply Rlt_trans with r2 := x; Auto with real.
-Qed.
-Hints Resolve Rlt_Rinv_R1 :real.
+Lemma Rinv_lt_contravar : forall r1 r2, 0 < r1 * r2 -> r1 < r2 -> / r2 < / r1.
+intros; apply Rmult_lt_reg_l with (r1 * r2); auto with real.
+case (Rmult_neq_0_reg r1 r2); intros; auto with real.
+replace (r1 * r2 * / r2) with r1.
+replace (r1 * r2 * / r1) with r2; trivial.
+symmetry in |- *; auto with real.
+symmetry in |- *; auto with real.
+Qed.
+
+Lemma Rinv_1_lt_contravar : forall r1 r2, 1 <= r1 -> r1 < r2 -> / r2 < / r1.
+intros x y H' H'0.
+cut (0 < x); [ intros Lt0 | apply Rlt_le_trans with (r2 := 1) ];
+ auto with real.
+apply Rmult_lt_reg_l with (r := x); auto with real.
+rewrite (Rmult_comm x (/ x)); rewrite Rinv_l; auto with real.
+apply Rmult_lt_reg_l with (r := y); auto with real.
+apply Rlt_trans with (r2 := x); auto.
+cut (y * (x * / y) = x).
+intro H1; rewrite H1; rewrite (Rmult_1_r y); auto.
+rewrite (Rmult_comm x); rewrite <- Rmult_assoc; rewrite (Rmult_comm y (/ y));
+ rewrite Rinv_l; auto with real.
+apply Rlt_dichotomy_converse; right.
+red in |- *; apply Rlt_trans with (r2 := x); auto with real.
+Qed.
+Hint Resolve Rinv_1_lt_contravar: real.
(*********************************************************)
(** Greater *)
(*********************************************************)
(**********)
-Lemma Rge_ge_eq:(r1,r2:R)``r1 >= r2`` -> ``r2 >= r1`` -> r1==r2.
-Intros; Apply Rle_antisym; Auto with real.
+Lemma Rge_antisym : forall r1 r2, r1 >= r2 -> r2 >= r1 -> r1 = r2.
+intros; apply Rle_antisym; auto with real.
Qed.
(**********)
-Lemma Rlt_not_ge:(r1,r2:R)~(``r1<r2``)->``r1>=r2``.
-Intros; Unfold Rge; Elim (total_order r1 r2); Intro.
-Absurd ``r1<r2``; Trivial.
-Case H0; Auto.
+Lemma Rnot_lt_ge : forall r1 r2, ~ r1 < r2 -> r1 >= r2.
+intros; unfold Rge in |- *; elim (Rtotal_order r1 r2); intro.
+absurd (r1 < r2); trivial.
+case H0; auto.
Qed.
(**********)
-Lemma Rnot_lt_le:(r1,r2:R)~(``r1<r2``)->``r2<=r1``.
-Intros; Apply Rge_le; Apply Rlt_not_ge; Assumption.
+Lemma Rnot_lt_le : forall r1 r2, ~ r1 < r2 -> r2 <= r1.
+intros; apply Rge_le; apply Rnot_lt_ge; assumption.
Qed.
(**********)
-Lemma Rgt_not_le:(r1,r2:R)~(``r1>r2``)->``r1<=r2``.
-Intros r1 r2 H; Apply Rge_le.
-Exact (Rlt_not_ge r2 r1 H).
+Lemma Rnot_gt_le : forall r1 r2, ~ r1 > r2 -> r1 <= r2.
+intros r1 r2 H; apply Rge_le.
+exact (Rnot_lt_ge r2 r1 H).
Qed.
(**********)
-Lemma Rgt_ge:(r1,r2:R)``r1>r2`` -> ``r1 >= r2``.
-Red; Auto with real.
+Lemma Rgt_ge : forall r1 r2, r1 > r2 -> r1 >= r2.
+red in |- *; auto with real.
Qed.
-V7only [
-(**********)
-Lemma Rlt_sym:(r1,r2:R)``r1<r2`` <-> ``r2>r1``.
-Split; Unfold Rgt; Auto with real.
-Qed.
-
-(**********)
-Lemma Rle_sym1:(r1,r2:R)``r1<=r2``->``r2>=r1``.
-Proof Rle_ge.
-
-Notation "'Rle_sym2' a b c" := (Rge_le b a c)
- (at level 10, a,b,c at level 9, only parsing).
-Notation Rle_sym2 := Rge_le (only parsing).
-(*
-(**********)
-Lemma Rle_sym2:(r1,r2:R)``r2>=r1`` -> ``r1<=r2``.
-Proof [r1,r2](Rge_le r2 r1).
-*)
-
-(**********)
-Lemma Rle_sym:(r1,r2:R)``r1<=r2``<->``r2>=r1``.
-Split; Auto with real.
-Qed.
-].
(**********)
-Lemma Rge_gt_trans:(r1,r2,r3:R)``r1>=r2``->``r2>r3``->``r1>r3``.
-Unfold Rgt; Intros; Apply Rlt_le_trans with r2; Auto with real.
+Lemma Rge_gt_trans : forall r1 r2 r3, r1 >= r2 -> r2 > r3 -> r1 > r3.
+unfold Rgt in |- *; intros; apply Rlt_le_trans with r2; auto with real.
Qed.
(**********)
-Lemma Rgt_ge_trans:(r1,r2,r3:R)``r1>r2`` -> ``r2>=r3`` -> ``r1>r3``.
-Unfold Rgt; Intros; Apply Rle_lt_trans with r2; Auto with real.
+Lemma Rgt_ge_trans : forall r1 r2 r3, r1 > r2 -> r2 >= r3 -> r1 > r3.
+unfold Rgt in |- *; intros; apply Rle_lt_trans with r2; auto with real.
Qed.
(**********)
-Lemma Rgt_trans:(r1,r2,r3:R)``r1>r2`` -> ``r2>r3`` -> ``r1>r3``.
-Unfold Rgt; Intros; Apply Rlt_trans with r2; Auto with real.
+Lemma Rgt_trans : forall r1 r2 r3, r1 > r2 -> r2 > r3 -> r1 > r3.
+unfold Rgt in |- *; intros; apply Rlt_trans with r2; auto with real.
Qed.
(**********)
-Lemma Rge_trans:(r1,r2,r3:R)``r1>=r2`` -> ``r2>=r3`` -> ``r1>=r3``.
-Intros; Apply Rle_ge.
-Apply Rle_trans with r2; Auto with real.
+Lemma Rge_trans : forall r1 r2 r3, r1 >= r2 -> r2 >= r3 -> r1 >= r3.
+intros; apply Rle_ge.
+apply Rle_trans with r2; auto with real.
Qed.
(**********)
-Lemma Rlt_r_plus_R1:(r:R)``0<=r`` -> ``0<r+1``.
-Intros.
-Apply Rlt_le_trans with ``1``; Auto with real.
-Pattern 1 ``1``; Replace ``1`` with ``0+1``; Auto with real.
+Lemma Rle_lt_0_plus_1 : forall r, 0 <= r -> 0 < r + 1.
+intros.
+apply Rlt_le_trans with 1; auto with real.
+pattern 1 at 1 in |- *; replace 1 with (0 + 1); auto with real.
Qed.
-Hints Resolve Rlt_r_plus_R1: real.
+Hint Resolve Rle_lt_0_plus_1: real.
(**********)
-Lemma Rlt_r_r_plus_R1:(r:R)``r<r+1``.
-Intros.
-Pattern 1 r; Replace r with ``r+0``; Auto with real.
+Lemma Rlt_plus_1 : forall r, r < r + 1.
+intros.
+pattern r at 1 in |- *; replace r with (r + 0); auto with real.
Qed.
-Hints Resolve Rlt_r_r_plus_R1: real.
+Hint Resolve Rlt_plus_1: real.
(**********)
-Lemma tech_Rgt_minus:(r1,r2:R)``0<r2``->``r1>r1-r2``.
-Red; Unfold Rminus; Intros.
-Pattern 2 r1; Replace r1 with ``r1+0``; Auto with real.
+Lemma tech_Rgt_minus : forall r1 r2, 0 < r2 -> r1 > r1 - r2.
+red in |- *; unfold Rminus in |- *; intros.
+pattern r1 at 2 in |- *; replace r1 with (r1 + 0); auto with real.
Qed.
(***********)
-Lemma Rgt_plus_plus_r:(r,r1,r2:R)``r1>r2``->``r+r1 > r+r2``.
-Unfold Rgt; Auto with real.
+Lemma Rplus_gt_compat_l : forall r r1 r2, r1 > r2 -> r + r1 > r + r2.
+unfold Rgt in |- *; auto with real.
Qed.
-Hints Resolve Rgt_plus_plus_r : real.
+Hint Resolve Rplus_gt_compat_l: real.
(***********)
-Lemma Rgt_r_plus_plus:(r,r1,r2:R)``r+r1 > r+r2`` -> ``r1 > r2``.
-Unfold Rgt; Intros; Apply (Rlt_anti_compatibility r r2 r1 H).
+Lemma Rplus_gt_reg_l : forall r r1 r2, r + r1 > r + r2 -> r1 > r2.
+unfold Rgt in |- *; intros; apply (Rplus_lt_reg_r r r2 r1 H).
Qed.
(***********)
-Lemma Rge_plus_plus_r:(r,r1,r2:R)``r1>=r2`` -> ``r+r1 >= r+r2``.
-Intros; Apply Rle_ge; Auto with real.
+Lemma Rplus_ge_compat_l : forall r r1 r2, r1 >= r2 -> r + r1 >= r + r2.
+intros; apply Rle_ge; auto with real.
Qed.
-Hints Resolve Rge_plus_plus_r : real.
+Hint Resolve Rplus_ge_compat_l: real.
(***********)
-Lemma Rge_r_plus_plus:(r,r1,r2:R)``r+r1 >= r+r2`` -> ``r1>=r2``.
-Intros; Apply Rle_ge; Apply Rle_anti_compatibility with r; Auto with real.
+Lemma Rplus_ge_reg_l : forall r r1 r2, r + r1 >= r + r2 -> r1 >= r2.
+intros; apply Rle_ge; apply Rplus_le_reg_l with r; auto with real.
Qed.
(***********)
-Lemma Rge_monotony:
- (x,y,z:R) ``z>=0`` -> ``x>=y`` -> ``x*z >= y*z``.
-Intros x y z; Intros; Apply Rle_ge; Apply Rle_monotony_r; Apply Rge_le; Assumption.
+Lemma Rmult_ge_compat_r :
+ forall r r1 r2, r2 >= 0 -> r >= r1 -> r * r2 >= r1 * r2.
+intros x y z; intros; apply Rle_ge; apply Rmult_le_compat_r; apply Rge_le;
+ assumption.
Qed.
(***********)
-Lemma Rgt_minus:(r1,r2:R)``r1>r2`` -> ``r1-r2 > 0``.
-Intros; Replace ``0`` with ``r2-r2``; Auto with real.
-Unfold Rgt Rminus; Auto with real.
+Lemma Rgt_minus : forall r1 r2, r1 > r2 -> r1 - r2 > 0.
+intros; replace 0 with (r2 - r2); auto with real.
+unfold Rgt, Rminus in |- *; auto with real.
Qed.
(*********)
-Lemma minus_Rgt:(r1,r2:R)``r1-r2 > 0`` -> ``r1>r2``.
-Intros; Replace r2 with ``r2+0``; Auto with real.
-Intros; Replace r1 with ``r2+(r1-r2)``; Auto with real.
+Lemma minus_Rgt : forall r1 r2, r1 - r2 > 0 -> r1 > r2.
+intros; replace r2 with (r2 + 0); auto with real.
+intros; replace r1 with (r2 + (r1 - r2)); auto with real.
Qed.
(**********)
-Lemma Rge_minus:(r1,r2:R)``r1>=r2`` -> ``r1-r2 >= 0``.
-Unfold Rge; Intros; Elim H; Intro.
-Left; Apply (Rgt_minus r1 r2 H0).
-Right; Apply (eq_Rminus r1 r2 H0).
+Lemma Rge_minus : forall r1 r2, r1 >= r2 -> r1 - r2 >= 0.
+unfold Rge in |- *; intros; elim H; intro.
+left; apply (Rgt_minus r1 r2 H0).
+right; apply (Rminus_diag_eq r1 r2 H0).
Qed.
(*********)
-Lemma minus_Rge:(r1,r2:R)``r1-r2 >= 0`` -> ``r1>=r2``.
-Intros; Replace r2 with ``r2+0``; Auto with real.
-Intros; Replace r1 with ``r2+(r1-r2)``; Auto with real.
+Lemma minus_Rge : forall r1 r2, r1 - r2 >= 0 -> r1 >= r2.
+intros; replace r2 with (r2 + 0); auto with real.
+intros; replace r1 with (r2 + (r1 - r2)); auto with real.
Qed.
(*********)
-Lemma Rmult_gt:(r1,r2:R)``r1>0`` -> ``r2>0`` -> ``r1*r2>0``.
-Unfold Rgt;Intros.
-Replace ``0`` with ``0*r2``; Auto with real.
+Lemma Rmult_gt_0_compat : forall r1 r2, r1 > 0 -> r2 > 0 -> r1 * r2 > 0.
+unfold Rgt in |- *; intros.
+replace 0 with (0 * r2); auto with real.
Qed.
(*********)
-Lemma Rmult_lt_pos:(x,y:R)``0<x`` -> ``0<y`` -> ``0<x*y``.
-Proof Rmult_gt.
+Lemma Rmult_lt_0_compat : forall r1 r2, 0 < r1 -> 0 < r2 -> 0 < r1 * r2.
+Proof Rmult_gt_0_compat.
(***********)
-Lemma Rplus_eq_R0_l:(a,b:R)``0<=a`` -> ``0<=b`` -> ``a+b==0`` -> ``a==0``.
-Intros a b [H|H] H0 H1; Auto with real.
-Absurd ``0<a+b``.
-Rewrite H1; Auto with real.
-Replace ``0`` with ``0+0``; Auto with real.
+Lemma Rplus_eq_0_l :
+ forall r1 r2, 0 <= r1 -> 0 <= r2 -> r1 + r2 = 0 -> r1 = 0.
+intros a b [H| H] H0 H1; auto with real.
+absurd (0 < a + b).
+rewrite H1; auto with real.
+replace 0 with (0 + 0); auto with real.
Qed.
-Lemma Rplus_eq_R0
- :(a,b:R)``0<=a`` -> ``0<=b`` -> ``a+b==0`` -> ``a==0``/\``b==0``.
-Intros a b; Split.
-Apply Rplus_eq_R0_l with b; Auto with real.
-Apply Rplus_eq_R0_l with a; Auto with real.
-Rewrite Rplus_sym; Auto with real.
+Lemma Rplus_eq_R0 :
+ forall r1 r2, 0 <= r1 -> 0 <= r2 -> r1 + r2 = 0 -> r1 = 0 /\ r2 = 0.
+intros a b; split.
+apply Rplus_eq_0_l with b; auto with real.
+apply Rplus_eq_0_l with a; auto with real.
+rewrite Rplus_comm; auto with real.
Qed.
(***********)
-Lemma Rplus_Rsr_eq_R0_l:(a,b:R)``(Rsqr a)+(Rsqr b)==0``->``a==0``.
-Intros a b; Intros; Apply Rsqr_r_R0; Apply Rplus_eq_R0_l with (Rsqr b); Auto with real.
+Lemma Rplus_sqr_eq_0_l : forall r1 r2, Rsqr r1 + Rsqr r2 = 0 -> r1 = 0.
+intros a b; intros; apply Rsqr_0_uniq; apply Rplus_eq_0_l with (Rsqr b);
+ auto with real.
Qed.
-Lemma Rplus_Rsr_eq_R0:(a,b:R)``(Rsqr a)+(Rsqr b)==0``->``a==0``/\``b==0``.
-Intros a b; Split.
-Apply Rplus_Rsr_eq_R0_l with b; Auto with real.
-Apply Rplus_Rsr_eq_R0_l with a; Auto with real.
-Rewrite Rplus_sym; Auto with real.
+Lemma Rplus_sqr_eq_0 :
+ forall r1 r2, Rsqr r1 + Rsqr r2 = 0 -> r1 = 0 /\ r2 = 0.
+intros a b; split.
+apply Rplus_sqr_eq_0_l with b; auto with real.
+apply Rplus_sqr_eq_0_l with a; auto with real.
+rewrite Rplus_comm; auto with real.
Qed.
@@ -1167,448 +1157,476 @@ Qed.
(**********************************************************)
(**********)
-Lemma S_INR:(n:nat)(INR (S n))==``(INR n)+1``.
-Intro; Case n; Auto with real.
+Lemma S_INR : forall n:nat, INR (S n) = INR n + 1.
+intro; case n; auto with real.
Qed.
(**********)
-Lemma S_O_plus_INR:(n:nat)
- (INR (plus (S O) n))==``(INR (S O))+(INR n)``.
-Intro; Simpl; Case n; Intros; Auto with real.
+Lemma S_O_plus_INR : forall n:nat, INR (1 + n) = INR 1 + INR n.
+intro; simpl in |- *; case n; intros; auto with real.
Qed.
(**********)
-Lemma plus_INR:(n,m:nat)(INR (plus n m))==``(INR n)+(INR m)``.
-Intros n m; Induction n.
-Simpl; Auto with real.
-Replace (plus (S n) m) with (S (plus n m)); Auto with arith.
-Repeat Rewrite S_INR.
-Rewrite Hrecn; Ring.
+Lemma plus_INR : forall n m:nat, INR (n + m) = INR n + INR m.
+intros n m; induction n as [| n Hrecn].
+simpl in |- *; auto with real.
+replace (S n + m)%nat with (S (n + m)); auto with arith.
+repeat rewrite S_INR.
+rewrite Hrecn; ring.
Qed.
(**********)
-Lemma minus_INR:(n,m:nat)(le m n)->(INR (minus n m))==``(INR n)-(INR m)``.
-Intros n m le; Pattern m n; Apply le_elim_rel; Auto with real.
-Intros; Rewrite <- minus_n_O; Auto with real.
-Intros; Repeat Rewrite S_INR; Simpl.
-Rewrite H0; Ring.
+Lemma minus_INR : forall n m:nat, (m <= n)%nat -> INR (n - m) = INR n - INR m.
+intros n m le; pattern m, n in |- *; apply le_elim_rel; auto with real.
+intros; rewrite <- minus_n_O; auto with real.
+intros; repeat rewrite S_INR; simpl in |- *.
+rewrite H0; ring.
Qed.
(*********)
-Lemma mult_INR:(n,m:nat)(INR (mult n m))==(Rmult (INR n) (INR m)).
-Intros n m; Induction n.
-Simpl; Auto with real.
-Intros; Repeat Rewrite S_INR; Simpl.
-Rewrite plus_INR; Rewrite Hrecn; Ring.
+Lemma mult_INR : forall n m:nat, INR (n * m) = INR n * INR m.
+intros n m; induction n as [| n Hrecn].
+simpl in |- *; auto with real.
+intros; repeat rewrite S_INR; simpl in |- *.
+rewrite plus_INR; rewrite Hrecn; ring.
Qed.
-Hints Resolve plus_INR minus_INR mult_INR : real.
+Hint Resolve plus_INR minus_INR mult_INR: real.
(*********)
-Lemma lt_INR_0:(n:nat)(lt O n)->``0 < (INR n)``.
-Induction 1; Intros; Auto with real.
-Rewrite S_INR; Auto with real.
+Lemma lt_INR_0 : forall n:nat, (0 < n)%nat -> 0 < INR n.
+simple induction 1; intros; auto with real.
+rewrite S_INR; auto with real.
Qed.
-Hints Resolve lt_INR_0: real.
+Hint Resolve lt_INR_0: real.
-Lemma lt_INR:(n,m:nat)(lt n m)->``(INR n) < (INR m)``.
-Induction 1; Intros; Auto with real.
-Rewrite S_INR; Auto with real.
-Rewrite S_INR; Apply Rlt_trans with (INR m0); Auto with real.
+Lemma lt_INR : forall n m:nat, (n < m)%nat -> INR n < INR m.
+simple induction 1; intros; auto with real.
+rewrite S_INR; auto with real.
+rewrite S_INR; apply Rlt_trans with (INR m0); auto with real.
Qed.
-Hints Resolve lt_INR: real.
+Hint Resolve lt_INR: real.
-Lemma INR_lt_1:(n:nat)(lt (S O) n)->``1 < (INR n)``.
-Intros;Replace ``1`` with (INR (S O));Auto with real.
+Lemma INR_lt_1 : forall n:nat, (1 < n)%nat -> 1 < INR n.
+intros; replace 1 with (INR 1); auto with real.
Qed.
-Hints Resolve INR_lt_1: real.
+Hint Resolve INR_lt_1: real.
(**********)
-Lemma INR_pos : (p:positive)``0<(INR (convert p))``.
-Intro; Apply lt_INR_0.
-Simpl; Auto with real.
-Apply compare_convert_O.
+Lemma INR_pos : forall p:positive, 0 < INR (nat_of_P p).
+intro; apply lt_INR_0.
+simpl in |- *; auto with real.
+apply lt_O_nat_of_P.
Qed.
-Hints Resolve INR_pos : real.
+Hint Resolve INR_pos: real.
(**********)
-Lemma pos_INR:(n:nat)``0 <= (INR n)``.
-Intro n; Case n.
-Simpl; Auto with real.
-Auto with arith real.
+Lemma pos_INR : forall n:nat, 0 <= INR n.
+intro n; case n.
+simpl in |- *; auto with real.
+auto with arith real.
Qed.
-Hints Resolve pos_INR: real.
+Hint Resolve pos_INR: real.
-Lemma INR_lt:(n,m:nat)``(INR n) < (INR m)``->(lt n m).
-Double Induction n m;Intros.
-Simpl;ElimType False;Apply (Rlt_antirefl R0);Auto.
-Auto with arith.
-Generalize (pos_INR (S n0));Intro;Cut (INR O)==R0;
- [Intro H2;Rewrite H2 in H0;Idtac|Simpl;Trivial].
-Generalize (Rle_lt_trans ``0`` (INR (S n0)) ``0`` H1 H0);Intro;
- ElimType False;Apply (Rlt_antirefl R0);Auto.
-Do 2 Rewrite S_INR in H1;Cut ``(INR n1) < (INR n0)``.
-Intro H2;Generalize (H0 n0 H2);Intro;Auto with arith.
-Apply (Rlt_anti_compatibility ``1`` (INR n1) (INR n0)).
-Rewrite Rplus_sym;Rewrite (Rplus_sym ``1`` (INR n0));Trivial.
+Lemma INR_lt : forall n m:nat, INR n < INR m -> (n < m)%nat.
+double induction n m; intros.
+simpl in |- *; elimtype False; apply (Rlt_irrefl 0); auto.
+auto with arith.
+generalize (pos_INR (S n0)); intro; cut (INR 0 = 0);
+ [ intro H2; rewrite H2 in H0; idtac | simpl in |- *; trivial ].
+generalize (Rle_lt_trans 0 (INR (S n0)) 0 H1 H0); intro; elimtype False;
+ apply (Rlt_irrefl 0); auto.
+do 2 rewrite S_INR in H1; cut (INR n1 < INR n0).
+intro H2; generalize (H0 n0 H2); intro; auto with arith.
+apply (Rplus_lt_reg_r 1 (INR n1) (INR n0)).
+rewrite Rplus_comm; rewrite (Rplus_comm 1 (INR n0)); trivial.
Qed.
-Hints Resolve INR_lt: real.
+Hint Resolve INR_lt: real.
(*********)
-Lemma le_INR:(n,m:nat)(le n m)->``(INR n)<=(INR m)``.
-Induction 1; Intros; Auto with real.
-Rewrite S_INR.
-Apply Rle_trans with (INR m0); Auto with real.
+Lemma le_INR : forall n m:nat, (n <= m)%nat -> INR n <= INR m.
+simple induction 1; intros; auto with real.
+rewrite S_INR.
+apply Rle_trans with (INR m0); auto with real.
Qed.
-Hints Resolve le_INR: real.
+Hint Resolve le_INR: real.
(**********)
-Lemma not_INR_O:(n:nat)``(INR n)<>0``->~n=O.
-Red; Intros n H H1.
-Apply H.
-Rewrite H1; Trivial.
+Lemma not_INR_O : forall n:nat, INR n <> 0 -> n <> 0%nat.
+red in |- *; intros n H H1.
+apply H.
+rewrite H1; trivial.
Qed.
-Hints Immediate not_INR_O : real.
+Hint Immediate not_INR_O: real.
(**********)
-Lemma not_O_INR:(n:nat)~n=O->``(INR n)<>0``.
-Intro n; Case n.
-Intro; Absurd (0)=(0); Trivial.
-Intros; Rewrite S_INR.
-Apply Rgt_not_eq; Red; Auto with real.
+Lemma not_O_INR : forall n:nat, n <> 0%nat -> INR n <> 0.
+intro n; case n.
+intro; absurd (0%nat = 0%nat); trivial.
+intros; rewrite S_INR.
+apply Rgt_not_eq; red in |- *; auto with real.
Qed.
-Hints Resolve not_O_INR : real.
+Hint Resolve not_O_INR: real.
-Lemma not_nm_INR:(n,m:nat)~n=m->``(INR n)<>(INR m)``.
-Intros n m H; Case (le_or_lt n m); Intros H1.
-Case (le_lt_or_eq ? ? H1); Intros H2.
-Apply imp_not_Req; Auto with real.
-ElimType False;Auto.
-Apply sym_not_eqT; Apply imp_not_Req; Auto with real.
+Lemma not_nm_INR : forall n m:nat, n <> m -> INR n <> INR m.
+intros n m H; case (le_or_lt n m); intros H1.
+case (le_lt_or_eq _ _ H1); intros H2.
+apply Rlt_dichotomy_converse; auto with real.
+elimtype False; auto.
+apply sym_not_eq; apply Rlt_dichotomy_converse; auto with real.
Qed.
-Hints Resolve not_nm_INR : real.
+Hint Resolve not_nm_INR: real.
-Lemma INR_eq: (n,m:nat)(INR n)==(INR m)->n=m.
-Intros;Case (le_or_lt n m); Intros H1.
-Case (le_lt_or_eq ? ? H1); Intros H2;Auto.
-Cut ~n=m.
-Intro H3;Generalize (not_nm_INR n m H3);Intro H4;
- ElimType False;Auto.
-Omega.
-Symmetry;Cut ~m=n.
-Intro H3;Generalize (not_nm_INR m n H3);Intro H4;
- ElimType False;Auto.
-Omega.
+Lemma INR_eq : forall n m:nat, INR n = INR m -> n = m.
+intros; case (le_or_lt n m); intros H1.
+case (le_lt_or_eq _ _ H1); intros H2; auto.
+cut (n <> m).
+intro H3; generalize (not_nm_INR n m H3); intro H4; elimtype False; auto.
+omega.
+symmetry in |- *; cut (m <> n).
+intro H3; generalize (not_nm_INR m n H3); intro H4; elimtype False; auto.
+omega.
Qed.
-Hints Resolve INR_eq : real.
+Hint Resolve INR_eq: real.
-Lemma INR_le: (n, m : nat) (Rle (INR n) (INR m)) -> (le n m).
-Intros;Elim H;Intro.
-Generalize (INR_lt n m H0);Intro;Auto with arith.
-Generalize (INR_eq n m H0);Intro;Rewrite H1;Auto.
+Lemma INR_le : forall n m:nat, INR n <= INR m -> (n <= m)%nat.
+intros; elim H; intro.
+generalize (INR_lt n m H0); intro; auto with arith.
+generalize (INR_eq n m H0); intro; rewrite H1; auto.
Qed.
-Hints Resolve INR_le : real.
+Hint Resolve INR_le: real.
-Lemma not_1_INR:(n:nat)~n=(S O)->``(INR n)<>1``.
-Replace ``1`` with (INR (S O)); Auto with real.
+Lemma not_1_INR : forall n:nat, n <> 1%nat -> INR n <> 1.
+replace 1 with (INR 1); auto with real.
Qed.
-Hints Resolve not_1_INR : real.
+Hint Resolve not_1_INR: real.
(**********************************************************)
(** Injection from [Z] to [R] *)
(**********************************************************)
-V7only [
-(**********)
-Definition Z_of_nat := inject_nat.
-Notation INZ:=Z_of_nat.
-].
(**********)
-Lemma IZN:(z:Z)(`0<=z`)->(Ex [m:nat] z=(INZ m)).
-Intros z; Unfold INZ; Apply inject_nat_complete; Assumption.
+Lemma IZN : forall n:Z, (0 <= n)%Z -> exists m : nat | n = Z_of_nat m.
+intros z; idtac; apply Z_of_nat_complete; assumption.
Qed.
(**********)
-Lemma INR_IZR_INZ:(n:nat)(INR n)==(IZR (INZ n)).
-Induction n; Auto with real.
-Intros; Simpl; Rewrite bij1; Auto with real.
+Lemma INR_IZR_INZ : forall n:nat, INR n = IZR (Z_of_nat n).
+simple induction n; auto with real.
+intros; simpl in |- *; rewrite nat_of_P_o_P_of_succ_nat_eq_succ;
+ auto with real.
Qed.
-Lemma plus_IZR_NEG_POS :
- (p,q:positive)(IZR `(POS p)+(NEG q)`)==``(IZR (POS p))+(IZR (NEG q))``.
-Intros.
-Case (lt_eq_lt_dec (convert p) (convert q)).
-Intros [H | H]; Simpl.
-Rewrite convert_compare_INFERIEUR; Simpl; Trivial.
-Rewrite (true_sub_convert q p).
-Rewrite minus_INR; Auto with arith; Ring.
-Apply ZC2; Apply convert_compare_INFERIEUR; Trivial.
-Rewrite (convert_intro p q); Trivial.
-Rewrite convert_compare_EGAL; Simpl; Auto with real.
-Intro H; Simpl.
-Rewrite convert_compare_SUPERIEUR; Simpl; Auto with arith.
-Rewrite (true_sub_convert p q).
-Rewrite minus_INR; Auto with arith; Ring.
-Apply ZC2; Apply convert_compare_INFERIEUR; Trivial.
+Lemma plus_IZR_NEG_POS :
+ forall p q:positive, IZR (Zpos p + Zneg q) = IZR (Zpos p) + IZR (Zneg q).
+intros.
+case (lt_eq_lt_dec (nat_of_P p) (nat_of_P q)).
+intros [H| H]; simpl in |- *.
+rewrite nat_of_P_lt_Lt_compare_complement_morphism; simpl in |- *; trivial.
+rewrite (nat_of_P_minus_morphism q p).
+rewrite minus_INR; auto with arith; ring.
+apply ZC2; apply nat_of_P_lt_Lt_compare_complement_morphism; trivial.
+rewrite (nat_of_P_inj p q); trivial.
+rewrite Pcompare_refl; simpl in |- *; auto with real.
+intro H; simpl in |- *.
+rewrite nat_of_P_gt_Gt_compare_complement_morphism; simpl in |- *;
+ auto with arith.
+rewrite (nat_of_P_minus_morphism p q).
+rewrite minus_INR; auto with arith; ring.
+apply ZC2; apply nat_of_P_lt_Lt_compare_complement_morphism; trivial.
Qed.
(**********)
-Lemma plus_IZR:(z,t:Z)(IZR `z+t`)==``(IZR z)+(IZR t)``.
-Intro z; NewDestruct z; Intro t; NewDestruct t; Intros; Auto with real.
-Simpl; Intros; Rewrite convert_add; Auto with real.
-Apply plus_IZR_NEG_POS.
-Rewrite Zplus_sym; Rewrite Rplus_sym; Apply plus_IZR_NEG_POS.
-Simpl; Intros; Rewrite convert_add; Rewrite plus_INR; Auto with real.
+Lemma plus_IZR : forall n m:Z, IZR (n + m) = IZR n + IZR m.
+intro z; destruct z; intro t; destruct t; intros; auto with real.
+simpl in |- *; intros; rewrite nat_of_P_plus_morphism; auto with real.
+apply plus_IZR_NEG_POS.
+rewrite Zplus_comm; rewrite Rplus_comm; apply plus_IZR_NEG_POS.
+simpl in |- *; intros; rewrite nat_of_P_plus_morphism; rewrite plus_INR;
+ auto with real.
Qed.
(**********)
-Lemma mult_IZR:(z,t:Z)(IZR `z*t`)==``(IZR z)*(IZR t)``.
-Intros z t; Case z; Case t; Simpl; Auto with real.
-Intros t1 z1; Rewrite times_convert; Auto with real.
-Intros t1 z1; Rewrite times_convert; Auto with real.
-Rewrite Rmult_sym.
-Rewrite Ropp_mul1; Auto with real.
-Apply eq_Ropp; Rewrite mult_sym; Auto with real.
-Intros t1 z1; Rewrite times_convert; Auto with real.
-Rewrite Ropp_mul1; Auto with real.
-Intros t1 z1; Rewrite times_convert; Auto with real.
-Rewrite Ropp_mul2; Auto with real.
+Lemma mult_IZR : forall n m:Z, IZR (n * m) = IZR n * IZR m.
+intros z t; case z; case t; simpl in |- *; auto with real.
+intros t1 z1; rewrite nat_of_P_mult_morphism; auto with real.
+intros t1 z1; rewrite nat_of_P_mult_morphism; auto with real.
+rewrite Rmult_comm.
+rewrite Ropp_mult_distr_l_reverse; auto with real.
+apply Ropp_eq_compat; rewrite mult_comm; auto with real.
+intros t1 z1; rewrite nat_of_P_mult_morphism; auto with real.
+rewrite Ropp_mult_distr_l_reverse; auto with real.
+intros t1 z1; rewrite nat_of_P_mult_morphism; auto with real.
+rewrite Rmult_opp_opp; auto with real.
Qed.
(**********)
-Lemma Ropp_Ropp_IZR:(z:Z)(IZR (`-z`))==``-(IZR z)``.
-Intro z; Case z; Simpl; Auto with real.
+Lemma Ropp_Ropp_IZR : forall n:Z, IZR (- n) = - IZR n.
+intro z; case z; simpl in |- *; auto with real.
Qed.
(**********)
-Lemma Z_R_minus:(z1,z2:Z)``(IZR z1)-(IZR z2)``==(IZR `z1-z2`).
-Intros z1 z2; Unfold Rminus; Unfold Zminus.
-Rewrite <-(Ropp_Ropp_IZR z2); Symmetry; Apply plus_IZR.
+Lemma Z_R_minus : forall n m:Z, IZR n - IZR m = IZR (n - m).
+intros z1 z2; unfold Rminus in |- *; unfold Zminus in |- *.
+rewrite <- (Ropp_Ropp_IZR z2); symmetry in |- *; apply plus_IZR.
Qed.
(**********)
-Lemma lt_O_IZR:(z:Z)``0 < (IZR z)``->`0<z`.
-Intro z; Case z; Simpl; Intros.
-Absurd ``0<0``; Auto with real.
-Unfold Zlt; Simpl; Trivial.
-Case Rlt_le_not with 1:=H.
-Replace ``0`` with ``-0``; Auto with real.
+Lemma lt_O_IZR : forall n:Z, 0 < IZR n -> (0 < n)%Z.
+intro z; case z; simpl in |- *; intros.
+absurd (0 < 0); auto with real.
+unfold Zlt in |- *; simpl in |- *; trivial.
+case Rlt_not_le with (1 := H).
+replace 0 with (-0); auto with real.
Qed.
(**********)
-Lemma lt_IZR:(z1,z2:Z)``(IZR z1)<(IZR z2)``->`z1<z2`.
-Intros z1 z2 H; Apply Zlt_O_minus_lt.
-Apply lt_O_IZR.
-Rewrite <- Z_R_minus.
-Exact (Rgt_minus (IZR z2) (IZR z1) H).
+Lemma lt_IZR : forall n m:Z, IZR n < IZR m -> (n < m)%Z.
+intros z1 z2 H; apply Zlt_O_minus_lt.
+apply lt_O_IZR.
+rewrite <- Z_R_minus.
+exact (Rgt_minus (IZR z2) (IZR z1) H).
Qed.
(**********)
-Lemma eq_IZR_R0:(z:Z)``(IZR z)==0``->`z=0`.
-Intro z; NewDestruct z; Simpl; Intros; Auto with zarith.
-Case (Rlt_not_eq ``0`` (INR (convert p))); Auto with real.
-Case (Rlt_not_eq ``-(INR (convert p))`` ``0`` ); Auto with real.
-Apply Rgt_RoppO. Unfold Rgt; Apply INR_pos.
+Lemma eq_IZR_R0 : forall n:Z, IZR n = 0 -> n = 0%Z.
+intro z; destruct z; simpl in |- *; intros; auto with zarith.
+case (Rlt_not_eq 0 (INR (nat_of_P p))); auto with real.
+case (Rlt_not_eq (- INR (nat_of_P p)) 0); auto with real.
+apply Ropp_lt_gt_0_contravar. unfold Rgt in |- *; apply INR_pos.
Qed.
(**********)
-Lemma eq_IZR:(z1,z2:Z)(IZR z1)==(IZR z2)->z1=z2.
-Intros z1 z2 H;Generalize (eq_Rminus (IZR z1) (IZR z2) H);
- Rewrite (Z_R_minus z1 z2);Intro;Generalize (eq_IZR_R0 `z1-z2` H0);
- Intro;Omega.
+Lemma eq_IZR : forall n m:Z, IZR n = IZR m -> n = m.
+intros z1 z2 H; generalize (Rminus_diag_eq (IZR z1) (IZR z2) H);
+ rewrite (Z_R_minus z1 z2); intro; generalize (eq_IZR_R0 (z1 - z2) H0);
+ intro; omega.
Qed.
(**********)
-Lemma not_O_IZR:(z:Z)`z<>0`->``(IZR z)<>0``.
-Intros z H; Red; Intros H0; Case H.
-Apply eq_IZR; Auto.
+Lemma not_O_IZR : forall n:Z, n <> 0%Z -> IZR n <> 0.
+intros z H; red in |- *; intros H0; case H.
+apply eq_IZR; auto.
Qed.
(*********)
-Lemma le_O_IZR:(z:Z)``0<= (IZR z)``->`0<=z`.
-Unfold Rle; Intros z [H|H].
-Red;Intro;Apply (Zlt_le_weak `0` z (lt_O_IZR z H)); Assumption.
-Rewrite (eq_IZR_R0 z); Auto with zarith real.
+Lemma le_O_IZR : forall n:Z, 0 <= IZR n -> (0 <= n)%Z.
+unfold Rle in |- *; intros z [H| H].
+red in |- *; intro; apply (Zlt_le_weak 0 z (lt_O_IZR z H)); assumption.
+rewrite (eq_IZR_R0 z); auto with zarith real.
Qed.
(**********)
-Lemma le_IZR:(z1,z2:Z)``(IZR z1)<=(IZR z2)``->`z1<=z2`.
-Unfold Rle; Intros z1 z2 [H|H].
-Apply (Zlt_le_weak z1 z2); Auto with real.
-Apply lt_IZR; Trivial.
-Rewrite (eq_IZR z1 z2); Auto with zarith real.
+Lemma le_IZR : forall n m:Z, IZR n <= IZR m -> (n <= m)%Z.
+unfold Rle in |- *; intros z1 z2 [H| H].
+apply (Zlt_le_weak z1 z2); auto with real.
+apply lt_IZR; trivial.
+rewrite (eq_IZR z1 z2); auto with zarith real.
Qed.
(**********)
-Lemma le_IZR_R1:(z:Z)``(IZR z)<=1``-> `z<=1`.
-Pattern 1 ``1``; Replace ``1`` with (IZR `1`); Intros; Auto.
-Apply le_IZR; Trivial.
+Lemma le_IZR_R1 : forall n:Z, IZR n <= 1 -> (n <= 1)%Z.
+pattern 1 at 1 in |- *; replace 1 with (IZR 1); intros; auto.
+apply le_IZR; trivial.
Qed.
(**********)
-Lemma IZR_ge: (m,n:Z) `m>= n` -> ``(IZR m)>=(IZR n)``.
-Intros m n H; Apply Rlt_not_ge;Red;Intro.
-Generalize (lt_IZR m n H0); Intro; Omega.
+Lemma IZR_ge : forall n m:Z, (n >= m)%Z -> IZR n >= IZR m.
+intros m n H; apply Rnot_lt_ge; red in |- *; intro.
+generalize (lt_IZR m n H0); intro; omega.
Qed.
-Lemma IZR_le: (m,n:Z) `m<= n` -> ``(IZR m)<=(IZR n)``.
-Intros m n H;Apply Rgt_not_le;Red;Intro.
-Unfold Rgt in H0;Generalize (lt_IZR n m H0); Intro; Omega.
+Lemma IZR_le : forall n m:Z, (n <= m)%Z -> IZR n <= IZR m.
+intros m n H; apply Rnot_gt_le; red in |- *; intro.
+unfold Rgt in H0; generalize (lt_IZR n m H0); intro; omega.
Qed.
-Lemma IZR_lt: (m,n:Z) `m< n` -> ``(IZR m)<(IZR n)``.
-Intros m n H;Cut `m<=n`.
-Intro H0;Elim (IZR_le m n H0);Intro;Auto.
-Generalize (eq_IZR m n H1);Intro;ElimType False;Omega.
-Omega.
+Lemma IZR_lt : forall n m:Z, (n < m)%Z -> IZR n < IZR m.
+intros m n H; cut (m <= n)%Z.
+intro H0; elim (IZR_le m n H0); intro; auto.
+generalize (eq_IZR m n H1); intro; elimtype False; omega.
+omega.
Qed.
-Lemma one_IZR_lt1 : (z:Z)``-1<(IZR z)<1``->`z=0`.
-Intros z (H1,H2).
-Apply Zle_antisym.
-Apply Zlt_n_Sm_le; Apply lt_IZR; Trivial.
-Replace `0` with (Zs `-1`); Trivial.
-Apply Zlt_le_S; Apply lt_IZR; Trivial.
+Lemma one_IZR_lt1 : forall n:Z, -1 < IZR n < 1 -> n = 0%Z.
+intros z [H1 H2].
+apply Zle_antisym.
+apply Zlt_succ_le; apply lt_IZR; trivial.
+replace 0%Z with (Zsucc (-1)); trivial.
+apply Zlt_le_succ; apply lt_IZR; trivial.
Qed.
-Lemma one_IZR_r_R1
- : (r:R)(z,x:Z)``r<(IZR z)<=r+1``->``r<(IZR x)<=r+1``->z=x.
-Intros r z x (H1,H2) (H3,H4).
-Cut `z-x=0`; Auto with zarith.
-Apply one_IZR_lt1.
-Rewrite <- Z_R_minus; Split.
-Replace ``-1`` with ``r-(r+1)``.
-Unfold Rminus; Apply Rplus_lt_le_lt; Auto with real.
-Ring.
-Replace ``1`` with ``(r+1)-r``.
-Unfold Rminus; Apply Rplus_le_lt_lt; Auto with real.
-Ring.
+Lemma one_IZR_r_R1 :
+ forall r (n m:Z), r < IZR n <= r + 1 -> r < IZR m <= r + 1 -> n = m.
+intros r z x [H1 H2] [H3 H4].
+cut ((z - x)%Z = 0%Z); auto with zarith.
+apply one_IZR_lt1.
+rewrite <- Z_R_minus; split.
+replace (-1) with (r - (r + 1)).
+unfold Rminus in |- *; apply Rplus_lt_le_compat; auto with real.
+ring.
+replace 1 with (r + 1 - r).
+unfold Rminus in |- *; apply Rplus_le_lt_compat; auto with real.
+ring.
Qed.
(**********)
-Lemma single_z_r_R1:
- (r:R)(z,x:Z)``r<(IZR z)``->``(IZR z)<=r+1``->``r<(IZR x)``->
- ``(IZR x)<=r+1``->z=x.
-Intros; Apply one_IZR_r_R1 with r; Auto.
+Lemma single_z_r_R1 :
+ forall r (n m:Z),
+ r < IZR n -> IZR n <= r + 1 -> r < IZR m -> IZR m <= r + 1 -> n = m.
+intros; apply one_IZR_r_R1 with r; auto.
Qed.
(**********)
-Lemma tech_single_z_r_R1
- :(r:R)(z:Z)``r<(IZR z)``->``(IZR z)<=r+1``
- -> (Ex [s:Z] (~s=z/\``r<(IZR s)``/\``(IZR s)<=r+1``))->False.
-Intros r z H1 H2 (s, (H3,(H4,H5))).
-Apply H3; Apply single_z_r_R1 with r; Trivial.
+Lemma tech_single_z_r_R1 :
+ forall r (n:Z),
+ r < IZR n ->
+ IZR n <= r + 1 ->
+ ( exists s : Z | s <> n /\ r < IZR s /\ IZR s <= r + 1) -> False.
+intros r z H1 H2 [s [H3 [H4 H5]]].
+apply H3; apply single_z_r_R1 with r; trivial.
Qed.
(*****************************************************************)
(** Definitions of new types *)
(*****************************************************************)
-Record nonnegreal : Type := mknonnegreal {
-nonneg :> R;
-cond_nonneg : ``0<=nonneg`` }.
+Record nonnegreal : Type := mknonnegreal
+ {nonneg :> R; cond_nonneg : 0 <= nonneg}.
-Record posreal : Type := mkposreal {
-pos :> R;
-cond_pos : ``0<pos`` }.
+Record posreal : Type := mkposreal {pos :> R; cond_pos : 0 < pos}.
-Record nonposreal : Type := mknonposreal {
-nonpos :> R;
-cond_nonpos : ``nonpos<=0`` }.
+Record nonposreal : Type := mknonposreal
+ {nonpos :> R; cond_nonpos : nonpos <= 0}.
-Record negreal : Type := mknegreal {
-neg :> R;
-cond_neg : ``neg<0`` }.
+Record negreal : Type := mknegreal {neg :> R; cond_neg : neg < 0}.
-Record nonzeroreal : Type := mknonzeroreal {
-nonzero :> R;
-cond_nonzero : ~``nonzero==0`` }.
+Record nonzeroreal : Type := mknonzeroreal
+ {nonzero :> R; cond_nonzero : nonzero <> 0}.
(**********)
-Lemma prod_neq_R0 : (x,y:R) ~``x==0``->~``y==0``->~``x*y==0``.
-Intros x y; Intros; Red; Intro; Generalize (without_div_Od x y H1); Intro; Elim H2; Intro; [Rewrite H3 in H; Elim H | Rewrite H3 in H0; Elim H0]; Reflexivity.
+Lemma prod_neq_R0 : forall r1 r2, r1 <> 0 -> r2 <> 0 -> r1 * r2 <> 0.
+intros x y; intros; red in |- *; intro; generalize (Rmult_integral x y H1);
+ intro; elim H2; intro;
+ [ rewrite H3 in H; elim H | rewrite H3 in H0; elim H0 ];
+ reflexivity.
Qed.
(*********)
-Lemma Rmult_le_pos : (x,y:R) ``0<=x`` -> ``0<=y`` -> ``0<=x*y``.
-Intros x y H H0; Rewrite <- (Rmult_Ol x); Rewrite <- (Rmult_sym x); Apply (Rle_monotony x R0 y H H0).
+Lemma Rmult_le_pos : forall r1 r2, 0 <= r1 -> 0 <= r2 -> 0 <= r1 * r2.
+intros x y H H0; rewrite <- (Rmult_0_l x); rewrite <- (Rmult_comm x);
+ apply (Rmult_le_compat_l x 0 y H H0).
Qed.
-Lemma double : (x:R) ``2*x==x+x``.
-Intro; Ring.
+Lemma double : forall r1, 2 * r1 = r1 + r1.
+intro; ring.
Qed.
-Lemma double_var : (x:R) ``x == x/2 + x/2``.
-Intro; Rewrite <- double; Unfold Rdiv; Rewrite <- Rmult_assoc; Symmetry; Apply Rinv_r_simpl_m.
-Replace ``2`` with (INR (2)); [Apply not_O_INR; Discriminate | Unfold INR; Ring].
+Lemma double_var : forall r1, r1 = r1 / 2 + r1 / 2.
+intro; rewrite <- double; unfold Rdiv in |- *; rewrite <- Rmult_assoc;
+ symmetry in |- *; apply Rinv_r_simpl_m.
+replace 2 with (INR 2);
+ [ apply not_O_INR; discriminate | unfold INR in |- *; ring ].
Qed.
(**********************************************************)
(** Other rules about < and <= *)
(**********************************************************)
-Lemma gt0_plus_gt0_is_gt0 : (x,y:R) ``0<x`` -> ``0<y`` -> ``0<x+y``.
-Intros x y; Intros; Apply Rlt_trans with x; [Assumption | Pattern 1 x; Rewrite <- (Rplus_Or x); Apply Rlt_compatibility; Assumption].
-Qed.
-
-Lemma ge0_plus_gt0_is_gt0 : (x,y:R) ``0<=x`` -> ``0<y`` -> ``0<x+y``.
-Intros x y; Intros; Apply Rle_lt_trans with x; [Assumption | Pattern 1 x; Rewrite <- (Rplus_Or x); Apply Rlt_compatibility; Assumption].
-Qed.
-
-Lemma gt0_plus_ge0_is_gt0 : (x,y:R) ``0<x`` -> ``0<=y`` -> ``0<x+y``.
-Intros x y; Intros; Rewrite <- Rplus_sym; Apply ge0_plus_gt0_is_gt0; Assumption.
-Qed.
-
-Lemma ge0_plus_ge0_is_ge0 : (x,y:R) ``0<=x`` -> ``0<=y`` -> ``0<=x+y``.
-Intros x y; Intros; Apply Rle_trans with x; [Assumption | Pattern 1 x; Rewrite <- (Rplus_Or x); Apply Rle_compatibility; Assumption].
-Qed.
-
-Lemma plus_le_is_le : (x,y,z:R) ``0<=y`` -> ``x+y<=z`` -> ``x<=z``.
-Intros x y z; Intros; Apply Rle_trans with ``x+y``; [Pattern 1 x; Rewrite <- (Rplus_Or x); Apply Rle_compatibility; Assumption | Assumption].
-Qed.
-
-Lemma plus_lt_is_lt : (x,y,z:R) ``0<=y`` -> ``x+y<z`` -> ``x<z``.
-Intros x y z; Intros; Apply Rle_lt_trans with ``x+y``; [Pattern 1 x; Rewrite <- (Rplus_Or x); Apply Rle_compatibility; Assumption | Assumption].
-Qed.
-
-Lemma Rmult_lt2 : (r1,r2,r3,r4:R) ``0<=r1`` -> ``0<=r3`` -> ``r1<r2`` -> ``r3<r4`` -> ``r1*r3<r2*r4``.
-Intros; Apply Rle_lt_trans with ``r2*r3``; [Apply Rle_monotony_r; [Assumption | Left; Assumption] | Apply Rlt_monotony; [Apply Rle_lt_trans with r1; Assumption | Assumption]].
-Qed.
-
-Lemma le_epsilon : (x,y:R) ((eps : R) ``0<eps``->``x<=y+eps``) -> ``x<=y``.
-Intros x y; Intros; Elim (total_order x y); Intro.
-Left; Assumption.
-Elim H0; Intro.
-Right; Assumption.
-Clear H0; Generalize (Rgt_minus x y H1); Intro H2; Change ``0<x-y`` in H2.
-Cut ``0<2``.
-Intro.
-Generalize (Rmult_lt_pos ``x-y`` ``/2`` H2 (Rlt_Rinv ``2`` H0)); Intro H3; Generalize (H ``(x-y)*/2`` H3); Replace ``y+(x-y)*/2`` with ``(y+x)*/2``.
-Intro H4; Generalize (Rle_monotony ``2`` x ``(y+x)*/2`` (Rlt_le ``0`` ``2`` H0) H4); Rewrite <- (Rmult_sym ``((y+x)*/2)``); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Replace ``2*x`` with ``x+x``.
-Rewrite (Rplus_sym y); Intro H5; Apply Rle_anti_compatibility with x; Assumption.
-Ring.
-Replace ``2`` with (INR (S (S O))); [Apply not_O_INR; Discriminate | Ring].
-Pattern 2 y; Replace y with ``y/2+y/2``.
-Unfold Rminus Rdiv.
-Repeat Rewrite Rmult_Rplus_distrl.
-Ring.
-Cut (z:R) ``2*z == z + z``.
-Intro.
-Rewrite <- (H4 ``y/2``).
-Unfold Rdiv.
-Rewrite <- Rmult_assoc; Apply Rinv_r_simpl_m.
-Replace ``2`` with (INR (2)).
-Apply not_O_INR.
-Discriminate.
-Unfold INR; Reflexivity.
-Intro; Ring.
-Cut ~(O=(2)); [Intro H0; Generalize (lt_INR_0 (2) (neq_O_lt (2) H0)); Unfold INR; Intro; Assumption | Discriminate].
-Qed.
-
-(**********)
-Lemma complet_weak : (E:R->Prop) (bound E) -> (ExT [x:R] (E x)) -> (ExT [m:R] (is_lub E m)).
-Intros; Elim (complet E H H0); Intros; Split with x; Assumption.
-Qed.
+Lemma Rplus_lt_0_compat : forall r1 r2, 0 < r1 -> 0 < r2 -> 0 < r1 + r2.
+intros x y; intros; apply Rlt_trans with x;
+ [ assumption
+ | pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_lt_compat_l;
+ assumption ].
+Qed.
+
+Lemma Rplus_le_lt_0_compat : forall r1 r2, 0 <= r1 -> 0 < r2 -> 0 < r1 + r2.
+intros x y; intros; apply Rle_lt_trans with x;
+ [ assumption
+ | pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_lt_compat_l;
+ assumption ].
+Qed.
+
+Lemma Rplus_lt_le_0_compat : forall r1 r2, 0 < r1 -> 0 <= r2 -> 0 < r1 + r2.
+intros x y; intros; rewrite <- Rplus_comm; apply Rplus_le_lt_0_compat;
+ assumption.
+Qed.
+
+Lemma Rplus_le_le_0_compat : forall r1 r2, 0 <= r1 -> 0 <= r2 -> 0 <= r1 + r2.
+intros x y; intros; apply Rle_trans with x;
+ [ assumption
+ | pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l;
+ assumption ].
+Qed.
+
+Lemma plus_le_is_le : forall r1 r2 r3, 0 <= r2 -> r1 + r2 <= r3 -> r1 <= r3.
+intros x y z; intros; apply Rle_trans with (x + y);
+ [ pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l;
+ assumption
+ | assumption ].
+Qed.
+
+Lemma plus_lt_is_lt : forall r1 r2 r3, 0 <= r2 -> r1 + r2 < r3 -> r1 < r3.
+intros x y z; intros; apply Rle_lt_trans with (x + y);
+ [ pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l;
+ assumption
+ | assumption ].
+Qed.
+
+Lemma Rmult_le_0_lt_compat :
+ forall r1 r2 r3 r4,
+ 0 <= r1 -> 0 <= r3 -> r1 < r2 -> r3 < r4 -> r1 * r3 < r2 * r4.
+intros; apply Rle_lt_trans with (r2 * r3);
+ [ apply Rmult_le_compat_r; [ assumption | left; assumption ]
+ | apply Rmult_lt_compat_l;
+ [ apply Rle_lt_trans with r1; assumption | assumption ] ].
+Qed.
+
+Lemma le_epsilon :
+ forall r1 r2, (forall eps:R, 0 < eps -> r1 <= r2 + eps) -> r1 <= r2.
+intros x y; intros; elim (Rtotal_order x y); intro.
+left; assumption.
+elim H0; intro.
+right; assumption.
+clear H0; generalize (Rgt_minus x y H1); intro H2; change (0 < x - y) in H2.
+cut (0 < 2).
+intro.
+generalize (Rmult_lt_0_compat (x - y) (/ 2) H2 (Rinv_0_lt_compat 2 H0));
+ intro H3; generalize (H ((x - y) * / 2) H3);
+ replace (y + (x - y) * / 2) with ((y + x) * / 2).
+intro H4;
+ generalize (Rmult_le_compat_l 2 x ((y + x) * / 2) (Rlt_le 0 2 H0) H4);
+ rewrite <- (Rmult_comm ((y + x) * / 2)); rewrite Rmult_assoc;
+ rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r; replace (2 * x) with (x + x).
+rewrite (Rplus_comm y); intro H5; apply Rplus_le_reg_l with x; assumption.
+ring.
+replace 2 with (INR 2); [ apply not_O_INR; discriminate | ring ].
+pattern y at 2 in |- *; replace y with (y / 2 + y / 2).
+unfold Rminus, Rdiv in |- *.
+repeat rewrite Rmult_plus_distr_r.
+ring.
+cut (forall z:R, 2 * z = z + z).
+intro.
+rewrite <- (H4 (y / 2)).
+unfold Rdiv in |- *.
+rewrite <- Rmult_assoc; apply Rinv_r_simpl_m.
+replace 2 with (INR 2).
+apply not_O_INR.
+discriminate.
+unfold INR in |- *; reflexivity.
+intro; ring.
+cut (0%nat <> 2%nat);
+ [ intro H0; generalize (lt_INR_0 2 (neq_O_lt 2 H0)); unfold INR in |- *;
+ intro; assumption
+ | discriminate ].
+Qed.
+
+(**********)
+Lemma completeness_weak :
+ forall E:R -> Prop,
+ bound E -> ( exists x : R | E x) -> exists m : R | is_lub E m.
+intros; elim (completeness E H H0); intros; split with x; assumption.
+Qed. \ No newline at end of file
diff --git a/theories/Reals/RList.v b/theories/Reals/RList.v
index 6e6f2716b..40848009a 100644
--- a/theories/Reals/RList.v
+++ b/theories/Reals/RList.v
@@ -8,420 +8,737 @@
(*i $Id$ i*)
-Require Rbase.
-Require Rfunctions.
-V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
+Require Import Rbase.
+Require Import Rfunctions.
Open Local Scope R_scope.
Inductive Rlist : Type :=
-| nil : Rlist
-| cons : R -> Rlist -> Rlist.
-
-Fixpoint In [x:R;l:Rlist] : Prop :=
-Cases l of
-| nil => False
-| (cons a l') => ``x==a``\/(In x l') end.
-
-Fixpoint Rlength [l:Rlist] : nat :=
-Cases l of
-| nil => O
-| (cons a l') => (S (Rlength l')) end.
-
-Fixpoint MaxRlist [l:Rlist] : R :=
- Cases l of
- | nil => R0
- | (cons a l1) =>
- Cases l1 of
- | nil => a
- | (cons a' l2) => (Rmax a (MaxRlist l1))
- end
-end.
-
-Fixpoint MinRlist [l:Rlist] : R :=
-Cases l of
- | nil => R1
- | (cons a l1) =>
- Cases l1 of
- | nil => a
- | (cons a' l2) => (Rmin a (MinRlist l1))
- end
-end.
-
-Lemma MaxRlist_P1 : (l:Rlist;x:R) (In x l)->``x<=(MaxRlist l)``.
-Intros; Induction l.
-Simpl in H; Elim H.
-Induction l.
-Simpl in H; Elim H; Intro.
-Simpl; Right; Assumption.
-Elim H0.
-Replace (MaxRlist (cons r (cons r0 l))) with (Rmax r (MaxRlist (cons r0 l))).
-Simpl in H; Decompose [or] H.
-Rewrite H0; Apply RmaxLess1.
-Unfold Rmax; Case (total_order_Rle r (MaxRlist (cons r0 l))); Intro.
-Apply Hrecl; Simpl; Tauto.
-Apply Rle_trans with (MaxRlist (cons r0 l)); [Apply Hrecl; Simpl; Tauto | Left; Auto with real].
-Unfold Rmax; Case (total_order_Rle r (MaxRlist (cons r0 l))); Intro.
-Apply Hrecl; Simpl; Tauto.
-Apply Rle_trans with (MaxRlist (cons r0 l)); [Apply Hrecl; Simpl; Tauto | Left; Auto with real].
-Reflexivity.
-Qed.
-
-Fixpoint AbsList [l:Rlist] : R->Rlist :=
-[x:R] Cases l of
-| nil => nil
-| (cons a l') => (cons ``(Rabsolu (a-x))/2`` (AbsList l' x))
-end.
-
-Lemma MinRlist_P1 : (l:Rlist;x:R) (In x l)->``(MinRlist l)<=x``.
-Intros; Induction l.
-Simpl in H; Elim H.
-Induction l.
-Simpl in H; Elim H; Intro.
-Simpl; Right; Symmetry; Assumption.
-Elim H0.
-Replace (MinRlist (cons r (cons r0 l))) with (Rmin r (MinRlist (cons r0 l))).
-Simpl in H; Decompose [or] H.
-Rewrite H0; Apply Rmin_l.
-Unfold Rmin; Case (total_order_Rle r (MinRlist (cons r0 l))); Intro.
-Apply Rle_trans with (MinRlist (cons r0 l)).
-Assumption.
-Apply Hrecl; Simpl; Tauto.
-Apply Hrecl; Simpl; Tauto.
-Apply Rle_trans with (MinRlist (cons r0 l)).
-Apply Rmin_r.
-Apply Hrecl; Simpl; Tauto.
-Reflexivity.
-Qed.
-
-Lemma AbsList_P1 : (l:Rlist;x,y:R) (In y l) -> (In ``(Rabsolu (y-x))/2`` (AbsList l x)).
-Intros; Induction l.
-Elim H.
-Simpl; Simpl in H; Elim H; Intro.
-Left; Rewrite H0; Reflexivity.
-Right; Apply Hrecl; Assumption.
-Qed.
-
-Lemma MinRlist_P2 : (l:Rlist) ((y:R)(In y l)->``0<y``)->``0<(MinRlist l)``.
-Intros; Induction l.
-Apply Rlt_R0_R1.
-Induction l.
-Simpl; Apply H; Simpl; Tauto.
-Replace (MinRlist (cons r (cons r0 l))) with (Rmin r (MinRlist (cons r0 l))).
-Unfold Rmin; Case (total_order_Rle r (MinRlist (cons r0 l))); Intro.
-Apply H; Simpl; Tauto.
-Apply Hrecl; Intros; Apply H; Simpl; Simpl in H0; Tauto.
-Reflexivity.
-Qed.
-
-Lemma AbsList_P2 : (l:Rlist;x,y:R) (In y (AbsList l x)) -> (EXT z : R | (In z l)/\``y==(Rabsolu (z-x))/2``).
-Intros; Induction l.
-Elim H.
-Elim H; Intro.
-Exists r; Split.
-Simpl; Tauto.
-Assumption.
-Assert H1 := (Hrecl H0); Elim H1; Intros; Elim H2; Clear H2; Intros; Exists x0; Simpl; Simpl in H2; Tauto.
-Qed.
-
-Lemma MaxRlist_P2 : (l:Rlist) (EXT y:R | (In y l)) -> (In (MaxRlist l) l).
-Intros; Induction l.
-Simpl in H; Elim H; Trivial.
-Induction l.
-Simpl; Left; Reflexivity.
-Change (In (Rmax r (MaxRlist (cons r0 l))) (cons r (cons r0 l))); Unfold Rmax; Case (total_order_Rle r (MaxRlist (cons r0 l))); Intro.
-Right; Apply Hrecl; Exists r0; Left; Reflexivity.
-Left; Reflexivity.
-Qed.
-
-Fixpoint pos_Rl [l:Rlist] : nat->R :=
-[i:nat] Cases l of
-| nil => R0
-| (cons a l') =>
- Cases i of
- | O => a
- | (S i') => (pos_Rl l' i')
- end
-end.
-
-Lemma pos_Rl_P1 : (l:Rlist;a:R) (lt O (Rlength l)) -> (pos_Rl (cons a l) (Rlength l))==(pos_Rl l (pred (Rlength l))).
-Intros; Induction l; [Elim (lt_n_O ? H) | Simpl; Case (Rlength l); [Reflexivity | Intro; Reflexivity]].
-Qed.
-
-Lemma pos_Rl_P2 : (l:Rlist;x:R) (In x l)<->(EX i:nat | (lt i (Rlength l))/\x==(pos_Rl l i)).
-Intros; Induction l.
-Split; Intro; [Elim H | Elim H; Intros; Elim H0; Intros; Elim (lt_n_O ? H1)].
-Split; Intro.
-Elim H; Intro.
-Exists O; Split; [Simpl; Apply lt_O_Sn | Simpl; Apply H0].
-Elim Hrecl; Intros; Assert H3 := (H1 H0); Elim H3; Intros; Elim H4; Intros; Exists (S x0); Split; [Simpl; Apply lt_n_S; Assumption | Simpl; Assumption].
-Elim H; Intros; Elim H0; Intros; Elim (zerop x0); Intro.
-Rewrite a in H2; Simpl in H2; Left; Assumption.
-Right; Elim Hrecl; Intros; Apply H4; Assert H5 : (S (pred x0))=x0.
-Symmetry; Apply S_pred with O; Assumption.
-Exists (pred x0); Split; [Simpl in H1; Apply lt_S_n; Rewrite H5; Assumption | Rewrite <- H5 in H2; Simpl in H2; Assumption].
-Qed.
-
-Lemma Rlist_P1 : (l:Rlist;P:R->R->Prop) ((x:R)(In x l)->(EXT y:R | (P x y))) -> (EXT l':Rlist | (Rlength l)=(Rlength l')/\(i:nat) (lt i (Rlength l))->(P (pos_Rl l i) (pos_Rl l' i))).
-Intros; Induction l.
-Exists nil; Intros; Split; [Reflexivity | Intros; Simpl in H0; Elim (lt_n_O ? H0)].
-Assert H0 : (In r (cons r l)).
-Simpl; Left; Reflexivity.
-Assert H1 := (H ? H0); Assert H2 : (x:R)(In x l)->(EXT y:R | (P x y)).
-Intros; Apply H; Simpl; Right; Assumption.
-Assert H3 := (Hrecl H2); Elim H1; Intros; Elim H3; Intros; Exists (cons x x0); Intros; Elim H5; Clear H5; Intros; Split.
-Simpl; Rewrite H5; Reflexivity.
-Intros; Elim (zerop i); Intro.
-Rewrite a; Simpl; Assumption.
-Assert H8 : i=(S (pred i)).
-Apply S_pred with O; Assumption.
-Rewrite H8; Simpl; Apply H6; Simpl in H7; Apply lt_S_n; Rewrite <- H8; Assumption.
-Qed.
-
-Definition ordered_Rlist [l:Rlist] : Prop := (i:nat) (lt i (pred (Rlength l))) -> (Rle (pos_Rl l i) (pos_Rl l (S i))).
-
-Fixpoint insert [l:Rlist] : R->Rlist :=
-[x:R] Cases l of
-| nil => (cons x nil)
-| (cons a l') =>
- Cases (total_order_Rle a x) of
- | (leftT _) => (cons a (insert l' x))
- | (rightT _) => (cons x l)
- end
-end.
-
-Fixpoint cons_Rlist [l:Rlist] : Rlist->Rlist :=
-[k:Rlist] Cases l of
-| nil => k
-| (cons a l') => (cons a (cons_Rlist l' k)) end.
-
-Fixpoint cons_ORlist [k:Rlist] : Rlist->Rlist :=
-[l:Rlist] Cases k of
-| nil => l
-| (cons a k') => (cons_ORlist k' (insert l a))
-end.
-
-Fixpoint app_Rlist [l:Rlist] : (R->R)->Rlist :=
-[f:R->R] Cases l of
-| nil => nil
-| (cons a l') => (cons (f a) (app_Rlist l' f))
-end.
-
-Fixpoint mid_Rlist [l:Rlist] : R->Rlist :=
-[x:R] Cases l of
-| nil => nil
-| (cons a l') => (cons ``(x+a)/2`` (mid_Rlist l' a))
-end.
-
-Definition Rtail [l:Rlist] : Rlist :=
-Cases l of
-| nil => nil
-| (cons a l') => l'
-end.
-
-Definition FF [l:Rlist;f:R->R] : Rlist :=
-Cases l of
-| nil => nil
-| (cons a l') => (app_Rlist (mid_Rlist l' a) f)
-end.
-
-Lemma RList_P0 : (l:Rlist;a:R) ``(pos_Rl (insert l a) O) == a`` \/ ``(pos_Rl (insert l a) O) == (pos_Rl l O)``.
-Intros; Induction l; [Left; Reflexivity | Simpl; Case (total_order_Rle r a); Intro; [Right; Reflexivity | Left; Reflexivity]].
-Qed.
-
-Lemma RList_P1 : (l:Rlist;a:R) (ordered_Rlist l) -> (ordered_Rlist (insert l a)).
-Intros; Induction l.
-Simpl; Unfold ordered_Rlist; Intros; Simpl in H0; Elim (lt_n_O ? H0).
-Simpl; Case (total_order_Rle r a); Intro.
-Assert H1 : (ordered_Rlist l).
-Unfold ordered_Rlist; Unfold ordered_Rlist in H; Intros; Assert H1 : (lt (S i) (pred (Rlength (cons r l)))); [Simpl; Replace (Rlength l) with (S (pred (Rlength l))); [Apply lt_n_S; Assumption | Symmetry; Apply S_pred with O; Apply neq_O_lt; Red; Intro; Rewrite <- H1 in H0; Simpl in H0; Elim (lt_n_O ? H0)] | Apply (H ? H1)].
-Assert H2 := (Hrecl H1); Unfold ordered_Rlist; Intros; Induction i.
-Simpl; Assert H3 := (RList_P0 l a); Elim H3; Intro.
-Rewrite H4; Assumption.
-Induction l; [Simpl; Assumption | Rewrite H4; Apply (H O); Simpl; Apply lt_O_Sn].
-Simpl; Apply H2; Simpl in H0; Apply lt_S_n; Replace (S (pred (Rlength (insert l a)))) with (Rlength (insert l a)); [Assumption | Apply S_pred with O; Apply neq_O_lt; Red; Intro; Rewrite <- H3 in H0; Elim (lt_n_O ? H0)].
-Unfold ordered_Rlist; Intros; Induction i; [Simpl; Auto with real | Change ``(pos_Rl (cons r l) i)<=(pos_Rl (cons r l) (S i))``; Apply H; Simpl in H0; Simpl; Apply (lt_S_n ? ? H0)].
-Qed.
-
-Lemma RList_P2 : (l1,l2:Rlist) (ordered_Rlist l2) ->(ordered_Rlist (cons_ORlist l1 l2)).
-Induction l1; [Intros; Simpl; Apply H | Intros; Simpl; Apply H; Apply RList_P1; Assumption].
-Qed.
-
-Lemma RList_P3 : (l:Rlist;x:R) (In x l) <-> (EX i:nat | x==(pos_Rl l i)/\(lt i (Rlength l))).
-Intros; Split; Intro; Induction l.
-Elim H.
-Elim H; Intro; [Exists O; Split; [Apply H0 | Simpl; Apply lt_O_Sn] | Elim (Hrecl H0); Intros; Elim H1; Clear H1; Intros; Exists (S x0); Split; [Apply H1 | Simpl; Apply lt_n_S; Assumption]].
-Elim H; Intros; Elim H0; Intros; Elim (lt_n_O ? H2).
-Simpl; Elim H; Intros; Elim H0; Clear H0; Intros; Induction x0; [Left; Apply H0 | Right; Apply Hrecl; Exists x0; Split; [Apply H0 | Simpl in H1; Apply lt_S_n; Assumption]].
-Qed.
-
-Lemma RList_P4 : (l1:Rlist;a:R) (ordered_Rlist (cons a l1)) -> (ordered_Rlist l1).
-Intros; Unfold ordered_Rlist; Intros; Apply (H (S i)); Simpl; Replace (Rlength l1) with (S (pred (Rlength l1))); [Apply lt_n_S; Assumption | Symmetry; Apply S_pred with O; Apply neq_O_lt; Red; Intro; Rewrite <- H1 in H0; Elim (lt_n_O ? H0)].
-Qed.
-
-Lemma RList_P5 : (l:Rlist;x:R) (ordered_Rlist l) -> (In x l) -> ``(pos_Rl l O)<=x``.
-Intros; Induction l; [Elim H0 | Simpl; Elim H0; Intro; [Rewrite H1; Right; Reflexivity | Apply Rle_trans with (pos_Rl l O); [Apply (H O); Simpl; Induction l; [Elim H1 | Simpl; Apply lt_O_Sn] | Apply Hrecl; [EApply RList_P4; Apply H | Assumption]]]].
-Qed.
-
-Lemma RList_P6 : (l:Rlist) (ordered_Rlist l)<->((i,j:nat)(le i j)->(lt j (Rlength l))->``(pos_Rl l i)<=(pos_Rl l j)``).
-Induction l; Split; Intro.
-Intros; Right; Reflexivity.
-Unfold ordered_Rlist; Intros; Simpl in H0; Elim (lt_n_O ? H0).
-Intros; Induction i; [Induction j; [Right; Reflexivity | Simpl; Apply Rle_trans with (pos_Rl r0 O); [Apply (H0 O); Simpl; Simpl in H2; Apply neq_O_lt; Red; Intro; Rewrite <- H3 in H2; Assert H4 := (lt_S_n ? ? H2); Elim (lt_n_O ? H4) | Elim H; Intros; Apply H3; [Apply RList_P4 with r; Assumption | Apply le_O_n | Simpl in H2; Apply lt_S_n; Assumption]]] | Induction j; [Elim (le_Sn_O ? H1) | Simpl; Elim H; Intros; Apply H3; [Apply RList_P4 with r; Assumption | Apply le_S_n; Assumption | Simpl in H2; Apply lt_S_n; Assumption]]].
-Unfold ordered_Rlist; Intros; Apply H0; [Apply le_n_Sn | Simpl; Simpl in H1; Apply lt_n_S; Assumption].
-Qed.
-
-Lemma RList_P7 : (l:Rlist;x:R) (ordered_Rlist l) -> (In x l) -> ``x<=(pos_Rl l (pred (Rlength l)))``.
-Intros; Assert H1 := (RList_P6 l); Elim H1; Intros H2 _; Assert H3 := (H2 H); Clear H1 H2; Assert H1 := (RList_P3 l x); Elim H1; Clear H1; Intros; Assert H4 := (H1 H0); Elim H4; Clear H4; Intros; Elim H4; Clear H4; Intros; Rewrite H4; Assert H6 : (Rlength l)=(S (pred (Rlength l))).
-Apply S_pred with O; Apply neq_O_lt; Red; Intro; Rewrite <- H6 in H5; Elim (lt_n_O ? H5).
-Apply H3; [Rewrite H6 in H5; Apply lt_n_Sm_le; Assumption | Apply lt_pred_n_n; Apply neq_O_lt; Red; Intro; Rewrite <- H7 in H5; Elim (lt_n_O ? H5)].
-Qed.
-
-Lemma RList_P8 : (l:Rlist;a,x:R) (In x (insert l a)) <-> x==a\/(In x l).
-Induction l.
-Intros; Split; Intro; Simpl in H; Apply H.
-Intros; Split; Intro; [Simpl in H0; Generalize H0; Case (total_order_Rle r a); Intros; [Simpl in H1; Elim H1; Intro; [Right; Left; Assumption |Elim (H a x); Intros; Elim (H3 H2); Intro; [Left; Assumption | Right; Right; Assumption]] | Simpl in H1; Decompose [or] H1; [Left; Assumption | Right; Left; Assumption | Right; Right; Assumption]] | Simpl; Case (total_order_Rle r a); Intro; [Simpl in H0; Decompose [or] H0; [Right; Elim (H a x); Intros; Apply H3; Left | Left | Right; Elim (H a x); Intros; Apply H3; Right] | Simpl in H0; Decompose [or] H0; [Left | Right; Left | Right; Right]]; Assumption].
-Qed.
-
-Lemma RList_P9 : (l1,l2:Rlist;x:R) (In x (cons_ORlist l1 l2)) <-> (In x l1)\/(In x l2).
-Induction l1.
-Intros; Split; Intro; [Simpl in H; Right; Assumption | Simpl; Elim H; Intro; [Elim H0 | Assumption]].
-Intros; Split.
-Simpl; Intros; Elim (H (insert l2 r) x); Intros; Assert H3 := (H1 H0); Elim H3; Intro; [Left; Right; Assumption | Elim (RList_P8 l2 r x); Intros H5 _; Assert H6 := (H5 H4); Elim H6; Intro; [Left; Left; Assumption | Right; Assumption]].
-Intro; Simpl; Elim (H (insert l2 r) x); Intros _ H1; Apply H1; Elim H0; Intro; [Elim H2; Intro; [Right; Elim (RList_P8 l2 r x); Intros _ H4; Apply H4; Left; Assumption | Left; Assumption] | Right; Elim (RList_P8 l2 r x); Intros _ H3; Apply H3; Right; Assumption].
-Qed.
-
-Lemma RList_P10 : (l:Rlist;a:R) (Rlength (insert l a))==(S (Rlength l)).
-Intros; Induction l; [Reflexivity | Simpl; Case (total_order_Rle r a); Intro; [Simpl; Rewrite Hrecl; Reflexivity | Reflexivity]].
-Qed.
-
-Lemma RList_P11 : (l1,l2:Rlist) (Rlength (cons_ORlist l1 l2))=(plus (Rlength l1) (Rlength l2)).
-Induction l1; [Intro; Reflexivity | Intros; Simpl; Rewrite (H (insert l2 r)); Rewrite RList_P10; Apply INR_eq; Rewrite S_INR; Do 2 Rewrite plus_INR; Rewrite S_INR; Ring].
-Qed.
-
-Lemma RList_P12 : (l:Rlist;i:nat;f:R->R) (lt i (Rlength l)) -> (pos_Rl (app_Rlist l f) i)==(f (pos_Rl l i)).
-Induction l; [Intros; Elim (lt_n_O ? H) | Intros; Induction i; [Reflexivity | Simpl; Apply H; Apply lt_S_n; Apply H0]].
-Qed.
-
-Lemma RList_P13 : (l:Rlist;i:nat;a:R) (lt i (pred (Rlength l))) -> ``(pos_Rl (mid_Rlist l a) (S i)) == ((pos_Rl l i)+(pos_Rl l (S i)))/2``.
-Induction l.
-Intros; Simpl in H; Elim (lt_n_O ? H).
-Induction r0.
-Intros; Simpl in H0; Elim (lt_n_O ? H0).
-Intros; Simpl in H1; Induction i.
-Reflexivity.
-Change ``(pos_Rl (mid_Rlist (cons r1 r2) r) (S i)) == ((pos_Rl (cons r1 r2) i)+(pos_Rl (cons r1 r2) (S i)))/2``; Apply H0; Simpl; Apply lt_S_n; Assumption.
-Qed.
-
-Lemma RList_P14 : (l:Rlist;a:R) (Rlength (mid_Rlist l a))=(Rlength l).
-Induction l; Intros; [Reflexivity | Simpl; Rewrite (H r); Reflexivity].
-Qed.
-
-Lemma RList_P15 : (l1,l2:Rlist) (ordered_Rlist l1) -> (ordered_Rlist l2) -> (pos_Rl l1 O)==(pos_Rl l2 O) -> (pos_Rl (cons_ORlist l1 l2) O)==(pos_Rl l1 O).
-Intros; Apply Rle_antisym.
-Induction l1; [Simpl; Simpl in H1; Right; Symmetry; Assumption | Elim (RList_P9 (cons r l1) l2 (pos_Rl (cons r l1) (0))); Intros; Assert H4 : (In (pos_Rl (cons r l1) (0)) (cons r l1))\/(In (pos_Rl (cons r l1) (0)) l2); [Left; Left; Reflexivity | Assert H5 := (H3 H4); Apply RList_P5; [Apply RList_P2; Assumption | Assumption]]].
-Induction l1; [Simpl; Simpl in H1; Right; Assumption | Assert H2 : (In (pos_Rl (cons_ORlist (cons r l1) l2) (0)) (cons_ORlist (cons r l1) l2)); [Elim (RList_P3 (cons_ORlist (cons r l1) l2) (pos_Rl (cons_ORlist (cons r l1) l2) (0))); Intros; Apply H3; Exists O; Split; [Reflexivity | Rewrite RList_P11; Simpl; Apply lt_O_Sn] | Elim (RList_P9 (cons r l1) l2 (pos_Rl (cons_ORlist (cons r l1) l2) (0))); Intros; Assert H5 := (H3 H2); Elim H5; Intro; [Apply RList_P5; Assumption | Rewrite H1; Apply RList_P5; Assumption]]].
-Qed.
-
-Lemma RList_P16 : (l1,l2:Rlist) (ordered_Rlist l1) -> (ordered_Rlist l2) -> (pos_Rl l1 (pred (Rlength l1)))==(pos_Rl l2 (pred (Rlength l2))) -> (pos_Rl (cons_ORlist l1 l2) (pred (Rlength (cons_ORlist l1 l2))))==(pos_Rl l1 (pred (Rlength l1))).
-Intros; Apply Rle_antisym.
-Induction l1.
-Simpl; Simpl in H1; Right; Symmetry; Assumption.
-Assert H2 : (In (pos_Rl (cons_ORlist (cons r l1) l2) (pred (Rlength (cons_ORlist (cons r l1) l2)))) (cons_ORlist (cons r l1) l2)); [Elim (RList_P3 (cons_ORlist (cons r l1) l2) (pos_Rl (cons_ORlist (cons r l1) l2) (pred (Rlength (cons_ORlist (cons r l1) l2))))); Intros; Apply H3; Exists (pred (Rlength (cons_ORlist (cons r l1) l2))); Split; [Reflexivity | Rewrite RList_P11; Simpl; Apply lt_n_Sn] | Elim (RList_P9 (cons r l1) l2 (pos_Rl (cons_ORlist (cons r l1) l2) (pred (Rlength (cons_ORlist (cons r l1) l2))))); Intros; Assert H5 := (H3 H2); Elim H5; Intro; [Apply RList_P7; Assumption | Rewrite H1; Apply RList_P7; Assumption]].
-Induction l1.
-Simpl; Simpl in H1; Right; Assumption.
-Elim (RList_P9 (cons r l1) l2 (pos_Rl (cons r l1) (pred (Rlength (cons r l1))))); Intros; Assert H4 : (In (pos_Rl (cons r l1) (pred (Rlength (cons r l1)))) (cons r l1))\/(In (pos_Rl (cons r l1) (pred (Rlength (cons r l1)))) l2); [Left; Change (In (pos_Rl (cons r l1) (Rlength l1)) (cons r l1)); Elim (RList_P3 (cons r l1) (pos_Rl (cons r l1) (Rlength l1))); Intros; Apply H5; Exists (Rlength l1); Split; [Reflexivity | Simpl; Apply lt_n_Sn] | Assert H5 := (H3 H4); Apply RList_P7; [Apply RList_P2; Assumption | Elim (RList_P9 (cons r l1) l2 (pos_Rl (cons r l1) (pred (Rlength (cons r l1))))); Intros; Apply H7; Left; Elim (RList_P3 (cons r l1) (pos_Rl (cons r l1) (pred (Rlength (cons r l1))))); Intros; Apply H9; Exists (pred (Rlength (cons r l1))); Split; [Reflexivity | Simpl; Apply lt_n_Sn]]].
-Qed.
-
-Lemma RList_P17 : (l1:Rlist;x:R;i:nat) (ordered_Rlist l1) -> (In x l1) -> ``(pos_Rl l1 i)<x`` -> (lt i (pred (Rlength l1))) -> ``(pos_Rl l1 (S i))<=x``.
-Induction l1.
-Intros; Elim H0.
-Intros; Induction i.
-Simpl; Elim H1; Intro; [Simpl in H2; Rewrite H4 in H2; Elim (Rlt_antirefl ? H2) | Apply RList_P5; [Apply RList_P4 with r; Assumption | Assumption]].
-Simpl; Simpl in H2; Elim H1; Intro.
-Rewrite H4 in H2; Assert H5 : ``r<=(pos_Rl r0 i)``; [Apply Rle_trans with (pos_Rl r0 O); [Apply (H0 O); Simpl; Simpl in H3; Apply neq_O_lt; Red; Intro; Rewrite <- H5 in H3; Elim (lt_n_O ? H3) | Elim (RList_P6 r0); Intros; Apply H5; [Apply RList_P4 with r; Assumption | Apply le_O_n | Simpl in H3; Apply lt_S_n; Apply lt_trans with (Rlength r0); [Apply H3 | Apply lt_n_Sn]]] | Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H5 H2))].
-Apply H; Try Assumption; [Apply RList_P4 with r; Assumption | Simpl in H3; Apply lt_S_n; Replace (S (pred (Rlength r0))) with (Rlength r0); [Apply H3 | Apply S_pred with O; Apply neq_O_lt; Red; Intro; Rewrite <- H5 in H3; Elim (lt_n_O ? H3)]].
-Qed.
-
-Lemma RList_P18 : (l:Rlist;f:R->R) (Rlength (app_Rlist l f))=(Rlength l).
-Induction l; Intros; [Reflexivity | Simpl; Rewrite H; Reflexivity].
-Qed.
-
-Lemma RList_P19 : (l:Rlist) ~l==nil -> (EXT r:R | (EXT r0:Rlist | l==(cons r r0))).
-Intros; Induction l; [Elim H; Reflexivity | Exists r; Exists l; Reflexivity].
-Qed.
-
-Lemma RList_P20 : (l:Rlist) (le (2) (Rlength l)) -> (EXT r:R | (EXT r1:R | (EXT l':Rlist | l==(cons r (cons r1 l'))))).
-Intros; Induction l; [Simpl in H; Elim (le_Sn_O ? H) | Induction l; [Simpl in H; Elim (le_Sn_O ? (le_S_n ? ? H)) | Exists r; Exists r0; Exists l; Reflexivity]].
-Qed.
-
-Lemma RList_P21 : (l,l':Rlist) l==l' -> (Rtail l)==(Rtail l').
-Intros; Rewrite H; Reflexivity.
-Qed.
-
-Lemma RList_P22 : (l1,l2:Rlist) ~l1==nil -> (pos_Rl (cons_Rlist l1 l2) O)==(pos_Rl l1 O).
-Induction l1; [Intros; Elim H; Reflexivity | Intros; Reflexivity].
-Qed.
-
-Lemma RList_P23 : (l1,l2:Rlist) (Rlength (cons_Rlist l1 l2))==(plus (Rlength l1) (Rlength l2)).
-Induction l1; [Intro; Reflexivity | Intros; Simpl; Rewrite H; Reflexivity].
-Qed.
-
-Lemma RList_P24 : (l1,l2:Rlist) ~l2==nil -> (pos_Rl (cons_Rlist l1 l2) (pred (Rlength (cons_Rlist l1 l2)))) == (pos_Rl l2 (pred (Rlength l2))).
-Induction l1.
-Intros; Reflexivity.
-Intros; Rewrite <- (H l2 H0); Induction l2.
-Elim H0; Reflexivity.
-Do 2 Rewrite RList_P23; Replace (plus (Rlength (cons r r0)) (Rlength (cons r1 l2))) with (S (S (plus (Rlength r0) (Rlength l2)))); [Replace (plus (Rlength r0) (Rlength (cons r1 l2))) with (S (plus (Rlength r0) (Rlength l2))); [Reflexivity | Simpl; Apply INR_eq; Rewrite S_INR; Do 2 Rewrite plus_INR; Rewrite S_INR; Ring] | Simpl; Apply INR_eq; Do 3 Rewrite S_INR; Do 2 Rewrite plus_INR; Rewrite S_INR; Ring].
-Qed.
-
-Lemma RList_P25 : (l1,l2:Rlist) (ordered_Rlist l1) -> (ordered_Rlist l2) -> ``(pos_Rl l1 (pred (Rlength l1)))<=(pos_Rl l2 O)`` -> (ordered_Rlist (cons_Rlist l1 l2)).
-Induction l1.
-Intros; Simpl; Assumption.
-Induction r0.
-Intros; Simpl; Simpl in H2; Unfold ordered_Rlist; Intros; Simpl in H3.
-Induction i.
-Simpl; Assumption.
-Change ``(pos_Rl l2 i)<=(pos_Rl l2 (S i))``; Apply (H1 i); Apply lt_S_n; Replace (S (pred (Rlength l2))) with (Rlength l2); [Assumption | Apply S_pred with O; Apply neq_O_lt; Red; Intro; Rewrite <- H4 in H3; Elim (lt_n_O ? H3)].
-Intros; Clear H; Assert H : (ordered_Rlist (cons_Rlist (cons r1 r2) l2)).
-Apply H0; Try Assumption.
-Apply RList_P4 with r; Assumption.
-Unfold ordered_Rlist; Intros; Simpl in H4; Induction i.
-Simpl; Apply (H1 O); Simpl; Apply lt_O_Sn.
-Change ``(pos_Rl (cons_Rlist (cons r1 r2) l2) i)<=(pos_Rl (cons_Rlist (cons r1 r2) l2) (S i))``; Apply (H i); Simpl; Apply lt_S_n; Assumption.
-Qed.
-
-Lemma RList_P26 : (l1,l2:Rlist;i:nat) (lt i (Rlength l1)) -> (pos_Rl (cons_Rlist l1 l2) i)==(pos_Rl l1 i).
-Induction l1.
-Intros; Elim (lt_n_O ? H).
-Intros; Induction i.
-Apply RList_P22; Discriminate.
-Apply (H l2 i); Simpl in H0; Apply lt_S_n; Assumption.
-Qed.
-
-Lemma RList_P27 : (l1,l2,l3:Rlist) (cons_Rlist l1 (cons_Rlist l2 l3))==(cons_Rlist (cons_Rlist l1 l2) l3).
-Induction l1; Intros; [Reflexivity | Simpl; Rewrite (H l2 l3); Reflexivity].
-Qed.
-
-Lemma RList_P28 : (l:Rlist) (cons_Rlist l nil)==l.
-Induction l; [Reflexivity | Intros; Simpl; Rewrite H; Reflexivity].
-Qed.
-
-Lemma RList_P29 : (l2,l1:Rlist;i:nat) (le (Rlength l1) i) -> (lt i (Rlength (cons_Rlist l1 l2))) -> (pos_Rl (cons_Rlist l1 l2) i)==(pos_Rl l2 (minus i (Rlength l1))).
-Induction l2.
-Intros; Rewrite RList_P28 in H0; Elim (lt_n_n ? (le_lt_trans ? ? ? H H0)).
-Intros; Replace (cons_Rlist l1 (cons r r0)) with (cons_Rlist (cons_Rlist l1 (cons r nil)) r0).
-Inversion H0.
-Rewrite <- minus_n_n; Simpl; Rewrite RList_P26.
-Clear l2 r0 H i H0 H1 H2; Induction l1.
-Reflexivity.
-Simpl; Assumption.
-Rewrite RList_P23; Rewrite plus_sym; Simpl; Apply lt_n_Sn.
-Replace (minus (S m) (Rlength l1)) with (S (minus (S m) (S (Rlength l1)))).
-Rewrite H3; Simpl; Replace (S (Rlength l1)) with (Rlength (cons_Rlist l1 (cons r nil))).
-Apply (H (cons_Rlist l1 (cons r nil)) i).
-Rewrite RList_P23; Rewrite plus_sym; Simpl; Rewrite <- H3; Apply le_n_S; Assumption.
-Repeat Rewrite RList_P23; Simpl; Rewrite RList_P23 in H1; Rewrite plus_sym in H1; Simpl in H1; Rewrite (plus_sym (Rlength l1)); Simpl; Rewrite plus_sym; Apply H1.
-Rewrite RList_P23; Rewrite plus_sym; Reflexivity.
-Change (S (minus m (Rlength l1)))=(minus (S m) (Rlength l1)); Apply minus_Sn_m; Assumption.
-Replace (cons r r0) with (cons_Rlist (cons r nil) r0); [Symmetry; Apply RList_P27 | Reflexivity].
-Qed.
+ | nil : Rlist
+ | cons : R -> Rlist -> Rlist.
+
+Fixpoint In (x:R) (l:Rlist) {struct l} : Prop :=
+ match l with
+ | nil => False
+ | cons a l' => x = a \/ In x l'
+ end.
+
+Fixpoint Rlength (l:Rlist) : nat :=
+ match l with
+ | nil => 0%nat
+ | cons a l' => S (Rlength l')
+ end.
+
+Fixpoint MaxRlist (l:Rlist) : R :=
+ match l with
+ | nil => 0
+ | cons a l1 =>
+ match l1 with
+ | nil => a
+ | cons a' l2 => Rmax a (MaxRlist l1)
+ end
+ end.
+
+Fixpoint MinRlist (l:Rlist) : R :=
+ match l with
+ | nil => 1
+ | cons a l1 =>
+ match l1 with
+ | nil => a
+ | cons a' l2 => Rmin a (MinRlist l1)
+ end
+ end.
+
+Lemma MaxRlist_P1 : forall (l:Rlist) (x:R), In x l -> x <= MaxRlist l.
+intros; induction l as [| r l Hrecl].
+simpl in H; elim H.
+induction l as [| r0 l Hrecl0].
+simpl in H; elim H; intro.
+simpl in |- *; right; assumption.
+elim H0.
+replace (MaxRlist (cons r (cons r0 l))) with (Rmax r (MaxRlist (cons r0 l))).
+simpl in H; decompose [or] H.
+rewrite H0; apply RmaxLess1.
+unfold Rmax in |- *; case (Rle_dec r (MaxRlist (cons r0 l))); intro.
+apply Hrecl; simpl in |- *; tauto.
+apply Rle_trans with (MaxRlist (cons r0 l));
+ [ apply Hrecl; simpl in |- *; tauto | left; auto with real ].
+unfold Rmax in |- *; case (Rle_dec r (MaxRlist (cons r0 l))); intro.
+apply Hrecl; simpl in |- *; tauto.
+apply Rle_trans with (MaxRlist (cons r0 l));
+ [ apply Hrecl; simpl in |- *; tauto | left; auto with real ].
+reflexivity.
+Qed.
+
+Fixpoint AbsList (l:Rlist) (x:R) {struct l} : Rlist :=
+ match l with
+ | nil => nil
+ | cons a l' => cons (Rabs (a - x) / 2) (AbsList l' x)
+ end.
+
+Lemma MinRlist_P1 : forall (l:Rlist) (x:R), In x l -> MinRlist l <= x.
+intros; induction l as [| r l Hrecl].
+simpl in H; elim H.
+induction l as [| r0 l Hrecl0].
+simpl in H; elim H; intro.
+simpl in |- *; right; symmetry in |- *; assumption.
+elim H0.
+replace (MinRlist (cons r (cons r0 l))) with (Rmin r (MinRlist (cons r0 l))).
+simpl in H; decompose [or] H.
+rewrite H0; apply Rmin_l.
+unfold Rmin in |- *; case (Rle_dec r (MinRlist (cons r0 l))); intro.
+apply Rle_trans with (MinRlist (cons r0 l)).
+assumption.
+apply Hrecl; simpl in |- *; tauto.
+apply Hrecl; simpl in |- *; tauto.
+apply Rle_trans with (MinRlist (cons r0 l)).
+apply Rmin_r.
+apply Hrecl; simpl in |- *; tauto.
+reflexivity.
+Qed.
+
+Lemma AbsList_P1 :
+ forall (l:Rlist) (x y:R), In y l -> In (Rabs (y - x) / 2) (AbsList l x).
+intros; induction l as [| r l Hrecl].
+elim H.
+simpl in |- *; simpl in H; elim H; intro.
+left; rewrite H0; reflexivity.
+right; apply Hrecl; assumption.
+Qed.
+
+Lemma MinRlist_P2 :
+ forall l:Rlist, (forall y:R, In y l -> 0 < y) -> 0 < MinRlist l.
+intros; induction l as [| r l Hrecl].
+apply Rlt_0_1.
+induction l as [| r0 l Hrecl0].
+simpl in |- *; apply H; simpl in |- *; tauto.
+replace (MinRlist (cons r (cons r0 l))) with (Rmin r (MinRlist (cons r0 l))).
+unfold Rmin in |- *; case (Rle_dec r (MinRlist (cons r0 l))); intro.
+apply H; simpl in |- *; tauto.
+apply Hrecl; intros; apply H; simpl in |- *; simpl in H0; tauto.
+reflexivity.
+Qed.
+
+Lemma AbsList_P2 :
+ forall (l:Rlist) (x y:R),
+ In y (AbsList l x) -> exists z : R | In z l /\ y = Rabs (z - x) / 2.
+intros; induction l as [| r l Hrecl].
+elim H.
+elim H; intro.
+exists r; split.
+simpl in |- *; tauto.
+assumption.
+assert (H1 := Hrecl H0); elim H1; intros; elim H2; clear H2; intros;
+ exists x0; simpl in |- *; simpl in H2; tauto.
+Qed.
+
+Lemma MaxRlist_P2 :
+ forall l:Rlist, ( exists y : R | In y l) -> In (MaxRlist l) l.
+intros; induction l as [| r l Hrecl].
+simpl in H; elim H; trivial.
+induction l as [| r0 l Hrecl0].
+simpl in |- *; left; reflexivity.
+change (In (Rmax r (MaxRlist (cons r0 l))) (cons r (cons r0 l))) in |- *;
+ unfold Rmax in |- *; case (Rle_dec r (MaxRlist (cons r0 l)));
+ intro.
+right; apply Hrecl; exists r0; left; reflexivity.
+left; reflexivity.
+Qed.
+
+Fixpoint pos_Rl (l:Rlist) (i:nat) {struct l} : R :=
+ match l with
+ | nil => 0
+ | cons a l' => match i with
+ | O => a
+ | S i' => pos_Rl l' i'
+ end
+ end.
+
+Lemma pos_Rl_P1 :
+ forall (l:Rlist) (a:R),
+ (0 < Rlength l)%nat ->
+ pos_Rl (cons a l) (Rlength l) = pos_Rl l (pred (Rlength l)).
+intros; induction l as [| r l Hrecl];
+ [ elim (lt_n_O _ H)
+ | simpl in |- *; case (Rlength l); [ reflexivity | intro; reflexivity ] ].
+Qed.
+
+Lemma pos_Rl_P2 :
+ forall (l:Rlist) (x:R),
+ In x l <-> ( exists i : nat | (i < Rlength l)%nat /\ x = pos_Rl l i).
+intros; induction l as [| r l Hrecl].
+split; intro;
+ [ elim H | elim H; intros; elim H0; intros; elim (lt_n_O _ H1) ].
+split; intro.
+elim H; intro.
+exists 0%nat; split;
+ [ simpl in |- *; apply lt_O_Sn | simpl in |- *; apply H0 ].
+elim Hrecl; intros; assert (H3 := H1 H0); elim H3; intros; elim H4; intros;
+ exists (S x0); split;
+ [ simpl in |- *; apply lt_n_S; assumption | simpl in |- *; assumption ].
+elim H; intros; elim H0; intros; elim (zerop x0); intro.
+rewrite a in H2; simpl in H2; left; assumption.
+right; elim Hrecl; intros; apply H4; assert (H5 : S (pred x0) = x0).
+symmetry in |- *; apply S_pred with 0%nat; assumption.
+exists (pred x0); split;
+ [ simpl in H1; apply lt_S_n; rewrite H5; assumption
+ | rewrite <- H5 in H2; simpl in H2; assumption ].
+Qed.
+
+Lemma Rlist_P1 :
+ forall (l:Rlist) (P:R -> R -> Prop),
+ (forall x:R, In x l -> exists y : R | P x y) ->
+ exists l' : Rlist
+ | Rlength l = Rlength l' /\
+ (forall i:nat, (i < Rlength l)%nat -> P (pos_Rl l i) (pos_Rl l' i)).
+intros; induction l as [| r l Hrecl].
+exists nil; intros; split;
+ [ reflexivity | intros; simpl in H0; elim (lt_n_O _ H0) ].
+assert (H0 : In r (cons r l)).
+simpl in |- *; left; reflexivity.
+assert (H1 := H _ H0);
+ assert (H2 : forall x:R, In x l -> exists y : R | P x y).
+intros; apply H; simpl in |- *; right; assumption.
+assert (H3 := Hrecl H2); elim H1; intros; elim H3; intros; exists (cons x x0);
+ intros; elim H5; clear H5; intros; split.
+simpl in |- *; rewrite H5; reflexivity.
+intros; elim (zerop i); intro.
+rewrite a; simpl in |- *; assumption.
+assert (H8 : i = S (pred i)).
+apply S_pred with 0%nat; assumption.
+rewrite H8; simpl in |- *; apply H6; simpl in H7; apply lt_S_n; rewrite <- H8;
+ assumption.
+Qed.
+
+Definition ordered_Rlist (l:Rlist) : Prop :=
+ forall i:nat, (i < pred (Rlength l))%nat -> pos_Rl l i <= pos_Rl l (S i).
+
+Fixpoint insert (l:Rlist) (x:R) {struct l} : Rlist :=
+ match l with
+ | nil => cons x nil
+ | cons a l' =>
+ match Rle_dec a x with
+ | left _ => cons a (insert l' x)
+ | right _ => cons x l
+ end
+ end.
+
+Fixpoint cons_Rlist (l k:Rlist) {struct l} : Rlist :=
+ match l with
+ | nil => k
+ | cons a l' => cons a (cons_Rlist l' k)
+ end.
+
+Fixpoint cons_ORlist (k l:Rlist) {struct k} : Rlist :=
+ match k with
+ | nil => l
+ | cons a k' => cons_ORlist k' (insert l a)
+ end.
+
+Fixpoint app_Rlist (l:Rlist) (f:R -> R) {struct l} : Rlist :=
+ match l with
+ | nil => nil
+ | cons a l' => cons (f a) (app_Rlist l' f)
+ end.
+
+Fixpoint mid_Rlist (l:Rlist) (x:R) {struct l} : Rlist :=
+ match l with
+ | nil => nil
+ | cons a l' => cons ((x + a) / 2) (mid_Rlist l' a)
+ end.
+
+Definition Rtail (l:Rlist) : Rlist :=
+ match l with
+ | nil => nil
+ | cons a l' => l'
+ end.
+
+Definition FF (l:Rlist) (f:R -> R) : Rlist :=
+ match l with
+ | nil => nil
+ | cons a l' => app_Rlist (mid_Rlist l' a) f
+ end.
+
+Lemma RList_P0 :
+ forall (l:Rlist) (a:R),
+ pos_Rl (insert l a) 0 = a \/ pos_Rl (insert l a) 0 = pos_Rl l 0.
+intros; induction l as [| r l Hrecl];
+ [ left; reflexivity
+ | simpl in |- *; case (Rle_dec r a); intro;
+ [ right; reflexivity | left; reflexivity ] ].
+Qed.
+
+Lemma RList_P1 :
+ forall (l:Rlist) (a:R), ordered_Rlist l -> ordered_Rlist (insert l a).
+intros; induction l as [| r l Hrecl].
+simpl in |- *; unfold ordered_Rlist in |- *; intros; simpl in H0;
+ elim (lt_n_O _ H0).
+simpl in |- *; case (Rle_dec r a); intro.
+assert (H1 : ordered_Rlist l).
+unfold ordered_Rlist in |- *; unfold ordered_Rlist in H; intros;
+ assert (H1 : (S i < pred (Rlength (cons r l)))%nat);
+ [ simpl in |- *; replace (Rlength l) with (S (pred (Rlength l)));
+ [ apply lt_n_S; assumption
+ | symmetry in |- *; apply S_pred with 0%nat; apply neq_O_lt; red in |- *;
+ intro; rewrite <- H1 in H0; simpl in H0; elim (lt_n_O _ H0) ]
+ | apply (H _ H1) ].
+assert (H2 := Hrecl H1); unfold ordered_Rlist in |- *; intros;
+ induction i as [| i Hreci].
+simpl in |- *; assert (H3 := RList_P0 l a); elim H3; intro.
+rewrite H4; assumption.
+induction l as [| r1 l Hrecl0];
+ [ simpl in |- *; assumption
+ | rewrite H4; apply (H 0%nat); simpl in |- *; apply lt_O_Sn ].
+simpl in |- *; apply H2; simpl in H0; apply lt_S_n;
+ replace (S (pred (Rlength (insert l a)))) with (Rlength (insert l a));
+ [ assumption
+ | apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro;
+ rewrite <- H3 in H0; elim (lt_n_O _ H0) ].
+unfold ordered_Rlist in |- *; intros; induction i as [| i Hreci];
+ [ simpl in |- *; auto with real
+ | change (pos_Rl (cons r l) i <= pos_Rl (cons r l) (S i)) in |- *; apply H;
+ simpl in H0; simpl in |- *; apply (lt_S_n _ _ H0) ].
+Qed.
+
+Lemma RList_P2 :
+ forall l1 l2:Rlist, ordered_Rlist l2 -> ordered_Rlist (cons_ORlist l1 l2).
+simple induction l1;
+ [ intros; simpl in |- *; apply H
+ | intros; simpl in |- *; apply H; apply RList_P1; assumption ].
+Qed.
+
+Lemma RList_P3 :
+ forall (l:Rlist) (x:R),
+ In x l <-> ( exists i : nat | x = pos_Rl l i /\ (i < Rlength l)%nat).
+intros; split; intro;
+ [ induction l as [| r l Hrecl] | induction l as [| r l Hrecl] ].
+elim H.
+elim H; intro;
+ [ exists 0%nat; split; [ apply H0 | simpl in |- *; apply lt_O_Sn ]
+ | elim (Hrecl H0); intros; elim H1; clear H1; intros; exists (S x0); split;
+ [ apply H1 | simpl in |- *; apply lt_n_S; assumption ] ].
+elim H; intros; elim H0; intros; elim (lt_n_O _ H2).
+simpl in |- *; elim H; intros; elim H0; clear H0; intros;
+ induction x0 as [| x0 Hrecx0];
+ [ left; apply H0
+ | right; apply Hrecl; exists x0; split;
+ [ apply H0 | simpl in H1; apply lt_S_n; assumption ] ].
+Qed.
+
+Lemma RList_P4 :
+ forall (l1:Rlist) (a:R), ordered_Rlist (cons a l1) -> ordered_Rlist l1.
+intros; unfold ordered_Rlist in |- *; intros; apply (H (S i)); simpl in |- *;
+ replace (Rlength l1) with (S (pred (Rlength l1)));
+ [ apply lt_n_S; assumption
+ | symmetry in |- *; apply S_pred with 0%nat; apply neq_O_lt; red in |- *;
+ intro; rewrite <- H1 in H0; elim (lt_n_O _ H0) ].
+Qed.
+
+Lemma RList_P5 :
+ forall (l:Rlist) (x:R), ordered_Rlist l -> In x l -> pos_Rl l 0 <= x.
+intros; induction l as [| r l Hrecl];
+ [ elim H0
+ | simpl in |- *; elim H0; intro;
+ [ rewrite H1; right; reflexivity
+ | apply Rle_trans with (pos_Rl l 0);
+ [ apply (H 0%nat); simpl in |- *; induction l as [| r0 l Hrecl0];
+ [ elim H1 | simpl in |- *; apply lt_O_Sn ]
+ | apply Hrecl; [ eapply RList_P4; apply H | assumption ] ] ] ].
+Qed.
+
+Lemma RList_P6 :
+ forall l:Rlist,
+ ordered_Rlist l <->
+ (forall i j:nat,
+ (i <= j)%nat -> (j < Rlength l)%nat -> pos_Rl l i <= pos_Rl l j).
+simple induction l; split; intro.
+intros; right; reflexivity.
+unfold ordered_Rlist in |- *; intros; simpl in H0; elim (lt_n_O _ H0).
+intros; induction i as [| i Hreci];
+ [ induction j as [| j Hrecj];
+ [ right; reflexivity
+ | simpl in |- *; apply Rle_trans with (pos_Rl r0 0);
+ [ apply (H0 0%nat); simpl in |- *; simpl in H2; apply neq_O_lt;
+ red in |- *; intro; rewrite <- H3 in H2;
+ assert (H4 := lt_S_n _ _ H2); elim (lt_n_O _ H4)
+ | elim H; intros; apply H3;
+ [ apply RList_P4 with r; assumption
+ | apply le_O_n
+ | simpl in H2; apply lt_S_n; assumption ] ] ]
+ | induction j as [| j Hrecj];
+ [ elim (le_Sn_O _ H1)
+ | simpl in |- *; elim H; intros; apply H3;
+ [ apply RList_P4 with r; assumption
+ | apply le_S_n; assumption
+ | simpl in H2; apply lt_S_n; assumption ] ] ].
+unfold ordered_Rlist in |- *; intros; apply H0;
+ [ apply le_n_Sn | simpl in |- *; simpl in H1; apply lt_n_S; assumption ].
+Qed.
+
+Lemma RList_P7 :
+ forall (l:Rlist) (x:R),
+ ordered_Rlist l -> In x l -> x <= pos_Rl l (pred (Rlength l)).
+intros; assert (H1 := RList_P6 l); elim H1; intros H2 _; assert (H3 := H2 H);
+ clear H1 H2; assert (H1 := RList_P3 l x); elim H1;
+ clear H1; intros; assert (H4 := H1 H0); elim H4; clear H4;
+ intros; elim H4; clear H4; intros; rewrite H4;
+ assert (H6 : Rlength l = S (pred (Rlength l))).
+apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro;
+ rewrite <- H6 in H5; elim (lt_n_O _ H5).
+apply H3;
+ [ rewrite H6 in H5; apply lt_n_Sm_le; assumption
+ | apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H7 in H5;
+ elim (lt_n_O _ H5) ].
+Qed.
+
+Lemma RList_P8 :
+ forall (l:Rlist) (a x:R), In x (insert l a) <-> x = a \/ In x l.
+simple induction l.
+intros; split; intro; simpl in H; apply H.
+intros; split; intro;
+ [ simpl in H0; generalize H0; case (Rle_dec r a); intros;
+ [ simpl in H1; elim H1; intro;
+ [ right; left; assumption
+ | elim (H a x); intros; elim (H3 H2); intro;
+ [ left; assumption | right; right; assumption ] ]
+ | simpl in H1; decompose [or] H1;
+ [ left; assumption
+ | right; left; assumption
+ | right; right; assumption ] ]
+ | simpl in |- *; case (Rle_dec r a); intro;
+ [ simpl in H0; decompose [or] H0;
+ [ right; elim (H a x); intros; apply H3; left
+ | left
+ | right; elim (H a x); intros; apply H3; right ]
+ | simpl in H0; decompose [or] H0; [ left | right; left | right; right ] ];
+ assumption ].
+Qed.
+
+Lemma RList_P9 :
+ forall (l1 l2:Rlist) (x:R), In x (cons_ORlist l1 l2) <-> In x l1 \/ In x l2.
+simple induction l1.
+intros; split; intro;
+ [ simpl in H; right; assumption
+ | simpl in |- *; elim H; intro; [ elim H0 | assumption ] ].
+intros; split.
+simpl in |- *; intros; elim (H (insert l2 r) x); intros; assert (H3 := H1 H0);
+ elim H3; intro;
+ [ left; right; assumption
+ | elim (RList_P8 l2 r x); intros H5 _; assert (H6 := H5 H4); elim H6; intro;
+ [ left; left; assumption | right; assumption ] ].
+intro; simpl in |- *; elim (H (insert l2 r) x); intros _ H1; apply H1;
+ elim H0; intro;
+ [ elim H2; intro;
+ [ right; elim (RList_P8 l2 r x); intros _ H4; apply H4; left; assumption
+ | left; assumption ]
+ | right; elim (RList_P8 l2 r x); intros _ H3; apply H3; right; assumption ].
+Qed.
+
+Lemma RList_P10 :
+ forall (l:Rlist) (a:R), Rlength (insert l a) = S (Rlength l).
+intros; induction l as [| r l Hrecl];
+ [ reflexivity
+ | simpl in |- *; case (Rle_dec r a); intro;
+ [ simpl in |- *; rewrite Hrecl; reflexivity | reflexivity ] ].
+Qed.
+
+Lemma RList_P11 :
+ forall l1 l2:Rlist,
+ Rlength (cons_ORlist l1 l2) = (Rlength l1 + Rlength l2)%nat.
+simple induction l1;
+ [ intro; reflexivity
+ | intros; simpl in |- *; rewrite (H (insert l2 r)); rewrite RList_P10;
+ apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR;
+ rewrite S_INR; ring ].
+Qed.
+
+Lemma RList_P12 :
+ forall (l:Rlist) (i:nat) (f:R -> R),
+ (i < Rlength l)%nat -> pos_Rl (app_Rlist l f) i = f (pos_Rl l i).
+simple induction l;
+ [ intros; elim (lt_n_O _ H)
+ | intros; induction i as [| i Hreci];
+ [ reflexivity | simpl in |- *; apply H; apply lt_S_n; apply H0 ] ].
+Qed.
+
+Lemma RList_P13 :
+ forall (l:Rlist) (i:nat) (a:R),
+ (i < pred (Rlength l))%nat ->
+ pos_Rl (mid_Rlist l a) (S i) = (pos_Rl l i + pos_Rl l (S i)) / 2.
+simple induction l.
+intros; simpl in H; elim (lt_n_O _ H).
+simple induction r0.
+intros; simpl in H0; elim (lt_n_O _ H0).
+intros; simpl in H1; induction i as [| i Hreci].
+reflexivity.
+change
+ (pos_Rl (mid_Rlist (cons r1 r2) r) (S i) =
+ (pos_Rl (cons r1 r2) i + pos_Rl (cons r1 r2) (S i)) / 2)
+ in |- *; apply H0; simpl in |- *; apply lt_S_n; assumption.
+Qed.
+
+Lemma RList_P14 : forall (l:Rlist) (a:R), Rlength (mid_Rlist l a) = Rlength l.
+simple induction l; intros;
+ [ reflexivity | simpl in |- *; rewrite (H r); reflexivity ].
+Qed.
+
+Lemma RList_P15 :
+ forall l1 l2:Rlist,
+ ordered_Rlist l1 ->
+ ordered_Rlist l2 ->
+ pos_Rl l1 0 = pos_Rl l2 0 -> pos_Rl (cons_ORlist l1 l2) 0 = pos_Rl l1 0.
+intros; apply Rle_antisym.
+induction l1 as [| r l1 Hrecl1];
+ [ simpl in |- *; simpl in H1; right; symmetry in |- *; assumption
+ | elim (RList_P9 (cons r l1) l2 (pos_Rl (cons r l1) 0)); intros;
+ assert
+ (H4 :
+ In (pos_Rl (cons r l1) 0) (cons r l1) \/ In (pos_Rl (cons r l1) 0) l2);
+ [ left; left; reflexivity
+ | assert (H5 := H3 H4); apply RList_P5;
+ [ apply RList_P2; assumption | assumption ] ] ].
+induction l1 as [| r l1 Hrecl1];
+ [ simpl in |- *; simpl in H1; right; assumption
+ | assert
+ (H2 :
+ In (pos_Rl (cons_ORlist (cons r l1) l2) 0) (cons_ORlist (cons r l1) l2));
+ [ elim
+ (RList_P3 (cons_ORlist (cons r l1) l2)
+ (pos_Rl (cons_ORlist (cons r l1) l2) 0));
+ intros; apply H3; exists 0%nat; split;
+ [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_O_Sn ]
+ | elim (RList_P9 (cons r l1) l2 (pos_Rl (cons_ORlist (cons r l1) l2) 0));
+ intros; assert (H5 := H3 H2); elim H5; intro;
+ [ apply RList_P5; assumption
+ | rewrite H1; apply RList_P5; assumption ] ] ].
+Qed.
+
+Lemma RList_P16 :
+ forall l1 l2:Rlist,
+ ordered_Rlist l1 ->
+ ordered_Rlist l2 ->
+ pos_Rl l1 (pred (Rlength l1)) = pos_Rl l2 (pred (Rlength l2)) ->
+ pos_Rl (cons_ORlist l1 l2) (pred (Rlength (cons_ORlist l1 l2))) =
+ pos_Rl l1 (pred (Rlength l1)).
+intros; apply Rle_antisym.
+induction l1 as [| r l1 Hrecl1].
+simpl in |- *; simpl in H1; right; symmetry in |- *; assumption.
+assert
+ (H2 :
+ In
+ (pos_Rl (cons_ORlist (cons r l1) l2)
+ (pred (Rlength (cons_ORlist (cons r l1) l2))))
+ (cons_ORlist (cons r l1) l2));
+ [ elim
+ (RList_P3 (cons_ORlist (cons r l1) l2)
+ (pos_Rl (cons_ORlist (cons r l1) l2)
+ (pred (Rlength (cons_ORlist (cons r l1) l2)))));
+ intros; apply H3; exists (pred (Rlength (cons_ORlist (cons r l1) l2)));
+ split; [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_n_Sn ]
+ | elim
+ (RList_P9 (cons r l1) l2
+ (pos_Rl (cons_ORlist (cons r l1) l2)
+ (pred (Rlength (cons_ORlist (cons r l1) l2)))));
+ intros; assert (H5 := H3 H2); elim H5; intro;
+ [ apply RList_P7; assumption | rewrite H1; apply RList_P7; assumption ] ].
+induction l1 as [| r l1 Hrecl1].
+simpl in |- *; simpl in H1; right; assumption.
+elim
+ (RList_P9 (cons r l1) l2 (pos_Rl (cons r l1) (pred (Rlength (cons r l1)))));
+ intros;
+ assert
+ (H4 :
+ In (pos_Rl (cons r l1) (pred (Rlength (cons r l1)))) (cons r l1) \/
+ In (pos_Rl (cons r l1) (pred (Rlength (cons r l1)))) l2);
+ [ left; change (In (pos_Rl (cons r l1) (Rlength l1)) (cons r l1)) in |- *;
+ elim (RList_P3 (cons r l1) (pos_Rl (cons r l1) (Rlength l1)));
+ intros; apply H5; exists (Rlength l1); split;
+ [ reflexivity | simpl in |- *; apply lt_n_Sn ]
+ | assert (H5 := H3 H4); apply RList_P7;
+ [ apply RList_P2; assumption
+ | elim
+ (RList_P9 (cons r l1) l2
+ (pos_Rl (cons r l1) (pred (Rlength (cons r l1)))));
+ intros; apply H7; left;
+ elim
+ (RList_P3 (cons r l1)
+ (pos_Rl (cons r l1) (pred (Rlength (cons r l1)))));
+ intros; apply H9; exists (pred (Rlength (cons r l1)));
+ split; [ reflexivity | simpl in |- *; apply lt_n_Sn ] ] ].
+Qed.
+
+Lemma RList_P17 :
+ forall (l1:Rlist) (x:R) (i:nat),
+ ordered_Rlist l1 ->
+ In x l1 ->
+ pos_Rl l1 i < x -> (i < pred (Rlength l1))%nat -> pos_Rl l1 (S i) <= x.
+simple induction l1.
+intros; elim H0.
+intros; induction i as [| i Hreci].
+simpl in |- *; elim H1; intro;
+ [ simpl in H2; rewrite H4 in H2; elim (Rlt_irrefl _ H2)
+ | apply RList_P5; [ apply RList_P4 with r; assumption | assumption ] ].
+simpl in |- *; simpl in H2; elim H1; intro.
+rewrite H4 in H2; assert (H5 : r <= pos_Rl r0 i);
+ [ apply Rle_trans with (pos_Rl r0 0);
+ [ apply (H0 0%nat); simpl in |- *; simpl in H3; apply neq_O_lt;
+ red in |- *; intro; rewrite <- H5 in H3; elim (lt_n_O _ H3)
+ | elim (RList_P6 r0); intros; apply H5;
+ [ apply RList_P4 with r; assumption
+ | apply le_O_n
+ | simpl in H3; apply lt_S_n; apply lt_trans with (Rlength r0);
+ [ apply H3 | apply lt_n_Sn ] ] ]
+ | elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H5 H2)) ].
+apply H; try assumption;
+ [ apply RList_P4 with r; assumption
+ | simpl in H3; apply lt_S_n;
+ replace (S (pred (Rlength r0))) with (Rlength r0);
+ [ apply H3
+ | apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro;
+ rewrite <- H5 in H3; elim (lt_n_O _ H3) ] ].
+Qed.
+
+Lemma RList_P18 :
+ forall (l:Rlist) (f:R -> R), Rlength (app_Rlist l f) = Rlength l.
+simple induction l; intros;
+ [ reflexivity | simpl in |- *; rewrite H; reflexivity ].
+Qed.
+
+Lemma RList_P19 :
+ forall l:Rlist,
+ l <> nil -> exists r : R | ( exists r0 : Rlist | l = cons r r0).
+intros; induction l as [| r l Hrecl];
+ [ elim H; reflexivity | exists r; exists l; reflexivity ].
+Qed.
+
+Lemma RList_P20 :
+ forall l:Rlist,
+ (2 <= Rlength l)%nat ->
+ exists r : R
+ | ( exists r1 : R | ( exists l' : Rlist | l = cons r (cons r1 l'))).
+intros; induction l as [| r l Hrecl];
+ [ simpl in H; elim (le_Sn_O _ H)
+ | induction l as [| r0 l Hrecl0];
+ [ simpl in H; elim (le_Sn_O _ (le_S_n _ _ H))
+ | exists r; exists r0; exists l; reflexivity ] ].
+Qed.
+
+Lemma RList_P21 : forall l l':Rlist, l = l' -> Rtail l = Rtail l'.
+intros; rewrite H; reflexivity.
+Qed.
+
+Lemma RList_P22 :
+ forall l1 l2:Rlist, l1 <> nil -> pos_Rl (cons_Rlist l1 l2) 0 = pos_Rl l1 0.
+simple induction l1; [ intros; elim H; reflexivity | intros; reflexivity ].
+Qed.
+
+Lemma RList_P23 :
+ forall l1 l2:Rlist,
+ Rlength (cons_Rlist l1 l2) = (Rlength l1 + Rlength l2)%nat.
+simple induction l1;
+ [ intro; reflexivity | intros; simpl in |- *; rewrite H; reflexivity ].
+Qed.
+
+Lemma RList_P24 :
+ forall l1 l2:Rlist,
+ l2 <> nil ->
+ pos_Rl (cons_Rlist l1 l2) (pred (Rlength (cons_Rlist l1 l2))) =
+ pos_Rl l2 (pred (Rlength l2)).
+simple induction l1.
+intros; reflexivity.
+intros; rewrite <- (H l2 H0); induction l2 as [| r1 l2 Hrecl2].
+elim H0; reflexivity.
+do 2 rewrite RList_P23;
+ replace (Rlength (cons r r0) + Rlength (cons r1 l2))%nat with
+ (S (S (Rlength r0 + Rlength l2)));
+ [ replace (Rlength r0 + Rlength (cons r1 l2))%nat with
+ (S (Rlength r0 + Rlength l2));
+ [ reflexivity
+ | simpl in |- *; apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR;
+ rewrite S_INR; ring ]
+ | simpl in |- *; apply INR_eq; do 3 rewrite S_INR; do 2 rewrite plus_INR;
+ rewrite S_INR; ring ].
+Qed.
+
+Lemma RList_P25 :
+ forall l1 l2:Rlist,
+ ordered_Rlist l1 ->
+ ordered_Rlist l2 ->
+ pos_Rl l1 (pred (Rlength l1)) <= pos_Rl l2 0 ->
+ ordered_Rlist (cons_Rlist l1 l2).
+simple induction l1.
+intros; simpl in |- *; assumption.
+simple induction r0.
+intros; simpl in |- *; simpl in H2; unfold ordered_Rlist in |- *; intros;
+ simpl in H3.
+induction i as [| i Hreci].
+simpl in |- *; assumption.
+change (pos_Rl l2 i <= pos_Rl l2 (S i)) in |- *; apply (H1 i); apply lt_S_n;
+ replace (S (pred (Rlength l2))) with (Rlength l2);
+ [ assumption
+ | apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro;
+ rewrite <- H4 in H3; elim (lt_n_O _ H3) ].
+intros; clear H; assert (H : ordered_Rlist (cons_Rlist (cons r1 r2) l2)).
+apply H0; try assumption.
+apply RList_P4 with r; assumption.
+unfold ordered_Rlist in |- *; intros; simpl in H4;
+ induction i as [| i Hreci].
+simpl in |- *; apply (H1 0%nat); simpl in |- *; apply lt_O_Sn.
+change
+ (pos_Rl (cons_Rlist (cons r1 r2) l2) i <=
+ pos_Rl (cons_Rlist (cons r1 r2) l2) (S i)) in |- *;
+ apply (H i); simpl in |- *; apply lt_S_n; assumption.
+Qed.
+
+Lemma RList_P26 :
+ forall (l1 l2:Rlist) (i:nat),
+ (i < Rlength l1)%nat -> pos_Rl (cons_Rlist l1 l2) i = pos_Rl l1 i.
+simple induction l1.
+intros; elim (lt_n_O _ H).
+intros; induction i as [| i Hreci].
+apply RList_P22; discriminate.
+apply (H l2 i); simpl in H0; apply lt_S_n; assumption.
+Qed.
+
+Lemma RList_P27 :
+ forall l1 l2 l3:Rlist,
+ cons_Rlist l1 (cons_Rlist l2 l3) = cons_Rlist (cons_Rlist l1 l2) l3.
+simple induction l1; intros;
+ [ reflexivity | simpl in |- *; rewrite (H l2 l3); reflexivity ].
+Qed.
+
+Lemma RList_P28 : forall l:Rlist, cons_Rlist l nil = l.
+simple induction l;
+ [ reflexivity | intros; simpl in |- *; rewrite H; reflexivity ].
+Qed.
+
+Lemma RList_P29 :
+ forall (l2 l1:Rlist) (i:nat),
+ (Rlength l1 <= i)%nat ->
+ (i < Rlength (cons_Rlist l1 l2))%nat ->
+ pos_Rl (cons_Rlist l1 l2) i = pos_Rl l2 (i - Rlength l1).
+simple induction l2.
+intros; rewrite RList_P28 in H0; elim (lt_irrefl _ (le_lt_trans _ _ _ H H0)).
+intros;
+ replace (cons_Rlist l1 (cons r r0)) with
+ (cons_Rlist (cons_Rlist l1 (cons r nil)) r0).
+inversion H0.
+rewrite <- minus_n_n; simpl in |- *; rewrite RList_P26.
+clear l2 r0 H i H0 H1 H2; induction l1 as [| r0 l1 Hrecl1].
+reflexivity.
+simpl in |- *; assumption.
+rewrite RList_P23; rewrite plus_comm; simpl in |- *; apply lt_n_Sn.
+replace (S m - Rlength l1)%nat with (S (S m - S (Rlength l1))).
+rewrite H3; simpl in |- *;
+ replace (S (Rlength l1)) with (Rlength (cons_Rlist l1 (cons r nil))).
+apply (H (cons_Rlist l1 (cons r nil)) i).
+rewrite RList_P23; rewrite plus_comm; simpl in |- *; rewrite <- H3;
+ apply le_n_S; assumption.
+repeat rewrite RList_P23; simpl in |- *; rewrite RList_P23 in H1;
+ rewrite plus_comm in H1; simpl in H1; rewrite (plus_comm (Rlength l1));
+ simpl in |- *; rewrite plus_comm; apply H1.
+rewrite RList_P23; rewrite plus_comm; reflexivity.
+change (S (m - Rlength l1) = (S m - Rlength l1)%nat) in |- *;
+ apply minus_Sn_m; assumption.
+replace (cons r r0) with (cons_Rlist (cons r nil) r0);
+ [ symmetry in |- *; apply RList_P27 | reflexivity ].
+Qed. \ No newline at end of file
diff --git a/theories/Reals/R_Ifp.v b/theories/Reals/R_Ifp.v
index b167b6ef9..37d987855 100644
--- a/theories/Reals/R_Ifp.v
+++ b/theories/Reals/R_Ifp.v
@@ -13,9 +13,8 @@
(* *)
(**********************************************************)
-Require Rbase.
-Require Omega.
-V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
+Require Import Rbase.
+Require Import Omega.
Open Local Scope R_scope.
(*********************************************************)
@@ -23,83 +22,81 @@ Open Local Scope R_scope.
(*********************************************************)
(**********)
-Definition Int_part:R->Z:=[r:R](`(up r)-1`).
+Definition Int_part (r:R) : Z := (up r - 1)%Z.
(**********)
-Definition frac_part:R->R:=[r:R](Rminus r (IZR (Int_part r))).
+Definition frac_part (r:R) : R := r - IZR (Int_part r).
(**********)
-Lemma tech_up:(r:R)(z:Z)(Rlt r (IZR z))->(Rle (IZR z) (Rplus r R1))->
- z=(up r).
-Intros;Generalize (archimed r);Intro;Elim H1;Intros;Clear H1;
- Unfold Rgt in H2;Unfold Rminus in H3;
-Generalize (Rle_compatibility r (Rplus (IZR (up r))
- (Ropp r)) R1 H3);Intro;Clear H3;
- Rewrite (Rplus_sym (IZR (up r)) (Ropp r)) in H1;
- Rewrite <-(Rplus_assoc r (Ropp r) (IZR (up r))) in H1;
- Rewrite (Rplus_Ropp_r r) in H1;Elim (Rplus_ne (IZR (up r)));Intros a b;
- Rewrite b in H1;Clear a b;Apply (single_z_r_R1 r z (up r));Auto with zarith real.
+Lemma tech_up : forall (r:R) (z:Z), r < IZR z -> IZR z <= r + 1 -> z = up r.
+intros; generalize (archimed r); intro; elim H1; intros; clear H1;
+ unfold Rgt in H2; unfold Rminus in H3;
+ generalize (Rplus_le_compat_l r (IZR (up r) + - r) 1 H3);
+ intro; clear H3; rewrite (Rplus_comm (IZR (up r)) (- r)) in H1;
+ rewrite <- (Rplus_assoc r (- r) (IZR (up r))) in H1;
+ rewrite (Rplus_opp_r r) in H1; elim (Rplus_ne (IZR (up r)));
+ intros a b; rewrite b in H1; clear a b; apply (single_z_r_R1 r z (up r));
+ auto with zarith real.
Qed.
(**********)
-Lemma up_tech:(r:R)(z:Z)(Rle (IZR z) r)->(Rlt r (IZR `z+1`))->
- `z+1`=(up r).
-Intros;Generalize (Rle_compatibility R1 (IZR z) r H);Intro;Clear H;
- Rewrite (Rplus_sym R1 (IZR z)) in H1;Rewrite (Rplus_sym R1 r) in H1;
- Cut (R1==(IZR `1`));Auto with zarith real.
-Intro;Generalize H1;Pattern 1 R1;Rewrite H;Intro;Clear H H1;
- Rewrite <-(plus_IZR z `1`) in H2;Apply (tech_up r `z+1`);Auto with zarith real.
+Lemma up_tech :
+ forall (r:R) (z:Z), IZR z <= r -> r < IZR (z + 1) -> (z + 1)%Z = up r.
+intros; generalize (Rplus_le_compat_l 1 (IZR z) r H); intro; clear H;
+ rewrite (Rplus_comm 1 (IZR z)) in H1; rewrite (Rplus_comm 1 r) in H1;
+ cut (1 = IZR 1); auto with zarith real.
+intro; generalize H1; pattern 1 at 1 in |- *; rewrite H; intro; clear H H1;
+ rewrite <- (plus_IZR z 1) in H2; apply (tech_up r (z + 1));
+ auto with zarith real.
Qed.
(**********)
-Lemma fp_R0:(frac_part R0)==R0.
-Unfold frac_part; Unfold Int_part; Elim (archimed R0);
- Intros; Unfold Rminus;
- Elim (Rplus_ne (Ropp (IZR `(up R0)-1`))); Intros a b;
- Rewrite b;Clear a b;Rewrite <- Z_R_minus;Cut (up R0)=`1`.
-Intro;Rewrite H1;
- Rewrite (eq_Rminus (IZR `1`) (IZR `1`) (refl_eqT R (IZR `1`)));
- Apply Ropp_O.
-Elim (archimed R0);Intros;Clear H2;Unfold Rgt in H1;
- Rewrite (minus_R0 (IZR (up R0))) in H0;
- Generalize (lt_O_IZR (up R0) H1);Intro;Clear H1;
- Generalize (le_IZR_R1 (up R0) H0);Intro;Clear H H0;Omega.
+Lemma fp_R0 : frac_part 0 = 0.
+unfold frac_part in |- *; unfold Int_part in |- *; elim (archimed 0); intros;
+ unfold Rminus in |- *; elim (Rplus_ne (- IZR (up 0 - 1)));
+ intros a b; rewrite b; clear a b; rewrite <- Z_R_minus;
+ cut (up 0 = 1%Z).
+intro; rewrite H1;
+ rewrite (Rminus_diag_eq (IZR 1) (IZR 1) (refl_equal (IZR 1)));
+ apply Ropp_0.
+elim (archimed 0); intros; clear H2; unfold Rgt in H1;
+ rewrite (Rminus_0_r (IZR (up 0))) in H0; generalize (lt_O_IZR (up 0) H1);
+ intro; clear H1; generalize (le_IZR_R1 (up 0) H0);
+ intro; clear H H0; omega.
Qed.
(**********)
-Lemma for_base_fp:(r:R)(Rgt (Rminus (IZR (up r)) r) R0)/\
- (Rle (Rminus (IZR (up r)) r) R1).
-Intro; Split;
- Cut (Rgt (IZR (up r)) r)/\(Rle (Rminus (IZR (up r)) r) R1).
-Intro; Elim H; Intros.
-Apply (Rgt_minus (IZR (up r)) r H0).
-Apply archimed.
-Intro; Elim H; Intros.
-Exact H1.
-Apply archimed.
+Lemma for_base_fp : forall r:R, IZR (up r) - r > 0 /\ IZR (up r) - r <= 1.
+intro; split; cut (IZR (up r) > r /\ IZR (up r) - r <= 1).
+intro; elim H; intros.
+apply (Rgt_minus (IZR (up r)) r H0).
+apply archimed.
+intro; elim H; intros.
+exact H1.
+apply archimed.
Qed.
(**********)
-Lemma base_fp:(r:R)(Rge (frac_part r) R0)/\(Rlt (frac_part r) R1).
-Intro; Unfold frac_part; Unfold Int_part; Split.
+Lemma base_fp : forall r:R, frac_part r >= 0 /\ frac_part r < 1.
+intro; unfold frac_part in |- *; unfold Int_part in |- *; split.
(*sup a O*)
-Cut (Rge (Rminus r (IZR (up r))) (Ropp R1)).
-Rewrite <- Z_R_minus;Simpl;Intro; Unfold Rminus;
- Rewrite Ropp_distr1;Rewrite <-Rplus_assoc;
- Fold (Rminus r (IZR (up r)));
- Fold (Rminus (Rminus r (IZR (up r))) (Ropp R1));
- Apply Rge_minus;Auto with zarith real.
-Rewrite <- Ropp_distr2;Apply Rle_Ropp;Elim (for_base_fp r); Auto with zarith real.
+cut (r - IZR (up r) >= -1).
+rewrite <- Z_R_minus; simpl in |- *; intro; unfold Rminus in |- *;
+ rewrite Ropp_plus_distr; rewrite <- Rplus_assoc;
+ fold (r - IZR (up r)) in |- *; fold (r - IZR (up r) - -1) in |- *;
+ apply Rge_minus; auto with zarith real.
+rewrite <- Ropp_minus_distr; apply Ropp_le_ge_contravar; elim (for_base_fp r);
+ auto with zarith real.
(*inf a 1*)
-Cut (Rlt (Rminus r (IZR (up r))) R0).
-Rewrite <- Z_R_minus; Simpl;Intro; Unfold Rminus;
- Rewrite Ropp_distr1;Rewrite <-Rplus_assoc;
- Fold (Rminus r (IZR (up r)));Rewrite Ropp_Ropp;
- Elim (Rplus_ne R1);Intros a b;Pattern 2 R1;Rewrite <-a;Clear a b;
- Rewrite (Rplus_sym (Rminus r (IZR (up r))) R1);
- Apply Rlt_compatibility;Auto with zarith real.
-Elim (for_base_fp r);Intros;Rewrite <-Ropp_O;
- Rewrite<-Ropp_distr2;Apply Rgt_Ropp;Auto with zarith real.
+cut (r - IZR (up r) < 0).
+rewrite <- Z_R_minus; simpl in |- *; intro; unfold Rminus in |- *;
+ rewrite Ropp_plus_distr; rewrite <- Rplus_assoc;
+ fold (r - IZR (up r)) in |- *; rewrite Ropp_involutive;
+ elim (Rplus_ne 1); intros a b; pattern 1 at 2 in |- *;
+ rewrite <- a; clear a b; rewrite (Rplus_comm (r - IZR (up r)) 1);
+ apply Rplus_lt_compat_l; auto with zarith real.
+elim (for_base_fp r); intros; rewrite <- Ropp_0; rewrite <- Ropp_minus_distr;
+ apply Ropp_gt_lt_contravar; auto with zarith real.
Qed.
(*********************************************************)
@@ -107,446 +104,442 @@ Qed.
(*********************************************************)
(**********)
-Lemma base_Int_part:(r:R)(Rle (IZR (Int_part r)) r)/\
- (Rgt (Rminus (IZR (Int_part r)) r) (Ropp R1)).
-Intro;Unfold Int_part;Elim (archimed r);Intros.
-Split;Rewrite <- (Z_R_minus (up r) `1`);Simpl.
-Generalize (Rle_minus (Rminus (IZR (up r)) r) R1 H0);Intro;
- Unfold Rminus in H1;
- Rewrite (Rplus_assoc (IZR (up r)) (Ropp r) (Ropp R1)) in
- H1;Rewrite (Rplus_sym (Ropp r) (Ropp R1)) in H1;
- Rewrite <-(Rplus_assoc (IZR (up r)) (Ropp R1) (Ropp r)) in
- H1;Fold (Rminus (IZR (up r)) R1) in H1;
- Fold (Rminus (Rminus (IZR (up r)) R1) r) in H1;
- Apply Rminus_le;Auto with zarith real.
-Generalize (Rgt_plus_plus_r (Ropp R1) (IZR (up r)) r H);Intro;
- Rewrite (Rplus_sym (Ropp R1) (IZR (up r))) in H1;
- Generalize (Rgt_plus_plus_r (Ropp r)
- (Rplus (IZR (up r)) (Ropp R1)) (Rplus (Ropp R1) r) H1);
- Intro;Clear H H0 H1;
- Rewrite (Rplus_sym (Ropp r) (Rplus (IZR (up r)) (Ropp R1)))
- in H2;Fold (Rminus (IZR (up r)) R1) in H2;
- Fold (Rminus (Rminus (IZR (up r)) R1) r) in H2;
- Rewrite (Rplus_sym (Ropp r) (Rplus (Ropp R1) r)) in H2;
- Rewrite (Rplus_assoc (Ropp R1) r (Ropp r)) in H2;
- Rewrite (Rplus_Ropp_r r) in H2;Elim (Rplus_ne (Ropp R1));Intros a b;
- Rewrite a in H2;Clear a b;Auto with zarith real.
+Lemma base_Int_part :
+ forall r:R, IZR (Int_part r) <= r /\ IZR (Int_part r) - r > -1.
+intro; unfold Int_part in |- *; elim (archimed r); intros.
+split; rewrite <- (Z_R_minus (up r) 1); simpl in |- *.
+generalize (Rle_minus (IZR (up r) - r) 1 H0); intro; unfold Rminus in H1;
+ rewrite (Rplus_assoc (IZR (up r)) (- r) (-1)) in H1;
+ rewrite (Rplus_comm (- r) (-1)) in H1;
+ rewrite <- (Rplus_assoc (IZR (up r)) (-1) (- r)) in H1;
+ fold (IZR (up r) - 1) in H1; fold (IZR (up r) - 1 - r) in H1;
+ apply Rminus_le; auto with zarith real.
+generalize (Rplus_gt_compat_l (-1) (IZR (up r)) r H); intro;
+ rewrite (Rplus_comm (-1) (IZR (up r))) in H1;
+ generalize (Rplus_gt_compat_l (- r) (IZR (up r) + -1) (-1 + r) H1);
+ intro; clear H H0 H1; rewrite (Rplus_comm (- r) (IZR (up r) + -1)) in H2;
+ fold (IZR (up r) - 1) in H2; fold (IZR (up r) - 1 - r) in H2;
+ rewrite (Rplus_comm (- r) (-1 + r)) in H2;
+ rewrite (Rplus_assoc (-1) r (- r)) in H2; rewrite (Rplus_opp_r r) in H2;
+ elim (Rplus_ne (-1)); intros a b; rewrite a in H2;
+ clear a b; auto with zarith real.
Qed.
(**********)
-Lemma Int_part_INR:(n : nat) (Int_part (INR n)) = (inject_nat n).
-Intros n; Unfold Int_part.
-Cut (up (INR n)) = (Zplus (inject_nat n) (inject_nat (1))).
-Intros H'; Rewrite H'; Simpl; Ring.
-Apply sym_equal; Apply tech_up; Auto.
-Replace (Zplus (inject_nat n) (inject_nat (1))) with (INZ (S n)).
-Repeat Rewrite <- INR_IZR_INZ.
-Apply lt_INR; Auto.
-Rewrite Zplus_sym; Rewrite <- inj_plus; Simpl; Auto.
-Rewrite plus_IZR; Simpl; Auto with real.
-Repeat Rewrite <- INR_IZR_INZ; Auto with real.
+Lemma Int_part_INR : forall n:nat, Int_part (INR n) = Z_of_nat n.
+intros n; unfold Int_part in |- *.
+cut (up (INR n) = (Z_of_nat n + Z_of_nat 1)%Z).
+intros H'; rewrite H'; simpl in |- *; ring.
+apply sym_equal; apply tech_up; auto.
+replace (Z_of_nat n + Z_of_nat 1)%Z with (Z_of_nat (S n)).
+repeat rewrite <- INR_IZR_INZ.
+apply lt_INR; auto.
+rewrite Zplus_comm; rewrite <- Znat.inj_plus; simpl in |- *; auto.
+rewrite plus_IZR; simpl in |- *; auto with real.
+repeat rewrite <- INR_IZR_INZ; auto with real.
Qed.
(**********)
-Lemma fp_nat:(r:R)(frac_part r)==R0->(Ex [c:Z](r==(IZR c))).
-Unfold frac_part;Intros;Split with (Int_part r);Apply Rminus_eq; Auto with zarith real.
+Lemma fp_nat : forall r:R, frac_part r = 0 -> exists c : Z | r = IZR c.
+unfold frac_part in |- *; intros; split with (Int_part r);
+ apply Rminus_diag_uniq; auto with zarith real.
Qed.
(**********)
-Lemma R0_fp_O:(r:R)~R0==(frac_part r)->~R0==r.
-Red;Intros;Rewrite <- H0 in H;Generalize fp_R0;Intro;Auto with zarith real.
+Lemma R0_fp_O : forall r:R, 0 <> frac_part r -> 0 <> r.
+red in |- *; intros; rewrite <- H0 in H; generalize fp_R0; intro;
+ auto with zarith real.
Qed.
(**********)
-Lemma Rminus_Int_part1:(r1,r2:R)(Rge (frac_part r1) (frac_part r2))->
- (Int_part (Rminus r1 r2))=(Zminus (Int_part r1) (Int_part r2)).
-Intros;Elim (base_fp r1);Elim (base_fp r2);Intros;
- Generalize (Rle_sym2 R0 (frac_part r2) H0);Intro;Clear H0;
- Generalize (Rle_Ropp R0 (frac_part r2) H4);Intro;Clear H4;
- Rewrite (Ropp_O) in H0;
- Generalize (Rle_sym2 (Ropp (frac_part r2)) R0 H0);Intro;Clear H0;
- Generalize (Rle_sym2 R0 (frac_part r1) H2);Intro;Clear H2;
- Generalize (Rlt_Ropp (frac_part r2) R1 H1);Intro;Clear H1;
- Unfold Rgt in H2;
- Generalize (sum_inequa_Rle_lt R0 (frac_part r1) R1 (Ropp R1)
- (Ropp (frac_part r2)) R0 H0 H3 H2 H4);Intro;Elim H1;Intros;
- Clear H1;Elim (Rplus_ne R1);Intros a b;Rewrite a in H6;Clear a b H5;
- Generalize (Rge_minus (frac_part r1) (frac_part r2) H);Intro;Clear H;
- Fold (Rminus (frac_part r1) (frac_part r2)) in H6;
- Generalize (Rle_sym2 R0 (Rminus (frac_part r1) (frac_part r2)) H1);
- Intro;Clear H1 H3 H4 H0 H2;Unfold frac_part in H6 H;
- Unfold Rminus in H6 H;
- Rewrite (Ropp_distr1 r2 (Ropp (IZR (Int_part r2)))) in H;
- Rewrite (Ropp_Ropp (IZR (Int_part r2))) in H;
- Rewrite (Rplus_assoc r1 (Ropp (IZR (Int_part r1)))
- (Rplus (Ropp r2) (IZR (Int_part r2)))) in H;
- Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp r2)
- (IZR (Int_part r2))) in H;
- Rewrite (Rplus_sym (Ropp (IZR (Int_part r1))) (Ropp r2)) in H;
- Rewrite (Rplus_assoc (Ropp r2) (Ropp (IZR (Int_part r1)))
- (IZR (Int_part r2))) in H;
- Rewrite <-(Rplus_assoc r1 (Ropp r2)
- (Rplus (Ropp (IZR (Int_part r1))) (IZR (Int_part r2)))) in H;
- Rewrite (Rplus_sym (Ropp (IZR (Int_part r1))) (IZR (Int_part r2))) in H;
- Fold (Rminus r1 r2) in H;Fold (Rminus (IZR (Int_part r2)) (IZR (Int_part r1)))
- in H;Generalize (Rle_compatibility
- (Rminus (IZR (Int_part r1)) (IZR (Int_part r2))) R0
- (Rplus (Rminus r1 r2) (Rminus (IZR (Int_part r2)) (IZR (Int_part r1)))) H);Intro;
- Clear H;Rewrite (Rplus_sym (Rminus r1 r2)
- (Rminus (IZR (Int_part r2)) (IZR (Int_part r1)))) in H0;
- Rewrite <-(Rplus_assoc (Rminus (IZR (Int_part r1)) (IZR (Int_part r2)))
- (Rminus (IZR (Int_part r2)) (IZR (Int_part r1))) (Rminus r1 r2)) in H0;
- Unfold Rminus in H0;Fold (Rminus r1 r2) in H0;
- Rewrite (Rplus_assoc (IZR (Int_part r1)) (Ropp (IZR (Int_part r2)))
- (Rplus (IZR (Int_part r2)) (Ropp (IZR (Int_part r1))))) in H0;
- Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r2))) (IZR (Int_part r2))
- (Ropp (IZR (Int_part r1)))) in H0;Rewrite (Rplus_Ropp_l (IZR (Int_part r2))) in
- H0;Elim (Rplus_ne (Ropp (IZR (Int_part r1))));Intros a b;Rewrite b in H0;
- Clear a b;
- Elim (Rplus_ne (Rplus (IZR (Int_part r1)) (Ropp (IZR (Int_part r2)))));
- Intros a b;Rewrite a in H0;Clear a b;Rewrite (Rplus_Ropp_r (IZR (Int_part r1)))
- in H0;Elim (Rplus_ne (Rminus r1 r2));Intros a b;Rewrite b in H0;
- Clear a b;Fold (Rminus (IZR (Int_part r1)) (IZR (Int_part r2))) in H0;
- Rewrite (Ropp_distr1 r2 (Ropp (IZR (Int_part r2)))) in H6;
- Rewrite (Ropp_Ropp (IZR (Int_part r2))) in H6;
- Rewrite (Rplus_assoc r1 (Ropp (IZR (Int_part r1)))
- (Rplus (Ropp r2) (IZR (Int_part r2)))) in H6;
- Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp r2)
- (IZR (Int_part r2))) in H6;
- Rewrite (Rplus_sym (Ropp (IZR (Int_part r1))) (Ropp r2)) in H6;
- Rewrite (Rplus_assoc (Ropp r2) (Ropp (IZR (Int_part r1)))
- (IZR (Int_part r2))) in H6;
- Rewrite <-(Rplus_assoc r1 (Ropp r2)
- (Rplus (Ropp (IZR (Int_part r1))) (IZR (Int_part r2)))) in H6;
- Rewrite (Rplus_sym (Ropp (IZR (Int_part r1))) (IZR (Int_part r2))) in H6;
- Fold (Rminus r1 r2) in H6;Fold (Rminus (IZR (Int_part r2)) (IZR (Int_part r1)))
- in H6;Generalize (Rlt_compatibility
- (Rminus (IZR (Int_part r1)) (IZR (Int_part r2)))
- (Rplus (Rminus r1 r2) (Rminus (IZR (Int_part r2)) (IZR (Int_part r1)))) R1 H6);
- Intro;Clear H6;
- Rewrite (Rplus_sym (Rminus r1 r2)
- (Rminus (IZR (Int_part r2)) (IZR (Int_part r1)))) in H;
- Rewrite <-(Rplus_assoc (Rminus (IZR (Int_part r1)) (IZR (Int_part r2)))
- (Rminus (IZR (Int_part r2)) (IZR (Int_part r1))) (Rminus r1 r2)) in H;
- Rewrite <-(Ropp_distr2 (IZR (Int_part r1)) (IZR (Int_part r2))) in H;
- Rewrite (Rplus_Ropp_r (Rminus (IZR (Int_part r1)) (IZR (Int_part r2)))) in H;
- Elim (Rplus_ne (Rminus r1 r2));Intros a b;Rewrite b in H;Clear a b;
- Rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H0;
- Rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H;
- Cut R1==(IZR `1`);Auto with zarith real.
-Intro;Rewrite H1 in H;Clear H1;
- Rewrite <-(plus_IZR `(Int_part r1)-(Int_part r2)` `1`) in H;
- Generalize (up_tech (Rminus r1 r2) `(Int_part r1)-(Int_part r2)`
- H0 H);Intros;Clear H H0;Unfold 1 Int_part;Omega.
+Lemma Rminus_Int_part1 :
+ forall r1 r2:R,
+ frac_part r1 >= frac_part r2 ->
+ Int_part (r1 - r2) = (Int_part r1 - Int_part r2)%Z.
+intros; elim (base_fp r1); elim (base_fp r2); intros;
+ generalize (Rge_le (frac_part r2) 0 H0); intro; clear H0;
+ generalize (Ropp_le_ge_contravar 0 (frac_part r2) H4);
+ intro; clear H4; rewrite Ropp_0 in H0;
+ generalize (Rge_le 0 (- frac_part r2) H0); intro;
+ clear H0; generalize (Rge_le (frac_part r1) 0 H2);
+ intro; clear H2; generalize (Ropp_lt_gt_contravar (frac_part r2) 1 H1);
+ intro; clear H1; unfold Rgt in H2;
+ generalize
+ (sum_inequa_Rle_lt 0 (frac_part r1) 1 (-1) (- frac_part r2) 0 H0 H3 H2 H4);
+ intro; elim H1; intros; clear H1; elim (Rplus_ne 1);
+ intros a b; rewrite a in H6; clear a b H5;
+ generalize (Rge_minus (frac_part r1) (frac_part r2) H);
+ intro; clear H; fold (frac_part r1 - frac_part r2) in H6;
+ generalize (Rge_le (frac_part r1 - frac_part r2) 0 H1);
+ intro; clear H1 H3 H4 H0 H2; unfold frac_part in H6, H;
+ unfold Rminus in H6, H;
+ rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2))) in H;
+ rewrite (Ropp_involutive (IZR (Int_part r2))) in H;
+ rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2)))
+ in H;
+ rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2)))
+ in H; rewrite (Rplus_comm (- IZR (Int_part r1)) (- r2)) in H;
+ rewrite (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2))) in H;
+ rewrite <- (Rplus_assoc r1 (- r2) (- IZR (Int_part r1) + IZR (Int_part r2)))
+ in H; rewrite (Rplus_comm (- IZR (Int_part r1)) (IZR (Int_part r2))) in H;
+ fold (r1 - r2) in H; fold (IZR (Int_part r2) - IZR (Int_part r1)) in H;
+ generalize
+ (Rplus_le_compat_l (IZR (Int_part r1) - IZR (Int_part r2)) 0
+ (r1 - r2 + (IZR (Int_part r2) - IZR (Int_part r1))) H);
+ intro; clear H;
+ rewrite (Rplus_comm (r1 - r2) (IZR (Int_part r2) - IZR (Int_part r1))) in H0;
+ rewrite <-
+ (Rplus_assoc (IZR (Int_part r1) - IZR (Int_part r2))
+ (IZR (Int_part r2) - IZR (Int_part r1)) (r1 - r2))
+ in H0; unfold Rminus in H0; fold (r1 - r2) in H0;
+ rewrite
+ (Rplus_assoc (IZR (Int_part r1)) (- IZR (Int_part r2))
+ (IZR (Int_part r2) + - IZR (Int_part r1))) in H0;
+ rewrite <-
+ (Rplus_assoc (- IZR (Int_part r2)) (IZR (Int_part r2))
+ (- IZR (Int_part r1))) in H0;
+ rewrite (Rplus_opp_l (IZR (Int_part r2))) in H0;
+ elim (Rplus_ne (- IZR (Int_part r1))); intros a b;
+ rewrite b in H0; clear a b;
+ elim (Rplus_ne (IZR (Int_part r1) + - IZR (Int_part r2)));
+ intros a b; rewrite a in H0; clear a b;
+ rewrite (Rplus_opp_r (IZR (Int_part r1))) in H0; elim (Rplus_ne (r1 - r2));
+ intros a b; rewrite b in H0; clear a b;
+ fold (IZR (Int_part r1) - IZR (Int_part r2)) in H0;
+ rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2))) in H6;
+ rewrite (Ropp_involutive (IZR (Int_part r2))) in H6;
+ rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2)))
+ in H6;
+ rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2)))
+ in H6; rewrite (Rplus_comm (- IZR (Int_part r1)) (- r2)) in H6;
+ rewrite (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2))) in H6;
+ rewrite <- (Rplus_assoc r1 (- r2) (- IZR (Int_part r1) + IZR (Int_part r2)))
+ in H6;
+ rewrite (Rplus_comm (- IZR (Int_part r1)) (IZR (Int_part r2))) in H6;
+ fold (r1 - r2) in H6; fold (IZR (Int_part r2) - IZR (Int_part r1)) in H6;
+ generalize
+ (Rplus_lt_compat_l (IZR (Int_part r1) - IZR (Int_part r2))
+ (r1 - r2 + (IZR (Int_part r2) - IZR (Int_part r1))) 1 H6);
+ intro; clear H6;
+ rewrite (Rplus_comm (r1 - r2) (IZR (Int_part r2) - IZR (Int_part r1))) in H;
+ rewrite <-
+ (Rplus_assoc (IZR (Int_part r1) - IZR (Int_part r2))
+ (IZR (Int_part r2) - IZR (Int_part r1)) (r1 - r2))
+ in H;
+ rewrite <- (Ropp_minus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H;
+ rewrite (Rplus_opp_r (IZR (Int_part r1) - IZR (Int_part r2))) in H;
+ elim (Rplus_ne (r1 - r2)); intros a b; rewrite b in H;
+ clear a b; rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H0;
+ rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H;
+ cut (1 = IZR 1); auto with zarith real.
+intro; rewrite H1 in H; clear H1;
+ rewrite <- (plus_IZR (Int_part r1 - Int_part r2) 1) in H;
+ generalize (up_tech (r1 - r2) (Int_part r1 - Int_part r2) H0 H);
+ intros; clear H H0; unfold Int_part at 1 in |- *;
+ omega.
Qed.
(**********)
-Lemma Rminus_Int_part2:(r1,r2:R)(Rlt (frac_part r1) (frac_part r2))->
- (Int_part (Rminus r1 r2))=(Zminus (Zminus (Int_part r1) (Int_part r2)) `1`).
-Intros;Elim (base_fp r1);Elim (base_fp r2);Intros;
- Generalize (Rle_sym2 R0 (frac_part r2) H0);Intro;Clear H0;
- Generalize (Rle_Ropp R0 (frac_part r2) H4);Intro;Clear H4;
- Rewrite (Ropp_O) in H0;
- Generalize (Rle_sym2 (Ropp (frac_part r2)) R0 H0);Intro;Clear H0;
- Generalize (Rle_sym2 R0 (frac_part r1) H2);Intro;Clear H2;
- Generalize (Rlt_Ropp (frac_part r2) R1 H1);Intro;Clear H1;
- Unfold Rgt in H2;
- Generalize (sum_inequa_Rle_lt R0 (frac_part r1) R1 (Ropp R1)
- (Ropp (frac_part r2)) R0 H0 H3 H2 H4);Intro;Elim H1;Intros;
- Clear H1;Elim (Rplus_ne (Ropp R1));Intros a b;Rewrite b in H5;
- Clear a b H6;Generalize (Rlt_minus (frac_part r1) (frac_part r2) H);
- Intro;Clear H;Fold (Rminus (frac_part r1) (frac_part r2)) in H5;
- Clear H3 H4 H0 H2;Unfold frac_part in H5 H1;
- Unfold Rminus in H5 H1;
- Rewrite (Ropp_distr1 r2 (Ropp (IZR (Int_part r2)))) in H5;
- Rewrite (Ropp_Ropp (IZR (Int_part r2))) in H5;
- Rewrite (Rplus_assoc r1 (Ropp (IZR (Int_part r1)))
- (Rplus (Ropp r2) (IZR (Int_part r2)))) in H5;
- Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp r2)
- (IZR (Int_part r2))) in H5;
- Rewrite (Rplus_sym (Ropp (IZR (Int_part r1))) (Ropp r2)) in H5;
- Rewrite (Rplus_assoc (Ropp r2) (Ropp (IZR (Int_part r1)))
- (IZR (Int_part r2))) in H5;
- Rewrite <-(Rplus_assoc r1 (Ropp r2)
- (Rplus (Ropp (IZR (Int_part r1))) (IZR (Int_part r2)))) in H5;
- Rewrite (Rplus_sym (Ropp (IZR (Int_part r1))) (IZR (Int_part r2))) in H5;
- Fold (Rminus r1 r2) in H5;Fold (Rminus (IZR (Int_part r2)) (IZR (Int_part r1)))
- in H5;Generalize (Rlt_compatibility
- (Rminus (IZR (Int_part r1)) (IZR (Int_part r2))) (Ropp R1)
- (Rplus (Rminus r1 r2) (Rminus (IZR (Int_part r2)) (IZR (Int_part r1)))) H5);
- Intro;Clear H5;Rewrite (Rplus_sym (Rminus r1 r2)
- (Rminus (IZR (Int_part r2)) (IZR (Int_part r1)))) in H;
- Rewrite <-(Rplus_assoc (Rminus (IZR (Int_part r1)) (IZR (Int_part r2)))
- (Rminus (IZR (Int_part r2)) (IZR (Int_part r1))) (Rminus r1 r2)) in H;
- Unfold Rminus in H;Fold (Rminus r1 r2) in H;
- Rewrite (Rplus_assoc (IZR (Int_part r1)) (Ropp (IZR (Int_part r2)))
- (Rplus (IZR (Int_part r2)) (Ropp (IZR (Int_part r1))))) in H;
- Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r2))) (IZR (Int_part r2))
- (Ropp (IZR (Int_part r1)))) in H;Rewrite (Rplus_Ropp_l (IZR (Int_part r2))) in
- H;Elim (Rplus_ne (Ropp (IZR (Int_part r1))));Intros a b;Rewrite b in H;
- Clear a b;Rewrite (Rplus_Ropp_r (IZR (Int_part r1))) in H;
- Elim (Rplus_ne (Rminus r1 r2));Intros a b;Rewrite b in H;
- Clear a b;Fold (Rminus (IZR (Int_part r1)) (IZR (Int_part r2))) in H;
- Fold (Rminus (Rminus (IZR (Int_part r1)) (IZR (Int_part r2))) R1) in H;
- Rewrite (Ropp_distr1 r2 (Ropp (IZR (Int_part r2)))) in H1;
- Rewrite (Ropp_Ropp (IZR (Int_part r2))) in H1;
- Rewrite (Rplus_assoc r1 (Ropp (IZR (Int_part r1)))
- (Rplus (Ropp r2) (IZR (Int_part r2)))) in H1;
- Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp r2)
- (IZR (Int_part r2))) in H1;
- Rewrite (Rplus_sym (Ropp (IZR (Int_part r1))) (Ropp r2)) in H1;
- Rewrite (Rplus_assoc (Ropp r2) (Ropp (IZR (Int_part r1)))
- (IZR (Int_part r2))) in H1;
- Rewrite <-(Rplus_assoc r1 (Ropp r2)
- (Rplus (Ropp (IZR (Int_part r1))) (IZR (Int_part r2)))) in H1;
- Rewrite (Rplus_sym (Ropp (IZR (Int_part r1))) (IZR (Int_part r2))) in H1;
- Fold (Rminus r1 r2) in H1;Fold (Rminus (IZR (Int_part r2)) (IZR (Int_part r1)))
- in H1;Generalize (Rlt_compatibility
- (Rminus (IZR (Int_part r1)) (IZR (Int_part r2)))
- (Rplus (Rminus r1 r2) (Rminus (IZR (Int_part r2)) (IZR (Int_part r1)))) R0 H1);
- Intro;Clear H1;
- Rewrite (Rplus_sym (Rminus r1 r2)
- (Rminus (IZR (Int_part r2)) (IZR (Int_part r1)))) in H0;
- Rewrite <-(Rplus_assoc (Rminus (IZR (Int_part r1)) (IZR (Int_part r2)))
- (Rminus (IZR (Int_part r2)) (IZR (Int_part r1))) (Rminus r1 r2)) in H0;
- Rewrite <-(Ropp_distr2 (IZR (Int_part r1)) (IZR (Int_part r2))) in H0;
- Rewrite (Rplus_Ropp_r (Rminus (IZR (Int_part r1)) (IZR (Int_part r2)))) in H0;
- Elim (Rplus_ne (Rminus r1 r2));Intros a b;Rewrite b in H0;Clear a b;
- Rewrite <-(Rplus_Ropp_l R1) in H0;
- Rewrite <-(Rplus_assoc (Rminus (IZR (Int_part r1)) (IZR (Int_part r2)))
- (Ropp R1) R1) in H0;
- Fold (Rminus (Rminus (IZR (Int_part r1)) (IZR (Int_part r2))) R1) in H0;
- Rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H0;
- Rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H;
- Cut R1==(IZR `1`);Auto with zarith real.
-Intro;Rewrite H1 in H;Rewrite H1 in H0;Clear H1;
- Rewrite (Z_R_minus `(Int_part r1)-(Int_part r2)` `1`) in H;
- Rewrite (Z_R_minus `(Int_part r1)-(Int_part r2)` `1`) in H0;
- Rewrite <-(plus_IZR `(Int_part r1)-(Int_part r2)-1` `1`) in H0;
- Generalize (Rlt_le (IZR `(Int_part r1)-(Int_part r2)-1`) (Rminus r1 r2) H);
- Intro;Clear H;
- Generalize (up_tech (Rminus r1 r2) `(Int_part r1)-(Int_part r2)-1`
- H1 H0);Intros;Clear H0 H1;Unfold 1 Int_part;Omega.
+Lemma Rminus_Int_part2 :
+ forall r1 r2:R,
+ frac_part r1 < frac_part r2 ->
+ Int_part (r1 - r2) = (Int_part r1 - Int_part r2 - 1)%Z.
+intros; elim (base_fp r1); elim (base_fp r2); intros;
+ generalize (Rge_le (frac_part r2) 0 H0); intro; clear H0;
+ generalize (Ropp_le_ge_contravar 0 (frac_part r2) H4);
+ intro; clear H4; rewrite Ropp_0 in H0;
+ generalize (Rge_le 0 (- frac_part r2) H0); intro;
+ clear H0; generalize (Rge_le (frac_part r1) 0 H2);
+ intro; clear H2; generalize (Ropp_lt_gt_contravar (frac_part r2) 1 H1);
+ intro; clear H1; unfold Rgt in H2;
+ generalize
+ (sum_inequa_Rle_lt 0 (frac_part r1) 1 (-1) (- frac_part r2) 0 H0 H3 H2 H4);
+ intro; elim H1; intros; clear H1; elim (Rplus_ne (-1));
+ intros a b; rewrite b in H5; clear a b H6;
+ generalize (Rlt_minus (frac_part r1) (frac_part r2) H);
+ intro; clear H; fold (frac_part r1 - frac_part r2) in H5;
+ clear H3 H4 H0 H2; unfold frac_part in H5, H1; unfold Rminus in H5, H1;
+ rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2))) in H5;
+ rewrite (Ropp_involutive (IZR (Int_part r2))) in H5;
+ rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2)))
+ in H5;
+ rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2)))
+ in H5; rewrite (Rplus_comm (- IZR (Int_part r1)) (- r2)) in H5;
+ rewrite (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2))) in H5;
+ rewrite <- (Rplus_assoc r1 (- r2) (- IZR (Int_part r1) + IZR (Int_part r2)))
+ in H5;
+ rewrite (Rplus_comm (- IZR (Int_part r1)) (IZR (Int_part r2))) in H5;
+ fold (r1 - r2) in H5; fold (IZR (Int_part r2) - IZR (Int_part r1)) in H5;
+ generalize
+ (Rplus_lt_compat_l (IZR (Int_part r1) - IZR (Int_part r2)) (-1)
+ (r1 - r2 + (IZR (Int_part r2) - IZR (Int_part r1))) H5);
+ intro; clear H5;
+ rewrite (Rplus_comm (r1 - r2) (IZR (Int_part r2) - IZR (Int_part r1))) in H;
+ rewrite <-
+ (Rplus_assoc (IZR (Int_part r1) - IZR (Int_part r2))
+ (IZR (Int_part r2) - IZR (Int_part r1)) (r1 - r2))
+ in H; unfold Rminus in H; fold (r1 - r2) in H;
+ rewrite
+ (Rplus_assoc (IZR (Int_part r1)) (- IZR (Int_part r2))
+ (IZR (Int_part r2) + - IZR (Int_part r1))) in H;
+ rewrite <-
+ (Rplus_assoc (- IZR (Int_part r2)) (IZR (Int_part r2))
+ (- IZR (Int_part r1))) in H;
+ rewrite (Rplus_opp_l (IZR (Int_part r2))) in H;
+ elim (Rplus_ne (- IZR (Int_part r1))); intros a b;
+ rewrite b in H; clear a b; rewrite (Rplus_opp_r (IZR (Int_part r1))) in H;
+ elim (Rplus_ne (r1 - r2)); intros a b; rewrite b in H;
+ clear a b; fold (IZR (Int_part r1) - IZR (Int_part r2)) in H;
+ fold (IZR (Int_part r1) - IZR (Int_part r2) - 1) in H;
+ rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2))) in H1;
+ rewrite (Ropp_involutive (IZR (Int_part r2))) in H1;
+ rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2)))
+ in H1;
+ rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2)))
+ in H1; rewrite (Rplus_comm (- IZR (Int_part r1)) (- r2)) in H1;
+ rewrite (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2))) in H1;
+ rewrite <- (Rplus_assoc r1 (- r2) (- IZR (Int_part r1) + IZR (Int_part r2)))
+ in H1;
+ rewrite (Rplus_comm (- IZR (Int_part r1)) (IZR (Int_part r2))) in H1;
+ fold (r1 - r2) in H1; fold (IZR (Int_part r2) - IZR (Int_part r1)) in H1;
+ generalize
+ (Rplus_lt_compat_l (IZR (Int_part r1) - IZR (Int_part r2))
+ (r1 - r2 + (IZR (Int_part r2) - IZR (Int_part r1))) 0 H1);
+ intro; clear H1;
+ rewrite (Rplus_comm (r1 - r2) (IZR (Int_part r2) - IZR (Int_part r1))) in H0;
+ rewrite <-
+ (Rplus_assoc (IZR (Int_part r1) - IZR (Int_part r2))
+ (IZR (Int_part r2) - IZR (Int_part r1)) (r1 - r2))
+ in H0;
+ rewrite <- (Ropp_minus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H0;
+ rewrite (Rplus_opp_r (IZR (Int_part r1) - IZR (Int_part r2))) in H0;
+ elim (Rplus_ne (r1 - r2)); intros a b; rewrite b in H0;
+ clear a b; rewrite <- (Rplus_opp_l 1) in H0;
+ rewrite <- (Rplus_assoc (IZR (Int_part r1) - IZR (Int_part r2)) (-1) 1)
+ in H0; fold (IZR (Int_part r1) - IZR (Int_part r2) - 1) in H0;
+ rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H0;
+ rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H;
+ cut (1 = IZR 1); auto with zarith real.
+intro; rewrite H1 in H; rewrite H1 in H0; clear H1;
+ rewrite (Z_R_minus (Int_part r1 - Int_part r2) 1) in H;
+ rewrite (Z_R_minus (Int_part r1 - Int_part r2) 1) in H0;
+ rewrite <- (plus_IZR (Int_part r1 - Int_part r2 - 1) 1) in H0;
+ generalize (Rlt_le (IZR (Int_part r1 - Int_part r2 - 1)) (r1 - r2) H);
+ intro; clear H;
+ generalize (up_tech (r1 - r2) (Int_part r1 - Int_part r2 - 1) H1 H0);
+ intros; clear H0 H1; unfold Int_part at 1 in |- *;
+ omega.
Qed.
(**********)
-Lemma Rminus_fp1:(r1,r2:R)(Rge (frac_part r1) (frac_part r2))->
- (frac_part (Rminus r1 r2))==(Rminus (frac_part r1) (frac_part r2)).
-Intros;Unfold frac_part;
- Generalize (Rminus_Int_part1 r1 r2 H);Intro;Rewrite -> H0;
- Rewrite <- (Z_R_minus (Int_part r1) (Int_part r2));Unfold Rminus;
- Rewrite -> (Ropp_distr1 (IZR (Int_part r1)) (Ropp (IZR (Int_part r2))));
- Rewrite -> (Ropp_distr1 r2 (Ropp (IZR (Int_part r2))));
- Rewrite -> (Ropp_Ropp (IZR (Int_part r2)));
- Rewrite -> (Rplus_assoc r1 (Ropp r2)
- (Rplus (Ropp (IZR (Int_part r1))) (IZR (Int_part r2))));
- Rewrite -> (Rplus_assoc r1 (Ropp (IZR (Int_part r1)))
- (Rplus (Ropp r2) (IZR (Int_part r2))));
- Rewrite <- (Rplus_assoc (Ropp r2) (Ropp (IZR (Int_part r1)))
- (IZR (Int_part r2)));
- Rewrite <- (Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp r2)
- (IZR (Int_part r2)));
- Rewrite -> (Rplus_sym (Ropp r2) (Ropp (IZR (Int_part r1))));Auto with zarith real.
+Lemma Rminus_fp1 :
+ forall r1 r2:R,
+ frac_part r1 >= frac_part r2 ->
+ frac_part (r1 - r2) = frac_part r1 - frac_part r2.
+intros; unfold frac_part in |- *; generalize (Rminus_Int_part1 r1 r2 H);
+ intro; rewrite H0; rewrite <- (Z_R_minus (Int_part r1) (Int_part r2));
+ unfold Rminus in |- *;
+ rewrite (Ropp_plus_distr (IZR (Int_part r1)) (- IZR (Int_part r2)));
+ rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2)));
+ rewrite (Ropp_involutive (IZR (Int_part r2)));
+ rewrite (Rplus_assoc r1 (- r2) (- IZR (Int_part r1) + IZR (Int_part r2)));
+ rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2)));
+ rewrite <- (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2)));
+ rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2)));
+ rewrite (Rplus_comm (- r2) (- IZR (Int_part r1)));
+ auto with zarith real.
Qed.
(**********)
-Lemma Rminus_fp2:(r1,r2:R)(Rlt (frac_part r1) (frac_part r2))->
- (frac_part (Rminus r1 r2))==
- (Rplus (Rminus (frac_part r1) (frac_part r2)) R1).
-Intros;Unfold frac_part;Generalize (Rminus_Int_part2 r1 r2 H);Intro;
- Rewrite -> H0;
- Rewrite <- (Z_R_minus (Zminus (Int_part r1) (Int_part r2)) `1`);
- Rewrite <- (Z_R_minus (Int_part r1) (Int_part r2));Unfold Rminus;
- Rewrite -> (Ropp_distr1 (Rplus (IZR (Int_part r1)) (Ropp (IZR (Int_part r2))))
- (Ropp (IZR `1`)));
- Rewrite -> (Ropp_distr1 r2 (Ropp (IZR (Int_part r2))));
- Rewrite -> (Ropp_Ropp (IZR `1`));
- Rewrite -> (Ropp_Ropp (IZR (Int_part r2)));
- Rewrite -> (Ropp_distr1 (IZR (Int_part r1)));
- Rewrite -> (Ropp_Ropp (IZR (Int_part r2)));Simpl;
- Rewrite <- (Rplus_assoc (Rplus r1 (Ropp r2))
- (Rplus (Ropp (IZR (Int_part r1))) (IZR (Int_part r2))) R1);
- Rewrite -> (Rplus_assoc r1 (Ropp r2)
- (Rplus (Ropp (IZR (Int_part r1))) (IZR (Int_part r2))));
- Rewrite -> (Rplus_assoc r1 (Ropp (IZR (Int_part r1)))
- (Rplus (Ropp r2) (IZR (Int_part r2))));
- Rewrite <- (Rplus_assoc (Ropp r2) (Ropp (IZR (Int_part r1)))
- (IZR (Int_part r2)));
- Rewrite <- (Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp r2)
- (IZR (Int_part r2)));
- Rewrite -> (Rplus_sym (Ropp r2) (Ropp (IZR (Int_part r1))));Auto with zarith real.
+Lemma Rminus_fp2 :
+ forall r1 r2:R,
+ frac_part r1 < frac_part r2 ->
+ frac_part (r1 - r2) = frac_part r1 - frac_part r2 + 1.
+intros; unfold frac_part in |- *; generalize (Rminus_Int_part2 r1 r2 H);
+ intro; rewrite H0; rewrite <- (Z_R_minus (Int_part r1 - Int_part r2) 1);
+ rewrite <- (Z_R_minus (Int_part r1) (Int_part r2));
+ unfold Rminus in |- *;
+ rewrite
+ (Ropp_plus_distr (IZR (Int_part r1) + - IZR (Int_part r2)) (- IZR 1))
+ ; rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2)));
+ rewrite (Ropp_involutive (IZR 1));
+ rewrite (Ropp_involutive (IZR (Int_part r2)));
+ rewrite (Ropp_plus_distr (IZR (Int_part r1)));
+ rewrite (Ropp_involutive (IZR (Int_part r2))); simpl in |- *;
+ rewrite <-
+ (Rplus_assoc (r1 + - r2) (- IZR (Int_part r1) + IZR (Int_part r2)) 1)
+ ; rewrite (Rplus_assoc r1 (- r2) (- IZR (Int_part r1) + IZR (Int_part r2)));
+ rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2)));
+ rewrite <- (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2)));
+ rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2)));
+ rewrite (Rplus_comm (- r2) (- IZR (Int_part r1)));
+ auto with zarith real.
Qed.
(**********)
-Lemma plus_Int_part1:(r1,r2:R)(Rge (Rplus (frac_part r1) (frac_part r2)) R1)->
- (Int_part (Rplus r1 r2))=(Zplus (Zplus (Int_part r1) (Int_part r2)) `1`).
-Intros;
- Generalize (Rle_sym2 R1 (Rplus (frac_part r1) (frac_part r2)) H);
- Intro;Clear H;Elim (base_fp r1);Elim (base_fp r2);Intros;Clear H H2;
- Generalize (Rlt_compatibility (frac_part r2) (frac_part r1) R1 H3);
- Intro;Clear H3;
- Generalize (Rlt_compatibility R1 (frac_part r2) R1 H1);Intro;Clear H1;
- Rewrite (Rplus_sym R1 (frac_part r2)) in H2;
- Generalize (Rlt_trans (Rplus (frac_part r2) (frac_part r1))
- (Rplus (frac_part r2) R1) (Rplus R1 R1) H H2);Intro;Clear H H2;
- Rewrite (Rplus_sym (frac_part r2) (frac_part r1)) in H1;
- Unfold frac_part in H0 H1;Unfold Rminus in H0 H1;
- Rewrite (Rplus_assoc r1 (Ropp (IZR (Int_part r1)))
- (Rplus r2 (Ropp (IZR (Int_part r2))))) in H1;
- Rewrite (Rplus_sym r2 (Ropp (IZR (Int_part r2)))) in H1;
- Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))
- r2) in H1;
- Rewrite (Rplus_sym
- (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))) r2) in H1;
- Rewrite <-(Rplus_assoc r1 r2
- (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2))))) in H1;
- Rewrite <-(Ropp_distr1 (IZR (Int_part r1)) (IZR (Int_part r2))) in H1;
- Rewrite (Rplus_assoc r1 (Ropp (IZR (Int_part r1)))
- (Rplus r2 (Ropp (IZR (Int_part r2))))) in H0;
- Rewrite (Rplus_sym r2 (Ropp (IZR (Int_part r2)))) in H0;
- Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))
- r2) in H0;
- Rewrite (Rplus_sym
- (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))) r2) in H0;
- Rewrite <-(Rplus_assoc r1 r2
- (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2))))) in H0;
- Rewrite <-(Ropp_distr1 (IZR (Int_part r1)) (IZR (Int_part r2))) in H0;
- Generalize (Rle_compatibility (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))
- R1 (Rplus (Rplus r1 r2)
- (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))))) H0);Intro;
- Clear H0;
- Generalize (Rlt_compatibility (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))
- (Rplus (Rplus r1 r2)
- (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))))) (Rplus R1 R1) H1);
- Intro;Clear H1;
- Rewrite (Rplus_sym (Rplus r1 r2)
- (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))))) in H;
- Rewrite <-(Rplus_assoc (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))
- (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))) (Rplus r1 r2)) in H;
- Rewrite (Rplus_Ropp_r (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))) in H;
- Elim (Rplus_ne (Rplus r1 r2));Intros a b;Rewrite b in H;Clear a b;
- Rewrite (Rplus_sym (Rplus r1 r2)
- (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))))) in H0;
- Rewrite <-(Rplus_assoc (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))
- (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))) (Rplus r1 r2)) in H0;
- Rewrite (Rplus_Ropp_r (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))) in H0;
- Elim (Rplus_ne (Rplus r1 r2));Intros a b;Rewrite b in H0;Clear a b;
- Rewrite <-(Rplus_assoc (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))) R1 R1) in
- H0;Cut R1==(IZR `1`);Auto with zarith real.
-Intro;Rewrite H1 in H0;Rewrite H1 in H;Clear H1;
- Rewrite <-(plus_IZR (Int_part r1) (Int_part r2)) in H;
- Rewrite <-(plus_IZR (Int_part r1) (Int_part r2)) in H0;
- Rewrite <-(plus_IZR `(Int_part r1)+(Int_part r2)` `1`) in H;
- Rewrite <-(plus_IZR `(Int_part r1)+(Int_part r2)` `1`) in H0;
- Rewrite <-(plus_IZR `(Int_part r1)+(Int_part r2)+1` `1`) in H0;
- Generalize (up_tech (Rplus r1 r2) `(Int_part r1)+(Int_part r2)+1` H H0);Intro;
- Clear H H0;Unfold 1 Int_part;Omega.
+Lemma plus_Int_part1 :
+ forall r1 r2:R,
+ frac_part r1 + frac_part r2 >= 1 ->
+ Int_part (r1 + r2) = (Int_part r1 + Int_part r2 + 1)%Z.
+intros; generalize (Rge_le (frac_part r1 + frac_part r2) 1 H); intro; clear H;
+ elim (base_fp r1); elim (base_fp r2); intros; clear H H2;
+ generalize (Rplus_lt_compat_l (frac_part r2) (frac_part r1) 1 H3);
+ intro; clear H3; generalize (Rplus_lt_compat_l 1 (frac_part r2) 1 H1);
+ intro; clear H1; rewrite (Rplus_comm 1 (frac_part r2)) in H2;
+ generalize
+ (Rlt_trans (frac_part r2 + frac_part r1) (frac_part r2 + 1) 2 H H2);
+ intro; clear H H2; rewrite (Rplus_comm (frac_part r2) (frac_part r1)) in H1;
+ unfold frac_part in H0, H1; unfold Rminus in H0, H1;
+ rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2)))
+ in H1; rewrite (Rplus_comm r2 (- IZR (Int_part r2))) in H1;
+ rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2)
+ in H1;
+ rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2) in H1;
+ rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2)))
+ in H1;
+ rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H1;
+ rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2)))
+ in H0; rewrite (Rplus_comm r2 (- IZR (Int_part r2))) in H0;
+ rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2)
+ in H0;
+ rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2) in H0;
+ rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2)))
+ in H0;
+ rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H0;
+ generalize
+ (Rplus_le_compat_l (IZR (Int_part r1) + IZR (Int_part r2)) 1
+ (r1 + r2 + - (IZR (Int_part r1) + IZR (Int_part r2))) H0);
+ intro; clear H0;
+ generalize
+ (Rplus_lt_compat_l (IZR (Int_part r1) + IZR (Int_part r2))
+ (r1 + r2 + - (IZR (Int_part r1) + IZR (Int_part r2))) 2 H1);
+ intro; clear H1;
+ rewrite (Rplus_comm (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2))))
+ in H;
+ rewrite <-
+ (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2))
+ (- (IZR (Int_part r1) + IZR (Int_part r2))) (r1 + r2))
+ in H; rewrite (Rplus_opp_r (IZR (Int_part r1) + IZR (Int_part r2))) in H;
+ elim (Rplus_ne (r1 + r2)); intros a b; rewrite b in H;
+ clear a b;
+ rewrite (Rplus_comm (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2))))
+ in H0;
+ rewrite <-
+ (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2))
+ (- (IZR (Int_part r1) + IZR (Int_part r2))) (r1 + r2))
+ in H0; rewrite (Rplus_opp_r (IZR (Int_part r1) + IZR (Int_part r2))) in H0;
+ elim (Rplus_ne (r1 + r2)); intros a b; rewrite b in H0;
+ clear a b;
+ rewrite <- (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2)) 1 1) in H0;
+ cut (1 = IZR 1); auto with zarith real.
+intro; rewrite H1 in H0; rewrite H1 in H; clear H1;
+ rewrite <- (plus_IZR (Int_part r1) (Int_part r2)) in H;
+ rewrite <- (plus_IZR (Int_part r1) (Int_part r2)) in H0;
+ rewrite <- (plus_IZR (Int_part r1 + Int_part r2) 1) in H;
+ rewrite <- (plus_IZR (Int_part r1 + Int_part r2) 1) in H0;
+ rewrite <- (plus_IZR (Int_part r1 + Int_part r2 + 1) 1) in H0;
+ generalize (up_tech (r1 + r2) (Int_part r1 + Int_part r2 + 1) H H0);
+ intro; clear H H0; unfold Int_part at 1 in |- *; omega.
Qed.
(**********)
-Lemma plus_Int_part2:(r1,r2:R)(Rlt (Rplus (frac_part r1) (frac_part r2)) R1)->
- (Int_part (Rplus r1 r2))=(Zplus (Int_part r1) (Int_part r2)).
-Intros;Elim (base_fp r1);Elim (base_fp r2);Intros;Clear H1 H3;
- Generalize (Rle_sym2 R0 (frac_part r2) H0);Intro;Clear H0;
- Generalize (Rle_sym2 R0 (frac_part r1) H2);Intro;Clear H2;
- Generalize (Rle_compatibility (frac_part r1) R0 (frac_part r2) H1);
- Intro;Clear H1;Elim (Rplus_ne (frac_part r1));Intros a b;
- Rewrite a in H2;Clear a b;Generalize (Rle_trans R0 (frac_part r1)
- (Rplus (frac_part r1) (frac_part r2)) H0 H2);Intro;Clear H0 H2;
- Unfold frac_part in H H1;Unfold Rminus in H H1;
- Rewrite (Rplus_assoc r1 (Ropp (IZR (Int_part r1)))
- (Rplus r2 (Ropp (IZR (Int_part r2))))) in H1;
- Rewrite (Rplus_sym r2 (Ropp (IZR (Int_part r2)))) in H1;
- Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))
- r2) in H1;
- Rewrite (Rplus_sym
- (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))) r2) in H1;
- Rewrite <-(Rplus_assoc r1 r2
- (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2))))) in H1;
- Rewrite <-(Ropp_distr1 (IZR (Int_part r1)) (IZR (Int_part r2))) in H1;
- Rewrite (Rplus_assoc r1 (Ropp (IZR (Int_part r1)))
- (Rplus r2 (Ropp (IZR (Int_part r2))))) in H;
- Rewrite (Rplus_sym r2 (Ropp (IZR (Int_part r2)))) in H;
- Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))
- r2) in H;
- Rewrite (Rplus_sym
- (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))) r2) in H;
- Rewrite <-(Rplus_assoc r1 r2
- (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2))))) in H;
- Rewrite <-(Ropp_distr1 (IZR (Int_part r1)) (IZR (Int_part r2))) in H;
- Generalize (Rle_compatibility (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))
- R0 (Rplus (Rplus r1 r2)
- (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))))) H1);Intro;
- Clear H1;
- Generalize (Rlt_compatibility (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))
- (Rplus (Rplus r1 r2)
- (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))))) R1 H);
- Intro;Clear H;
- Rewrite (Rplus_sym (Rplus r1 r2)
- (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))))) in H1;
- Rewrite <-(Rplus_assoc (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))
- (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))) (Rplus r1 r2)) in H1;
- Rewrite (Rplus_Ropp_r (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))) in H1;
- Elim (Rplus_ne (Rplus r1 r2));Intros a b;Rewrite b in H1;Clear a b;
- Rewrite (Rplus_sym (Rplus r1 r2)
- (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))))) in H0;
- Rewrite <-(Rplus_assoc (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))
- (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))) (Rplus r1 r2)) in H0;
- Rewrite (Rplus_Ropp_r (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))) in H0;
- Elim (Rplus_ne (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))));Intros a b;
- Rewrite a in H0;Clear a b;Elim (Rplus_ne (Rplus r1 r2));Intros a b;
- Rewrite b in H0;Clear a b;Cut R1==(IZR `1`);Auto with zarith real.
-Intro;Rewrite H in H1;Clear H;
- Rewrite <-(plus_IZR (Int_part r1) (Int_part r2)) in H0;
- Rewrite <-(plus_IZR (Int_part r1) (Int_part r2)) in H1;
- Rewrite <-(plus_IZR `(Int_part r1)+(Int_part r2)` `1`) in H1;
- Generalize (up_tech (Rplus r1 r2) `(Int_part r1)+(Int_part r2)` H0 H1);Intro;
- Clear H0 H1;Unfold 1 Int_part;Omega.
+Lemma plus_Int_part2 :
+ forall r1 r2:R,
+ frac_part r1 + frac_part r2 < 1 ->
+ Int_part (r1 + r2) = (Int_part r1 + Int_part r2)%Z.
+intros; elim (base_fp r1); elim (base_fp r2); intros; clear H1 H3;
+ generalize (Rge_le (frac_part r2) 0 H0); intro; clear H0;
+ generalize (Rge_le (frac_part r1) 0 H2); intro; clear H2;
+ generalize (Rplus_le_compat_l (frac_part r1) 0 (frac_part r2) H1);
+ intro; clear H1; elim (Rplus_ne (frac_part r1)); intros a b;
+ rewrite a in H2; clear a b;
+ generalize (Rle_trans 0 (frac_part r1) (frac_part r1 + frac_part r2) H0 H2);
+ intro; clear H0 H2; unfold frac_part in H, H1; unfold Rminus in H, H1;
+ rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2)))
+ in H1; rewrite (Rplus_comm r2 (- IZR (Int_part r2))) in H1;
+ rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2)
+ in H1;
+ rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2) in H1;
+ rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2)))
+ in H1;
+ rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H1;
+ rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2)))
+ in H; rewrite (Rplus_comm r2 (- IZR (Int_part r2))) in H;
+ rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2) in H;
+ rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2) in H;
+ rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2)))
+ in H;
+ rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H;
+ generalize
+ (Rplus_le_compat_l (IZR (Int_part r1) + IZR (Int_part r2)) 0
+ (r1 + r2 + - (IZR (Int_part r1) + IZR (Int_part r2))) H1);
+ intro; clear H1;
+ generalize
+ (Rplus_lt_compat_l (IZR (Int_part r1) + IZR (Int_part r2))
+ (r1 + r2 + - (IZR (Int_part r1) + IZR (Int_part r2))) 1 H);
+ intro; clear H;
+ rewrite (Rplus_comm (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2))))
+ in H1;
+ rewrite <-
+ (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2))
+ (- (IZR (Int_part r1) + IZR (Int_part r2))) (r1 + r2))
+ in H1; rewrite (Rplus_opp_r (IZR (Int_part r1) + IZR (Int_part r2))) in H1;
+ elim (Rplus_ne (r1 + r2)); intros a b; rewrite b in H1;
+ clear a b;
+ rewrite (Rplus_comm (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2))))
+ in H0;
+ rewrite <-
+ (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2))
+ (- (IZR (Int_part r1) + IZR (Int_part r2))) (r1 + r2))
+ in H0; rewrite (Rplus_opp_r (IZR (Int_part r1) + IZR (Int_part r2))) in H0;
+ elim (Rplus_ne (IZR (Int_part r1) + IZR (Int_part r2)));
+ intros a b; rewrite a in H0; clear a b; elim (Rplus_ne (r1 + r2));
+ intros a b; rewrite b in H0; clear a b; cut (1 = IZR 1);
+ auto with zarith real.
+intro; rewrite H in H1; clear H;
+ rewrite <- (plus_IZR (Int_part r1) (Int_part r2)) in H0;
+ rewrite <- (plus_IZR (Int_part r1) (Int_part r2)) in H1;
+ rewrite <- (plus_IZR (Int_part r1 + Int_part r2) 1) in H1;
+ generalize (up_tech (r1 + r2) (Int_part r1 + Int_part r2) H0 H1);
+ intro; clear H0 H1; unfold Int_part at 1 in |- *;
+ omega.
Qed.
(**********)
-Lemma plus_frac_part1:(r1,r2:R)
- (Rge (Rplus (frac_part r1) (frac_part r2)) R1)->
- (frac_part (Rplus r1 r2))==
- (Rminus (Rplus (frac_part r1) (frac_part r2)) R1).
-Intros;Unfold frac_part;
- Generalize (plus_Int_part1 r1 r2 H);Intro;Rewrite H0;
- Rewrite (plus_IZR `(Int_part r1)+(Int_part r2)` `1`);
- Rewrite (plus_IZR (Int_part r1) (Int_part r2));Simpl;Unfold 3 4 Rminus;
- Rewrite (Rplus_assoc r1 (Ropp (IZR (Int_part r1)))
- (Rplus r2 (Ropp (IZR (Int_part r2)))));
- Rewrite (Rplus_sym r2 (Ropp (IZR (Int_part r2))));
- Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))
- r2);
- Rewrite (Rplus_sym
- (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))) r2);
- Rewrite <-(Rplus_assoc r1 r2
- (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))));
- Rewrite <-(Ropp_distr1 (IZR (Int_part r1)) (IZR (Int_part r2)));
- Unfold Rminus;
- Rewrite (Rplus_assoc (Rplus r1 r2)
- (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))))
- (Ropp R1));
- Rewrite <-(Ropp_distr1 (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))) R1);
- Trivial with zarith real.
+Lemma plus_frac_part1 :
+ forall r1 r2:R,
+ frac_part r1 + frac_part r2 >= 1 ->
+ frac_part (r1 + r2) = frac_part r1 + frac_part r2 - 1.
+intros; unfold frac_part in |- *; generalize (plus_Int_part1 r1 r2 H); intro;
+ rewrite H0; rewrite (plus_IZR (Int_part r1 + Int_part r2) 1);
+ rewrite (plus_IZR (Int_part r1) (Int_part r2)); simpl in |- *;
+ unfold Rminus at 3 4 in |- *;
+ rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2)));
+ rewrite (Rplus_comm r2 (- IZR (Int_part r2)));
+ rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2);
+ rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2);
+ rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2)));
+ rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2)));
+ unfold Rminus in |- *;
+ rewrite
+ (Rplus_assoc (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2))) (-1))
+ ; rewrite <- (Ropp_plus_distr (IZR (Int_part r1) + IZR (Int_part r2)) 1);
+ trivial with zarith real.
Qed.
(**********)
-Lemma plus_frac_part2:(r1,r2:R)
- (Rlt (Rplus (frac_part r1) (frac_part r2)) R1)->
-(frac_part (Rplus r1 r2))==(Rplus (frac_part r1) (frac_part r2)).
-Intros;Unfold frac_part;
- Generalize (plus_Int_part2 r1 r2 H);Intro;Rewrite H0;
- Rewrite (plus_IZR (Int_part r1) (Int_part r2));Unfold 2 3 Rminus;
- Rewrite (Rplus_assoc r1 (Ropp (IZR (Int_part r1)))
- (Rplus r2 (Ropp (IZR (Int_part r2)))));
- Rewrite (Rplus_sym r2 (Ropp (IZR (Int_part r2))));
- Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))
- r2);
- Rewrite (Rplus_sym
- (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))) r2);
- Rewrite <-(Rplus_assoc r1 r2
- (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))));
- Rewrite <-(Ropp_distr1 (IZR (Int_part r1)) (IZR (Int_part r2)));Unfold Rminus;
- Trivial with zarith real.
-Qed.
+Lemma plus_frac_part2 :
+ forall r1 r2:R,
+ frac_part r1 + frac_part r2 < 1 ->
+ frac_part (r1 + r2) = frac_part r1 + frac_part r2.
+intros; unfold frac_part in |- *; generalize (plus_Int_part2 r1 r2 H); intro;
+ rewrite H0; rewrite (plus_IZR (Int_part r1) (Int_part r2));
+ unfold Rminus at 2 3 in |- *;
+ rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2)));
+ rewrite (Rplus_comm r2 (- IZR (Int_part r2)));
+ rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2);
+ rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2);
+ rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2)));
+ rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2)));
+ unfold Rminus in |- *; trivial with zarith real.
+Qed. \ No newline at end of file
diff --git a/theories/Reals/R_sqr.v b/theories/Reals/R_sqr.v
index 0610db3be..1abe6d925 100644
--- a/theories/Reals/R_sqr.v
+++ b/theories/Reals/R_sqr.v
@@ -8,225 +8,323 @@
(*i $Id$ i*)
-Require Rbase.
-Require Rbasic_fun.
-V7only [Import R_scope.]. Open Local Scope R_scope.
+Require Import Rbase.
+Require Import Rbasic_fun. Open Local Scope R_scope.
(****************************************************)
(* Rsqr : some results *)
(****************************************************)
-Tactic Definition SqRing := Unfold Rsqr; Ring.
+Ltac ring_Rsqr := unfold Rsqr in |- *; ring.
-Lemma Rsqr_neg : (x:R) ``(Rsqr x)==(Rsqr (-x))``.
-Intros; SqRing.
+Lemma Rsqr_neg : forall x:R, Rsqr x = Rsqr (- x).
+intros; ring_Rsqr.
Qed.
-Lemma Rsqr_times : (x,y:R) ``(Rsqr (x*y))==(Rsqr x)*(Rsqr y)``.
-Intros; SqRing.
+Lemma Rsqr_mult : forall x y:R, Rsqr (x * y) = Rsqr x * Rsqr y.
+intros; ring_Rsqr.
Qed.
-Lemma Rsqr_plus : (x,y:R) ``(Rsqr (x+y))==(Rsqr x)+(Rsqr y)+2*x*y``.
-Intros; SqRing.
+Lemma Rsqr_plus : forall x y:R, Rsqr (x + y) = Rsqr x + Rsqr y + 2 * x * y.
+intros; ring_Rsqr.
Qed.
-Lemma Rsqr_minus : (x,y:R) ``(Rsqr (x-y))==(Rsqr x)+(Rsqr y)-2*x*y``.
-Intros; SqRing.
+Lemma Rsqr_minus : forall x y:R, Rsqr (x - y) = Rsqr x + Rsqr y - 2 * x * y.
+intros; ring_Rsqr.
Qed.
-Lemma Rsqr_neg_minus : (x,y:R) ``(Rsqr (x-y))==(Rsqr (y-x))``.
-Intros; SqRing.
+Lemma Rsqr_neg_minus : forall x y:R, Rsqr (x - y) = Rsqr (y - x).
+intros; ring_Rsqr.
Qed.
-Lemma Rsqr_1 : ``(Rsqr 1)==1``.
-SqRing.
+Lemma Rsqr_1 : Rsqr 1 = 1.
+ring_Rsqr.
Qed.
-Lemma Rsqr_gt_0_0 : (x:R) ``0<(Rsqr x)`` -> ~``x==0``.
-Intros; Red; Intro; Rewrite H0 in H; Rewrite Rsqr_O in H; Elim (Rlt_antirefl ``0`` H).
+Lemma Rsqr_gt_0_0 : forall x:R, 0 < Rsqr x -> x <> 0.
+intros; red in |- *; intro; rewrite H0 in H; rewrite Rsqr_0 in H;
+ elim (Rlt_irrefl 0 H).
Qed.
-Lemma Rsqr_pos_lt : (x:R) ~(x==R0)->``0<(Rsqr x)``.
-Intros; Case (total_order R0 x); Intro; [Unfold Rsqr; Apply Rmult_lt_pos; Assumption | Elim H0; Intro; [Elim H; Symmetry; Exact H1 | Rewrite Rsqr_neg; Generalize (Rlt_Ropp x ``0`` H1); Rewrite Ropp_O; Intro; Unfold Rsqr; Apply Rmult_lt_pos; Assumption]].
+Lemma Rsqr_pos_lt : forall x:R, x <> 0 -> 0 < Rsqr x.
+intros; case (Rtotal_order 0 x); intro;
+ [ unfold Rsqr in |- *; apply Rmult_lt_0_compat; assumption
+ | elim H0; intro;
+ [ elim H; symmetry in |- *; exact H1
+ | rewrite Rsqr_neg; generalize (Ropp_lt_gt_contravar x 0 H1);
+ rewrite Ropp_0; intro; unfold Rsqr in |- *;
+ apply Rmult_lt_0_compat; assumption ] ].
Qed.
-Lemma Rsqr_div : (x,y:R) ~``y==0`` -> ``(Rsqr (x/y))==(Rsqr x)/(Rsqr y)``.
-Intros; Unfold Rsqr.
-Unfold Rdiv.
-Rewrite Rinv_Rmult.
-Repeat Rewrite Rmult_assoc.
-Apply Rmult_mult_r.
-Pattern 2 x; Rewrite Rmult_sym.
-Repeat Rewrite Rmult_assoc.
-Apply Rmult_mult_r.
-Reflexivity.
-Assumption.
-Assumption.
+Lemma Rsqr_div : forall x y:R, y <> 0 -> Rsqr (x / y) = Rsqr x / Rsqr y.
+intros; unfold Rsqr in |- *.
+unfold Rdiv in |- *.
+rewrite Rinv_mult_distr.
+repeat rewrite Rmult_assoc.
+apply Rmult_eq_compat_l.
+pattern x at 2 in |- *; rewrite Rmult_comm.
+repeat rewrite Rmult_assoc.
+apply Rmult_eq_compat_l.
+reflexivity.
+assumption.
+assumption.
Qed.
-Lemma Rsqr_eq_0 : (x:R) ``(Rsqr x)==0`` -> ``x==0``.
-Unfold Rsqr; Intros; Generalize (without_div_Od x x H); Intro; Elim H0; Intro ; Assumption.
+Lemma Rsqr_eq_0 : forall x:R, Rsqr x = 0 -> x = 0.
+unfold Rsqr in |- *; intros; generalize (Rmult_integral x x H); intro;
+ elim H0; intro; assumption.
Qed.
-Lemma Rsqr_minus_plus : (a,b:R) ``(a-b)*(a+b)==(Rsqr a)-(Rsqr b)``.
-Intros; SqRing.
+Lemma Rsqr_minus_plus : forall a b:R, (a - b) * (a + b) = Rsqr a - Rsqr b.
+intros; ring_Rsqr.
Qed.
-Lemma Rsqr_plus_minus : (a,b:R) ``(a+b)*(a-b)==(Rsqr a)-(Rsqr b)``.
-Intros; SqRing.
+Lemma Rsqr_plus_minus : forall a b:R, (a + b) * (a - b) = Rsqr a - Rsqr b.
+intros; ring_Rsqr.
Qed.
-Lemma Rsqr_incr_0 : (x,y:R) ``(Rsqr x)<=(Rsqr y)`` -> ``0<=x`` -> ``0<=y`` -> ``x<=y``.
-Intros; Case (total_order_Rle x y); Intro; [Assumption | Cut ``y<x``; [Intro; Unfold Rsqr in H; Generalize (Rmult_lt2 y x y x H1 H1 H2 H2); Intro; Generalize (Rle_lt_trans ``x*x`` ``y*y`` ``x*x`` H H3); Intro; Elim (Rlt_antirefl ``x*x`` H4) | Auto with real]].
+Lemma Rsqr_incr_0 :
+ forall x y:R, Rsqr x <= Rsqr y -> 0 <= x -> 0 <= y -> x <= y.
+intros; case (Rle_dec x y); intro;
+ [ assumption
+ | cut (y < x);
+ [ intro; unfold Rsqr in H;
+ generalize (Rmult_le_0_lt_compat y x y x H1 H1 H2 H2);
+ intro; generalize (Rle_lt_trans (x * x) (y * y) (x * x) H H3);
+ intro; elim (Rlt_irrefl (x * x) H4)
+ | auto with real ] ].
Qed.
-Lemma Rsqr_incr_0_var : (x,y:R) ``(Rsqr x)<=(Rsqr y)`` -> ``0<=y`` -> ``x<=y``.
-Intros; Case (total_order_Rle x y); Intro; [Assumption | Cut ``y<x``; [Intro; Unfold Rsqr in H; Generalize (Rmult_lt2 y x y x H0 H0 H1 H1); Intro; Generalize (Rle_lt_trans ``x*x`` ``y*y`` ``x*x`` H H2); Intro; Elim (Rlt_antirefl ``x*x`` H3) | Auto with real]].
+Lemma Rsqr_incr_0_var : forall x y:R, Rsqr x <= Rsqr y -> 0 <= y -> x <= y.
+intros; case (Rle_dec x y); intro;
+ [ assumption
+ | cut (y < x);
+ [ intro; unfold Rsqr in H;
+ generalize (Rmult_le_0_lt_compat y x y x H0 H0 H1 H1);
+ intro; generalize (Rle_lt_trans (x * x) (y * y) (x * x) H H2);
+ intro; elim (Rlt_irrefl (x * x) H3)
+ | auto with real ] ].
Qed.
-Lemma Rsqr_incr_1 : (x,y:R) ``x<=y``->``0<=x``->``0<= y``->``(Rsqr x)<=(Rsqr y)``.
-Intros; Unfold Rsqr; Apply Rle_Rmult_comp; Assumption.
+Lemma Rsqr_incr_1 :
+ forall x y:R, x <= y -> 0 <= x -> 0 <= y -> Rsqr x <= Rsqr y.
+intros; unfold Rsqr in |- *; apply Rmult_le_compat; assumption.
Qed.
-Lemma Rsqr_incrst_0 : (x,y:R) ``(Rsqr x)<(Rsqr y)``->``0<=x``->``0<=y``-> ``x<y``.
-Intros; Case (total_order x y); Intro; [Assumption | Elim H2; Intro; [Rewrite H3 in H; Elim (Rlt_antirefl (Rsqr y) H) | Generalize (Rmult_lt2 y x y x H1 H1 H3 H3); Intro; Unfold Rsqr in H; Generalize (Rlt_trans ``x*x`` ``y*y`` ``x*x`` H H4); Intro; Elim (Rlt_antirefl ``x*x`` H5)]].
+Lemma Rsqr_incrst_0 :
+ forall x y:R, Rsqr x < Rsqr y -> 0 <= x -> 0 <= y -> x < y.
+intros; case (Rtotal_order x y); intro;
+ [ assumption
+ | elim H2; intro;
+ [ rewrite H3 in H; elim (Rlt_irrefl (Rsqr y) H)
+ | generalize (Rmult_le_0_lt_compat y x y x H1 H1 H3 H3); intro;
+ unfold Rsqr in H; generalize (Rlt_trans (x * x) (y * y) (x * x) H H4);
+ intro; elim (Rlt_irrefl (x * x) H5) ] ].
Qed.
-Lemma Rsqr_incrst_1 : (x,y:R) ``x<y``->``0<=x``->``0<=y``->``(Rsqr x)<(Rsqr y)``.
-Intros; Unfold Rsqr; Apply Rmult_lt2; Assumption.
+Lemma Rsqr_incrst_1 :
+ forall x y:R, x < y -> 0 <= x -> 0 <= y -> Rsqr x < Rsqr y.
+intros; unfold Rsqr in |- *; apply Rmult_le_0_lt_compat; assumption.
Qed.
-Lemma Rsqr_neg_pos_le_0 : (x,y:R) ``(Rsqr x)<=(Rsqr y)``->``0<=y``->``-y<=x``.
-Intros; Case (case_Rabsolu x); Intro.
-Generalize (Rlt_Ropp x ``0`` r); Rewrite Ropp_O; Intro; Generalize (Rlt_le ``0`` ``-x`` H1); Intro; Rewrite (Rsqr_neg x) in H; Generalize (Rsqr_incr_0 (Ropp x) y H H2 H0); Intro; Rewrite <- (Ropp_Ropp x); Apply Rge_Ropp; Apply Rle_sym1; Assumption.
-Apply Rle_trans with ``0``; [Rewrite <- Ropp_O; Apply Rge_Ropp; Apply Rle_sym1; Assumption | Apply Rle_sym2; Assumption].
-Qed.
-
-Lemma Rsqr_neg_pos_le_1 : (x,y:R) ``(-y)<=x`` -> ``x<=y`` -> ``0<=y`` -> ``(Rsqr x)<=(Rsqr y)``.
-Intros; Case (case_Rabsolu x); Intro.
-Generalize (Rlt_Ropp x ``0`` r); Rewrite Ropp_O; Intro; Generalize (Rlt_le ``0`` ``-x`` H2); Intro; Generalize (Rle_Ropp ``-y`` x H); Rewrite Ropp_Ropp; Intro; Generalize (Rle_sym2 ``-x`` y H4); Intro; Rewrite (Rsqr_neg x); Apply Rsqr_incr_1; Assumption.
-Generalize (Rle_sym2 ``0`` x r); Intro; Apply Rsqr_incr_1; Assumption.
-Qed.
-
-Lemma neg_pos_Rsqr_le : (x,y:R) ``(-y)<=x``->``x<=y``->``(Rsqr x)<=(Rsqr y)``.
-Intros; Case (case_Rabsolu x); Intro.
-Generalize (Rlt_Ropp x ``0`` r); Rewrite Ropp_O; Intro; Generalize (Rle_Ropp ``-y`` x H); Rewrite Ropp_Ropp; Intro; Generalize (Rle_sym2 ``-x`` y H2); Intro; Generalize (Rlt_le ``0`` ``-x`` H1); Intro; Generalize (Rle_trans ``0`` ``-x`` y H4 H3); Intro; Rewrite (Rsqr_neg x); Apply Rsqr_incr_1; Assumption.
-Generalize (Rle_sym2 ``0`` x r); Intro; Generalize (Rle_trans ``0`` x y H1 H0); Intro; Apply Rsqr_incr_1; Assumption.
-Qed.
-
-Lemma Rsqr_abs : (x:R) ``(Rsqr x)==(Rsqr (Rabsolu x))``.
-Intro; Unfold Rabsolu; Case (case_Rabsolu x); Intro; [Apply Rsqr_neg | Reflexivity].
-Qed.
-
-Lemma Rsqr_le_abs_0 : (x,y:R) ``(Rsqr x)<=(Rsqr y)`` -> ``(Rabsolu x)<=(Rabsolu y)``.
-Intros; Apply Rsqr_incr_0; Repeat Rewrite <- Rsqr_abs; [Assumption | Apply Rabsolu_pos | Apply Rabsolu_pos].
-Qed.
-
-Lemma Rsqr_le_abs_1 : (x,y:R) ``(Rabsolu x)<=(Rabsolu y)`` -> ``(Rsqr x)<=(Rsqr y)``.
-Intros; Rewrite (Rsqr_abs x); Rewrite (Rsqr_abs y); Apply (Rsqr_incr_1 (Rabsolu x) (Rabsolu y) H (Rabsolu_pos x) (Rabsolu_pos y)).
-Qed.
-
-Lemma Rsqr_lt_abs_0 : (x,y:R) ``(Rsqr x)<(Rsqr y)`` -> ``(Rabsolu x)<(Rabsolu y)``.
-Intros; Apply Rsqr_incrst_0; Repeat Rewrite <- Rsqr_abs; [Assumption | Apply Rabsolu_pos | Apply Rabsolu_pos].
-Qed.
-
-Lemma Rsqr_lt_abs_1 : (x,y:R) ``(Rabsolu x)<(Rabsolu y)`` -> ``(Rsqr x)<(Rsqr y)``.
-Intros; Rewrite (Rsqr_abs x); Rewrite (Rsqr_abs y); Apply (Rsqr_incrst_1 (Rabsolu x) (Rabsolu y) H (Rabsolu_pos x) (Rabsolu_pos y)).
-Qed.
-
-Lemma Rsqr_inj : (x,y:R) ``0<=x`` -> ``0<=y`` -> (Rsqr x)==(Rsqr y) -> x==y.
-Intros; Generalize (Rle_le_eq (Rsqr x) (Rsqr y)); Intro; Elim H2; Intros _ H3; Generalize (H3 H1); Intro; Elim H4; Intros; Apply Rle_antisym; Apply Rsqr_incr_0; Assumption.
-Qed.
-
-Lemma Rsqr_eq_abs_0 : (x,y:R) (Rsqr x)==(Rsqr y) -> (Rabsolu x)==(Rabsolu y).
-Intros; Unfold Rabsolu; Case (case_Rabsolu x); Case (case_Rabsolu y); Intros.
-Rewrite -> (Rsqr_neg x) in H; Rewrite -> (Rsqr_neg y) in H; Generalize (Rlt_Ropp y ``0`` r); Generalize (Rlt_Ropp x ``0`` r0); Rewrite Ropp_O; Intros; Generalize (Rlt_le ``0`` ``-x`` H0); Generalize (Rlt_le ``0`` ``-y`` H1); Intros; Apply Rsqr_inj; Assumption.
-Rewrite -> (Rsqr_neg x) in H; Generalize (Rle_sym2 ``0`` y r); Intro; Generalize (Rlt_Ropp x ``0`` r0); Rewrite Ropp_O; Intro; Generalize (Rlt_le ``0`` ``-x`` H1); Intro; Apply Rsqr_inj; Assumption.
-Rewrite -> (Rsqr_neg y) in H; Generalize (Rle_sym2 ``0`` x r0); Intro; Generalize (Rlt_Ropp y ``0`` r); Rewrite Ropp_O; Intro; Generalize (Rlt_le ``0`` ``-y`` H1); Intro; Apply Rsqr_inj; Assumption.
-Generalize (Rle_sym2 ``0`` x r0); Generalize (Rle_sym2 ``0`` y r); Intros; Apply Rsqr_inj; Assumption.
-Qed.
-
-Lemma Rsqr_eq_asb_1 : (x,y:R) (Rabsolu x)==(Rabsolu y) -> (Rsqr x)==(Rsqr y).
-Intros; Cut ``(Rsqr (Rabsolu x))==(Rsqr (Rabsolu y))``.
-Intro; Repeat Rewrite <- Rsqr_abs in H0; Assumption.
-Rewrite H; Reflexivity.
-Qed.
-
-Lemma triangle_rectangle : (x,y,z:R) ``0<=z``->``(Rsqr x)+(Rsqr y)<=(Rsqr z)``->``-z<=x<=z`` /\``-z<=y<=z``.
-Intros; Generalize (plus_le_is_le (Rsqr x) (Rsqr y) (Rsqr z) (pos_Rsqr y) H0); Rewrite Rplus_sym in H0; Generalize (plus_le_is_le (Rsqr y) (Rsqr x) (Rsqr z) (pos_Rsqr x) H0); Intros; Split; [Split; [Apply Rsqr_neg_pos_le_0; Assumption | Apply Rsqr_incr_0_var; Assumption] | Split; [Apply Rsqr_neg_pos_le_0; Assumption | Apply Rsqr_incr_0_var; Assumption]].
-Qed.
-
-Lemma triangle_rectangle_lt : (x,y,z:R) ``(Rsqr x)+(Rsqr y)<(Rsqr z)`` -> ``(Rabsolu x)<(Rabsolu z)``/\``(Rabsolu y)<(Rabsolu z)``.
-Intros; Split; [Generalize (plus_lt_is_lt (Rsqr x) (Rsqr y) (Rsqr z) (pos_Rsqr y) H); Intro; Apply Rsqr_lt_abs_0; Assumption | Rewrite Rplus_sym in H; Generalize (plus_lt_is_lt (Rsqr y) (Rsqr x) (Rsqr z) (pos_Rsqr x) H); Intro; Apply Rsqr_lt_abs_0; Assumption].
-Qed.
-
-Lemma triangle_rectangle_le : (x,y,z:R) ``(Rsqr x)+(Rsqr y)<=(Rsqr z)`` -> ``(Rabsolu x)<=(Rabsolu z)``/\``(Rabsolu y)<=(Rabsolu z)``.
-Intros; Split; [Generalize (plus_le_is_le (Rsqr x) (Rsqr y) (Rsqr z) (pos_Rsqr y) H); Intro; Apply Rsqr_le_abs_0; Assumption | Rewrite Rplus_sym in H; Generalize (plus_le_is_le (Rsqr y) (Rsqr x) (Rsqr z) (pos_Rsqr x) H); Intro; Apply Rsqr_le_abs_0; Assumption].
-Qed.
-
-Lemma Rsqr_inv : (x:R) ~``x==0`` -> ``(Rsqr (/x))==/(Rsqr x)``.
-Intros; Unfold Rsqr.
-Rewrite Rinv_Rmult; Try Reflexivity Orelse Assumption.
-Qed.
-
-Lemma canonical_Rsqr : (a:nonzeroreal;b,c,x:R) ``a*(Rsqr x)+b*x+c == a* (Rsqr (x+b/(2*a))) + (4*a*c - (Rsqr b))/(4*a)``.
-Intros.
-Rewrite Rsqr_plus.
-Repeat Rewrite Rmult_Rplus_distr.
-Repeat Rewrite Rplus_assoc.
-Apply Rplus_plus_r.
-Unfold Rdiv Rminus.
-Replace ``2*1+2*1`` with ``4``; [Idtac | Ring].
-Rewrite (Rmult_Rplus_distrl ``4*a*c`` ``-(Rsqr b)`` ``/(4*a)``).
-Rewrite Rsqr_times.
-Repeat Rewrite Rinv_Rmult.
-Repeat Rewrite (Rmult_sym a).
-Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Rewrite (Rmult_sym ``2``).
-Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Rewrite (Rmult_sym ``/2``).
-Rewrite (Rmult_sym ``2``).
-Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Rewrite (Rmult_sym a).
-Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Rewrite (Rmult_sym ``2``).
-Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Repeat Rewrite Rplus_assoc.
-Rewrite (Rplus_sym ``(Rsqr b)*((Rsqr (/a*/2))*a)``).
-Repeat Rewrite Rplus_assoc.
-Rewrite (Rmult_sym x).
-Apply Rplus_plus_r.
-Rewrite (Rmult_sym ``/a``).
-Unfold Rsqr; Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Ring.
-Apply (cond_nonzero a).
-DiscrR.
-Apply (cond_nonzero a).
-DiscrR.
-DiscrR.
-Apply (cond_nonzero a).
-DiscrR.
-DiscrR.
-DiscrR.
-Apply (cond_nonzero a).
-DiscrR.
-Apply (cond_nonzero a).
-Qed.
-
-Lemma Rsqr_eq : (x,y:R) (Rsqr x)==(Rsqr y) -> x==y \/ x==``-y``.
-Intros; Unfold Rsqr in H; Generalize (Rplus_plus_r ``-(y*y)`` ``x*x`` ``y*y`` H); Rewrite Rplus_Ropp_l; Replace ``-(y*y)+x*x`` with ``(x-y)*(x+y)``.
-Intro; Generalize (without_div_Od ``x-y`` ``x+y`` H0); Intro; Elim H1; Intros.
-Left; Apply Rminus_eq; Assumption.
-Right; Apply Rminus_eq; Unfold Rminus; Rewrite Ropp_Ropp; Assumption.
-Ring.
-Qed.
+Lemma Rsqr_neg_pos_le_0 :
+ forall x y:R, Rsqr x <= Rsqr y -> 0 <= y -> - y <= x.
+intros; case (Rcase_abs x); intro.
+generalize (Ropp_lt_gt_contravar x 0 r); rewrite Ropp_0; intro;
+ generalize (Rlt_le 0 (- x) H1); intro; rewrite (Rsqr_neg x) in H;
+ generalize (Rsqr_incr_0 (- x) y H H2 H0); intro;
+ rewrite <- (Ropp_involutive x); apply Ropp_ge_le_contravar;
+ apply Rle_ge; assumption.
+apply Rle_trans with 0;
+ [ rewrite <- Ropp_0; apply Ropp_ge_le_contravar; apply Rle_ge; assumption
+ | apply Rge_le; assumption ].
+Qed.
+
+Lemma Rsqr_neg_pos_le_1 :
+ forall x y:R, - y <= x -> x <= y -> 0 <= y -> Rsqr x <= Rsqr y.
+intros; case (Rcase_abs x); intro.
+generalize (Ropp_lt_gt_contravar x 0 r); rewrite Ropp_0; intro;
+ generalize (Rlt_le 0 (- x) H2); intro;
+ generalize (Ropp_le_ge_contravar (- y) x H); rewrite Ropp_involutive;
+ intro; generalize (Rge_le y (- x) H4); intro; rewrite (Rsqr_neg x);
+ apply Rsqr_incr_1; assumption.
+generalize (Rge_le x 0 r); intro; apply Rsqr_incr_1; assumption.
+Qed.
+
+Lemma neg_pos_Rsqr_le : forall x y:R, - y <= x -> x <= y -> Rsqr x <= Rsqr y.
+intros; case (Rcase_abs x); intro.
+generalize (Ropp_lt_gt_contravar x 0 r); rewrite Ropp_0; intro;
+ generalize (Ropp_le_ge_contravar (- y) x H); rewrite Ropp_involutive;
+ intro; generalize (Rge_le y (- x) H2); intro; generalize (Rlt_le 0 (- x) H1);
+ intro; generalize (Rle_trans 0 (- x) y H4 H3); intro;
+ rewrite (Rsqr_neg x); apply Rsqr_incr_1; assumption.
+generalize (Rge_le x 0 r); intro; generalize (Rle_trans 0 x y H1 H0); intro;
+ apply Rsqr_incr_1; assumption.
+Qed.
+
+Lemma Rsqr_abs : forall x:R, Rsqr x = Rsqr (Rabs x).
+intro; unfold Rabs in |- *; case (Rcase_abs x); intro;
+ [ apply Rsqr_neg | reflexivity ].
+Qed.
+
+Lemma Rsqr_le_abs_0 : forall x y:R, Rsqr x <= Rsqr y -> Rabs x <= Rabs y.
+intros; apply Rsqr_incr_0; repeat rewrite <- Rsqr_abs;
+ [ assumption | apply Rabs_pos | apply Rabs_pos ].
+Qed.
+
+Lemma Rsqr_le_abs_1 : forall x y:R, Rabs x <= Rabs y -> Rsqr x <= Rsqr y.
+intros; rewrite (Rsqr_abs x); rewrite (Rsqr_abs y);
+ apply (Rsqr_incr_1 (Rabs x) (Rabs y) H (Rabs_pos x) (Rabs_pos y)).
+Qed.
+
+Lemma Rsqr_lt_abs_0 : forall x y:R, Rsqr x < Rsqr y -> Rabs x < Rabs y.
+intros; apply Rsqr_incrst_0; repeat rewrite <- Rsqr_abs;
+ [ assumption | apply Rabs_pos | apply Rabs_pos ].
+Qed.
+
+Lemma Rsqr_lt_abs_1 : forall x y:R, Rabs x < Rabs y -> Rsqr x < Rsqr y.
+intros; rewrite (Rsqr_abs x); rewrite (Rsqr_abs y);
+ apply (Rsqr_incrst_1 (Rabs x) (Rabs y) H (Rabs_pos x) (Rabs_pos y)).
+Qed.
+
+Lemma Rsqr_inj : forall x y:R, 0 <= x -> 0 <= y -> Rsqr x = Rsqr y -> x = y.
+intros; generalize (Rle_le_eq (Rsqr x) (Rsqr y)); intro; elim H2; intros _ H3;
+ generalize (H3 H1); intro; elim H4; intros; apply Rle_antisym;
+ apply Rsqr_incr_0; assumption.
+Qed.
+
+Lemma Rsqr_eq_abs_0 : forall x y:R, Rsqr x = Rsqr y -> Rabs x = Rabs y.
+intros; unfold Rabs in |- *; case (Rcase_abs x); case (Rcase_abs y); intros.
+rewrite (Rsqr_neg x) in H; rewrite (Rsqr_neg y) in H;
+ generalize (Ropp_lt_gt_contravar y 0 r);
+ generalize (Ropp_lt_gt_contravar x 0 r0); rewrite Ropp_0;
+ intros; generalize (Rlt_le 0 (- x) H0); generalize (Rlt_le 0 (- y) H1);
+ intros; apply Rsqr_inj; assumption.
+rewrite (Rsqr_neg x) in H; generalize (Rge_le y 0 r); intro;
+ generalize (Ropp_lt_gt_contravar x 0 r0); rewrite Ropp_0;
+ intro; generalize (Rlt_le 0 (- x) H1); intro; apply Rsqr_inj;
+ assumption.
+rewrite (Rsqr_neg y) in H; generalize (Rge_le x 0 r0); intro;
+ generalize (Ropp_lt_gt_contravar y 0 r); rewrite Ropp_0;
+ intro; generalize (Rlt_le 0 (- y) H1); intro; apply Rsqr_inj;
+ assumption.
+generalize (Rge_le x 0 r0); generalize (Rge_le y 0 r); intros; apply Rsqr_inj;
+ assumption.
+Qed.
+
+Lemma Rsqr_eq_asb_1 : forall x y:R, Rabs x = Rabs y -> Rsqr x = Rsqr y.
+intros; cut (Rsqr (Rabs x) = Rsqr (Rabs y)).
+intro; repeat rewrite <- Rsqr_abs in H0; assumption.
+rewrite H; reflexivity.
+Qed.
+
+Lemma triangle_rectangle :
+ forall x y z:R,
+ 0 <= z -> Rsqr x + Rsqr y <= Rsqr z -> - z <= x <= z /\ - z <= y <= z.
+intros;
+ generalize (plus_le_is_le (Rsqr x) (Rsqr y) (Rsqr z) (Rle_0_sqr y) H0);
+ rewrite Rplus_comm in H0;
+ generalize (plus_le_is_le (Rsqr y) (Rsqr x) (Rsqr z) (Rle_0_sqr x) H0);
+ intros; split;
+ [ split;
+ [ apply Rsqr_neg_pos_le_0; assumption
+ | apply Rsqr_incr_0_var; assumption ]
+ | split;
+ [ apply Rsqr_neg_pos_le_0; assumption
+ | apply Rsqr_incr_0_var; assumption ] ].
+Qed.
+
+Lemma triangle_rectangle_lt :
+ forall x y z:R,
+ Rsqr x + Rsqr y < Rsqr z -> Rabs x < Rabs z /\ Rabs y < Rabs z.
+intros; split;
+ [ generalize (plus_lt_is_lt (Rsqr x) (Rsqr y) (Rsqr z) (Rle_0_sqr y) H);
+ intro; apply Rsqr_lt_abs_0; assumption
+ | rewrite Rplus_comm in H;
+ generalize (plus_lt_is_lt (Rsqr y) (Rsqr x) (Rsqr z) (Rle_0_sqr x) H);
+ intro; apply Rsqr_lt_abs_0; assumption ].
+Qed.
+
+Lemma triangle_rectangle_le :
+ forall x y z:R,
+ Rsqr x + Rsqr y <= Rsqr z -> Rabs x <= Rabs z /\ Rabs y <= Rabs z.
+intros; split;
+ [ generalize (plus_le_is_le (Rsqr x) (Rsqr y) (Rsqr z) (Rle_0_sqr y) H);
+ intro; apply Rsqr_le_abs_0; assumption
+ | rewrite Rplus_comm in H;
+ generalize (plus_le_is_le (Rsqr y) (Rsqr x) (Rsqr z) (Rle_0_sqr x) H);
+ intro; apply Rsqr_le_abs_0; assumption ].
+Qed.
+
+Lemma Rsqr_inv : forall x:R, x <> 0 -> Rsqr (/ x) = / Rsqr x.
+intros; unfold Rsqr in |- *.
+rewrite Rinv_mult_distr; try reflexivity || assumption.
+Qed.
+
+Lemma canonical_Rsqr :
+ forall (a:nonzeroreal) (b c x:R),
+ a * Rsqr x + b * x + c =
+ a * Rsqr (x + b / (2 * a)) + (4 * a * c - Rsqr b) / (4 * a).
+intros.
+rewrite Rsqr_plus.
+repeat rewrite Rmult_plus_distr_l.
+repeat rewrite Rplus_assoc.
+apply Rplus_eq_compat_l.
+unfold Rdiv, Rminus in |- *.
+replace (2 * 1 + 2 * 1) with 4; [ idtac | ring ].
+rewrite (Rmult_plus_distr_r (4 * a * c) (- Rsqr b) (/ (4 * a))).
+rewrite Rsqr_mult.
+repeat rewrite Rinv_mult_distr.
+repeat rewrite (Rmult_comm a).
+repeat rewrite Rmult_assoc.
+rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r.
+rewrite (Rmult_comm 2).
+repeat rewrite Rmult_assoc.
+rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r.
+rewrite (Rmult_comm (/ 2)).
+rewrite (Rmult_comm 2).
+repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r.
+rewrite (Rmult_comm a).
+repeat rewrite Rmult_assoc.
+rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r.
+rewrite (Rmult_comm 2).
+repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r.
+repeat rewrite Rplus_assoc.
+rewrite (Rplus_comm (Rsqr b * (Rsqr (/ a * / 2) * a))).
+repeat rewrite Rplus_assoc.
+rewrite (Rmult_comm x).
+apply Rplus_eq_compat_l.
+rewrite (Rmult_comm (/ a)).
+unfold Rsqr in |- *; repeat rewrite Rmult_assoc.
+rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r.
+ring.
+apply (cond_nonzero a).
+discrR.
+apply (cond_nonzero a).
+discrR.
+discrR.
+apply (cond_nonzero a).
+discrR.
+discrR.
+discrR.
+apply (cond_nonzero a).
+discrR.
+apply (cond_nonzero a).
+Qed.
+
+Lemma Rsqr_eq : forall x y:R, Rsqr x = Rsqr y -> x = y \/ x = - y.
+intros; unfold Rsqr in H;
+ generalize (Rplus_eq_compat_l (- (y * y)) (x * x) (y * y) H);
+ rewrite Rplus_opp_l; replace (- (y * y) + x * x) with ((x - y) * (x + y)).
+intro; generalize (Rmult_integral (x - y) (x + y) H0); intro; elim H1; intros.
+left; apply Rminus_diag_uniq; assumption.
+right; apply Rminus_diag_uniq; unfold Rminus in |- *; rewrite Ropp_involutive;
+ assumption.
+ring.
+Qed. \ No newline at end of file
diff --git a/theories/Reals/R_sqrt.v b/theories/Reals/R_sqrt.v
index 759e4b164..f4d5ccf1a 100644
--- a/theories/Reals/R_sqrt.v
+++ b/theories/Reals/R_sqrt.v
@@ -8,244 +8,392 @@
(*i $Id$ i*)
-Require Rbase.
-Require Rfunctions.
-Require Rsqrt_def.
-V7only [Import R_scope.]. Open Local Scope R_scope.
+Require Import Rbase.
+Require Import Rfunctions.
+Require Import Rsqrt_def. Open Local Scope R_scope.
(* Here is a continuous extension of Rsqrt on R *)
-Definition sqrt : R->R := [x:R](Cases (case_Rabsolu x) of
- (leftT _) => R0
- | (rightT a) => (Rsqrt (mknonnegreal x (Rle_sym2 ? ? a))) end).
-
-Lemma sqrt_positivity : (x:R) ``0<=x`` -> ``0<=(sqrt x)``.
-Intros.
-Unfold sqrt.
-Case (case_Rabsolu x); Intro.
-Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? r H)).
-Apply Rsqrt_positivity.
+Definition sqrt (x:R) : R :=
+ match Rcase_abs x with
+ | left _ => 0
+ | right a => Rsqrt (mknonnegreal x (Rge_le _ _ a))
+ end.
+
+Lemma sqrt_positivity : forall x:R, 0 <= x -> 0 <= sqrt x.
+intros.
+unfold sqrt in |- *.
+case (Rcase_abs x); intro.
+elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ r H)).
+apply Rsqrt_positivity.
Qed.
-Lemma sqrt_sqrt : (x:R) ``0<=x`` -> ``(sqrt x)*(sqrt x)==x``.
-Intros.
-Unfold sqrt.
-Case (case_Rabsolu x); Intro.
-Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? r H)).
-Rewrite Rsqrt_Rsqrt; Reflexivity.
+Lemma sqrt_sqrt : forall x:R, 0 <= x -> sqrt x * sqrt x = x.
+intros.
+unfold sqrt in |- *.
+case (Rcase_abs x); intro.
+elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ r H)).
+rewrite Rsqrt_Rsqrt; reflexivity.
Qed.
-Lemma sqrt_0 : ``(sqrt 0)==0``.
-Apply Rsqr_eq_0; Unfold Rsqr; Apply sqrt_sqrt; Right; Reflexivity.
+Lemma sqrt_0 : sqrt 0 = 0.
+apply Rsqr_eq_0; unfold Rsqr in |- *; apply sqrt_sqrt; right; reflexivity.
Qed.
-Lemma sqrt_1 : ``(sqrt 1)==1``.
-Apply (Rsqr_inj (sqrt R1) R1); [Apply sqrt_positivity; Left | Left | Unfold Rsqr; Rewrite -> sqrt_sqrt; [Ring | Left]]; Apply Rlt_R0_R1.
+Lemma sqrt_1 : sqrt 1 = 1.
+apply (Rsqr_inj (sqrt 1) 1);
+ [ apply sqrt_positivity; left
+ | left
+ | unfold Rsqr in |- *; rewrite sqrt_sqrt; [ ring | left ] ];
+ apply Rlt_0_1.
Qed.
-Lemma sqrt_eq_0 : (x:R) ``0<=x``->``(sqrt x)==0``->``x==0``.
-Intros; Cut ``(Rsqr (sqrt x))==0``.
-Intro; Unfold Rsqr in H1; Rewrite -> sqrt_sqrt in H1; Assumption.
-Rewrite H0; Apply Rsqr_O.
+Lemma sqrt_eq_0 : forall x:R, 0 <= x -> sqrt x = 0 -> x = 0.
+intros; cut (Rsqr (sqrt x) = 0).
+intro; unfold Rsqr in H1; rewrite sqrt_sqrt in H1; assumption.
+rewrite H0; apply Rsqr_0.
Qed.
-Lemma sqrt_lem_0 : (x,y:R) ``0<=x``->``0<=y``->(sqrt x)==y->``y*y==x``.
-Intros; Rewrite <- H1; Apply (sqrt_sqrt x H).
+Lemma sqrt_lem_0 : forall x y:R, 0 <= x -> 0 <= y -> sqrt x = y -> y * y = x.
+intros; rewrite <- H1; apply (sqrt_sqrt x H).
Qed.
-Lemma sqtr_lem_1 : (x,y:R) ``0<=x``->``0<=y``->``y*y==x``->(sqrt x)==y.
-Intros; Apply Rsqr_inj; [Apply (sqrt_positivity x H) | Assumption | Unfold Rsqr; Rewrite -> H1; Apply (sqrt_sqrt x H)].
+Lemma sqtr_lem_1 : forall x y:R, 0 <= x -> 0 <= y -> y * y = x -> sqrt x = y.
+intros; apply Rsqr_inj;
+ [ apply (sqrt_positivity x H)
+ | assumption
+ | unfold Rsqr in |- *; rewrite H1; apply (sqrt_sqrt x H) ].
Qed.
-Lemma sqrt_def : (x:R) ``0<=x``->``(sqrt x)*(sqrt x)==x``.
-Intros; Apply (sqrt_sqrt x H).
+Lemma sqrt_def : forall x:R, 0 <= x -> sqrt x * sqrt x = x.
+intros; apply (sqrt_sqrt x H).
Qed.
-Lemma sqrt_square : (x:R) ``0<=x``->``(sqrt (x*x))==x``.
-Intros; Apply (Rsqr_inj (sqrt (Rsqr x)) x (sqrt_positivity (Rsqr x) (pos_Rsqr x)) H); Unfold Rsqr; Apply (sqrt_sqrt (Rsqr x) (pos_Rsqr x)).
+Lemma sqrt_square : forall x:R, 0 <= x -> sqrt (x * x) = x.
+intros;
+ apply
+ (Rsqr_inj (sqrt (Rsqr x)) x (sqrt_positivity (Rsqr x) (Rle_0_sqr x)) H);
+ unfold Rsqr in |- *; apply (sqrt_sqrt (Rsqr x) (Rle_0_sqr x)).
Qed.
-Lemma sqrt_Rsqr : (x:R) ``0<=x``->``(sqrt (Rsqr x))==x``.
-Intros; Unfold Rsqr; Apply sqrt_square; Assumption.
+Lemma sqrt_Rsqr : forall x:R, 0 <= x -> sqrt (Rsqr x) = x.
+intros; unfold Rsqr in |- *; apply sqrt_square; assumption.
Qed.
-Lemma sqrt_Rsqr_abs : (x:R) (sqrt (Rsqr x))==(Rabsolu x).
-Intro x; Rewrite -> Rsqr_abs; Apply sqrt_Rsqr; Apply Rabsolu_pos.
+Lemma sqrt_Rsqr_abs : forall x:R, sqrt (Rsqr x) = Rabs x.
+intro x; rewrite Rsqr_abs; apply sqrt_Rsqr; apply Rabs_pos.
Qed.
-Lemma Rsqr_sqrt : (x:R) ``0<=x``->(Rsqr (sqrt x))==x.
-Intros x H1; Unfold Rsqr; Apply (sqrt_sqrt x H1).
+Lemma Rsqr_sqrt : forall x:R, 0 <= x -> Rsqr (sqrt x) = x.
+intros x H1; unfold Rsqr in |- *; apply (sqrt_sqrt x H1).
Qed.
-Lemma sqrt_times : (x,y:R) ``0<=x``->``0<=y``->``(sqrt (x*y))==(sqrt x)*(sqrt y)``.
-Intros x y H1 H2; Apply (Rsqr_inj (sqrt (Rmult x y)) (Rmult (sqrt x) (sqrt y)) (sqrt_positivity (Rmult x y) (Rmult_le_pos x y H1 H2)) (Rmult_le_pos (sqrt x) (sqrt y) (sqrt_positivity x H1) (sqrt_positivity y H2))); Rewrite Rsqr_times; Repeat Rewrite Rsqr_sqrt; [Ring | Assumption |Assumption | Apply (Rmult_le_pos x y H1 H2)].
+Lemma sqrt_mult :
+ forall x y:R, 0 <= x -> 0 <= y -> sqrt (x * y) = sqrt x * sqrt y.
+intros x y H1 H2;
+ apply
+ (Rsqr_inj (sqrt (x * y)) (sqrt x * sqrt y)
+ (sqrt_positivity (x * y) (Rmult_le_pos x y H1 H2))
+ (Rmult_le_pos (sqrt x) (sqrt y) (sqrt_positivity x H1)
+ (sqrt_positivity y H2))); rewrite Rsqr_mult;
+ repeat rewrite Rsqr_sqrt;
+ [ ring | assumption | assumption | apply (Rmult_le_pos x y H1 H2) ].
Qed.
-Lemma sqrt_lt_R0 : (x:R) ``0<x`` -> ``0<(sqrt x)``.
-Intros x H1; Apply Rsqr_incrst_0; [Rewrite Rsqr_O; Rewrite Rsqr_sqrt ; [Assumption | Left; Assumption] | Right; Reflexivity | Apply (sqrt_positivity x (Rlt_le R0 x H1))].
+Lemma sqrt_lt_R0 : forall x:R, 0 < x -> 0 < sqrt x.
+intros x H1; apply Rsqr_incrst_0;
+ [ rewrite Rsqr_0; rewrite Rsqr_sqrt; [ assumption | left; assumption ]
+ | right; reflexivity
+ | apply (sqrt_positivity x (Rlt_le 0 x H1)) ].
Qed.
-Lemma sqrt_div : (x,y:R) ``0<=x``->``0<y``->``(sqrt (x/y))==(sqrt x)/(sqrt y)``.
-Intros x y H1 H2; Apply Rsqr_inj; [ Apply sqrt_positivity; Apply (Rmult_le_pos x (Rinv y)); [ Assumption | Generalize (Rlt_Rinv y H2); Clear H2; Intro H2; Left; Assumption] | Apply (Rmult_le_pos (sqrt x) (Rinv (sqrt y))) ; [ Apply (sqrt_positivity x H1) | Generalize (sqrt_lt_R0 y H2); Clear H2; Intro H2; Generalize (Rlt_Rinv (sqrt y) H2); Clear H2; Intro H2; Left; Assumption] | Rewrite Rsqr_div; Repeat Rewrite Rsqr_sqrt; [ Reflexivity | Left; Assumption | Assumption | Generalize (Rlt_Rinv y H2); Intro H3; Generalize (Rlt_le R0 (Rinv y) H3); Intro H4; Apply (Rmult_le_pos x (Rinv y) H1 H4) |Red; Intro H3; Generalize (Rlt_le R0 y H2); Intro H4; Generalize (sqrt_eq_0 y H4 H3); Intro H5; Rewrite H5 in H2; Elim (Rlt_antirefl R0 H2)]].
+Lemma sqrt_div :
+ forall x y:R, 0 <= x -> 0 < y -> sqrt (x / y) = sqrt x / sqrt y.
+intros x y H1 H2; apply Rsqr_inj;
+ [ apply sqrt_positivity; apply (Rmult_le_pos x (/ y));
+ [ assumption
+ | generalize (Rinv_0_lt_compat y H2); clear H2; intro H2; left;
+ assumption ]
+ | apply (Rmult_le_pos (sqrt x) (/ sqrt y));
+ [ apply (sqrt_positivity x H1)
+ | generalize (sqrt_lt_R0 y H2); clear H2; intro H2;
+ generalize (Rinv_0_lt_compat (sqrt y) H2); clear H2;
+ intro H2; left; assumption ]
+ | rewrite Rsqr_div; repeat rewrite Rsqr_sqrt;
+ [ reflexivity
+ | left; assumption
+ | assumption
+ | generalize (Rinv_0_lt_compat y H2); intro H3;
+ generalize (Rlt_le 0 (/ y) H3); intro H4;
+ apply (Rmult_le_pos x (/ y) H1 H4)
+ | red in |- *; intro H3; generalize (Rlt_le 0 y H2); intro H4;
+ generalize (sqrt_eq_0 y H4 H3); intro H5; rewrite H5 in H2;
+ elim (Rlt_irrefl 0 H2) ] ].
Qed.
-Lemma sqrt_lt_0 : (x,y:R) ``0<=x``->``0<=y``->``(sqrt x)<(sqrt y)``->``x<y``.
-Intros x y H1 H2 H3; Generalize (Rsqr_incrst_1 (sqrt x) (sqrt y) H3 (sqrt_positivity x H1) (sqrt_positivity y H2)); Intro H4; Rewrite (Rsqr_sqrt x H1) in H4; Rewrite (Rsqr_sqrt y H2) in H4; Assumption.
+Lemma sqrt_lt_0 : forall x y:R, 0 <= x -> 0 <= y -> sqrt x < sqrt y -> x < y.
+intros x y H1 H2 H3;
+ generalize
+ (Rsqr_incrst_1 (sqrt x) (sqrt y) H3 (sqrt_positivity x H1)
+ (sqrt_positivity y H2)); intro H4; rewrite (Rsqr_sqrt x H1) in H4;
+ rewrite (Rsqr_sqrt y H2) in H4; assumption.
Qed.
-Lemma sqrt_lt_1 : (x,y:R) ``0<=x``->``0<=y``->``x<y``->``(sqrt x)<(sqrt y)``.
-Intros x y H1 H2 H3; Apply Rsqr_incrst_0; [Rewrite (Rsqr_sqrt x H1); Rewrite (Rsqr_sqrt y H2); Assumption | Apply (sqrt_positivity x H1) | Apply (sqrt_positivity y H2)].
+Lemma sqrt_lt_1 : forall x y:R, 0 <= x -> 0 <= y -> x < y -> sqrt x < sqrt y.
+intros x y H1 H2 H3; apply Rsqr_incrst_0;
+ [ rewrite (Rsqr_sqrt x H1); rewrite (Rsqr_sqrt y H2); assumption
+ | apply (sqrt_positivity x H1)
+ | apply (sqrt_positivity y H2) ].
Qed.
-Lemma sqrt_le_0 : (x,y:R) ``0<=x``->``0<=y``->``(sqrt x)<=(sqrt y)``->``x<=y``.
-Intros x y H1 H2 H3; Generalize (Rsqr_incr_1 (sqrt x) (sqrt y) H3 (sqrt_positivity x H1) (sqrt_positivity y H2)); Intro H4; Rewrite (Rsqr_sqrt x H1) in H4; Rewrite (Rsqr_sqrt y H2) in H4; Assumption.
+Lemma sqrt_le_0 :
+ forall x y:R, 0 <= x -> 0 <= y -> sqrt x <= sqrt y -> x <= y.
+intros x y H1 H2 H3;
+ generalize
+ (Rsqr_incr_1 (sqrt x) (sqrt y) H3 (sqrt_positivity x H1)
+ (sqrt_positivity y H2)); intro H4; rewrite (Rsqr_sqrt x H1) in H4;
+ rewrite (Rsqr_sqrt y H2) in H4; assumption.
Qed.
-Lemma sqrt_le_1 : (x,y:R) ``0<=x``->``0<=y``->``x<=y``->``(sqrt x)<=(sqrt y)``.
-Intros x y H1 H2 H3; Apply Rsqr_incr_0; [ Rewrite (Rsqr_sqrt x H1); Rewrite (Rsqr_sqrt y H2); Assumption | Apply (sqrt_positivity x H1) | Apply (sqrt_positivity y H2)].
+Lemma sqrt_le_1 :
+ forall x y:R, 0 <= x -> 0 <= y -> x <= y -> sqrt x <= sqrt y.
+intros x y H1 H2 H3; apply Rsqr_incr_0;
+ [ rewrite (Rsqr_sqrt x H1); rewrite (Rsqr_sqrt y H2); assumption
+ | apply (sqrt_positivity x H1)
+ | apply (sqrt_positivity y H2) ].
Qed.
-Lemma sqrt_inj : (x,y:R) ``0<=x``->``0<=y``->(sqrt x)==(sqrt y)->x==y.
-Intros; Cut ``(Rsqr (sqrt x))==(Rsqr (sqrt y))``.
-Intro; Rewrite (Rsqr_sqrt x H) in H2; Rewrite (Rsqr_sqrt y H0) in H2; Assumption.
-Rewrite H1; Reflexivity.
+Lemma sqrt_inj : forall x y:R, 0 <= x -> 0 <= y -> sqrt x = sqrt y -> x = y.
+intros; cut (Rsqr (sqrt x) = Rsqr (sqrt y)).
+intro; rewrite (Rsqr_sqrt x H) in H2; rewrite (Rsqr_sqrt y H0) in H2;
+ assumption.
+rewrite H1; reflexivity.
Qed.
-Lemma sqrt_less : (x:R) ``0<=x``->``1<x``->``(sqrt x)<x``.
-Intros x H1 H2; Generalize (sqrt_lt_1 R1 x (Rlt_le R0 R1 (Rlt_R0_R1)) H1 H2); Intro H3; Rewrite sqrt_1 in H3; Generalize (Rmult_ne (sqrt x)); Intro H4; Elim H4; Intros H5 H6; Rewrite <- H5; Pattern 2 x; Rewrite <- (sqrt_def x H1); Apply (Rlt_monotony (sqrt x) R1 (sqrt x) (sqrt_lt_R0 x (Rlt_trans R0 R1 x Rlt_R0_R1 H2)) H3).
+Lemma sqrt_less : forall x:R, 0 <= x -> 1 < x -> sqrt x < x.
+intros x H1 H2; generalize (sqrt_lt_1 1 x (Rlt_le 0 1 Rlt_0_1) H1 H2);
+ intro H3; rewrite sqrt_1 in H3; generalize (Rmult_ne (sqrt x));
+ intro H4; elim H4; intros H5 H6; rewrite <- H5; pattern x at 2 in |- *;
+ rewrite <- (sqrt_def x H1);
+ apply
+ (Rmult_lt_compat_l (sqrt x) 1 (sqrt x)
+ (sqrt_lt_R0 x (Rlt_trans 0 1 x Rlt_0_1 H2)) H3).
Qed.
-Lemma sqrt_more : (x:R) ``0<x``->``x<1``->``x<(sqrt x)``.
-Intros x H1 H2; Generalize (sqrt_lt_1 x R1 (Rlt_le R0 x H1) (Rlt_le R0 R1 (Rlt_R0_R1)) H2); Intro H3; Rewrite sqrt_1 in H3; Generalize (Rmult_ne (sqrt x)); Intro H4; Elim H4; Intros H5 H6; Rewrite <- H5; Pattern 1 x; Rewrite <- (sqrt_def x (Rlt_le R0 x H1)); Apply (Rlt_monotony (sqrt x) (sqrt x) R1 (sqrt_lt_R0 x H1) H3).
+Lemma sqrt_more : forall x:R, 0 < x -> x < 1 -> x < sqrt x.
+intros x H1 H2;
+ generalize (sqrt_lt_1 x 1 (Rlt_le 0 x H1) (Rlt_le 0 1 Rlt_0_1) H2);
+ intro H3; rewrite sqrt_1 in H3; generalize (Rmult_ne (sqrt x));
+ intro H4; elim H4; intros H5 H6; rewrite <- H5; pattern x at 1 in |- *;
+ rewrite <- (sqrt_def x (Rlt_le 0 x H1));
+ apply (Rmult_lt_compat_l (sqrt x) (sqrt x) 1 (sqrt_lt_R0 x H1) H3).
Qed.
-Lemma sqrt_cauchy : (a,b,c,d:R) ``a*c+b*d<=(sqrt ((Rsqr a)+(Rsqr b)))*(sqrt ((Rsqr c)+(Rsqr d)))``.
-Intros a b c d; Apply Rsqr_incr_0_var; [Rewrite Rsqr_times; Repeat Rewrite Rsqr_sqrt; Unfold Rsqr; [Replace ``(a*c+b*d)*(a*c+b*d)`` with ``(a*a*c*c+b*b*d*d)+(2*a*b*c*d)``; [Replace ``(a*a+b*b)*(c*c+d*d)`` with ``(a*a*c*c+b*b*d*d)+(a*a*d*d+b*b*c*c)``; [Apply Rle_compatibility; Replace ``a*a*d*d+b*b*c*c`` with ``(2*a*b*c*d)+(a*a*d*d+b*b*c*c-2*a*b*c*d)``; [Pattern 1 ``2*a*b*c*d``; Rewrite <- Rplus_Or; Apply Rle_compatibility; Replace ``a*a*d*d+b*b*c*c-2*a*b*c*d`` with (Rsqr (Rminus (Rmult a d) (Rmult b c))); [Apply pos_Rsqr | Unfold Rsqr; Ring] | Ring] | Ring] | Ring] | Apply (ge0_plus_ge0_is_ge0 (Rsqr c) (Rsqr d) (pos_Rsqr c) (pos_Rsqr d)) | Apply (ge0_plus_ge0_is_ge0 (Rsqr a) (Rsqr b) (pos_Rsqr a) (pos_Rsqr b))] | Apply Rmult_le_pos; Apply sqrt_positivity; Apply ge0_plus_ge0_is_ge0; Apply pos_Rsqr].
+Lemma sqrt_cauchy :
+ forall a b c d:R,
+ a * c + b * d <= sqrt (Rsqr a + Rsqr b) * sqrt (Rsqr c + Rsqr d).
+intros a b c d; apply Rsqr_incr_0_var;
+ [ rewrite Rsqr_mult; repeat rewrite Rsqr_sqrt; unfold Rsqr in |- *;
+ [ replace ((a * c + b * d) * (a * c + b * d)) with
+ (a * a * c * c + b * b * d * d + 2 * a * b * c * d);
+ [ replace ((a * a + b * b) * (c * c + d * d)) with
+ (a * a * c * c + b * b * d * d + (a * a * d * d + b * b * c * c));
+ [ apply Rplus_le_compat_l;
+ replace (a * a * d * d + b * b * c * c) with
+ (2 * a * b * c * d +
+ (a * a * d * d + b * b * c * c - 2 * a * b * c * d));
+ [ pattern (2 * a * b * c * d) at 1 in |- *; rewrite <- Rplus_0_r;
+ apply Rplus_le_compat_l;
+ replace (a * a * d * d + b * b * c * c - 2 * a * b * c * d)
+ with (Rsqr (a * d - b * c));
+ [ apply Rle_0_sqr | unfold Rsqr in |- *; ring ]
+ | ring ]
+ | ring ]
+ | ring ]
+ | apply
+ (Rplus_le_le_0_compat (Rsqr c) (Rsqr d) (Rle_0_sqr c) (Rle_0_sqr d))
+ | apply
+ (Rplus_le_le_0_compat (Rsqr a) (Rsqr b) (Rle_0_sqr a) (Rle_0_sqr b)) ]
+ | apply Rmult_le_pos; apply sqrt_positivity; apply Rplus_le_le_0_compat;
+ apply Rle_0_sqr ].
Qed.
(************************************************************)
(* Resolution of [a*X^2+b*X+c=0] *)
(************************************************************)
-Definition Delta [a:nonzeroreal;b,c:R] : R := ``(Rsqr b)-4*a*c``.
-
-Definition Delta_is_pos [a:nonzeroreal;b,c:R] : Prop := ``0<=(Delta a b c)``.
-
-Definition sol_x1 [a:nonzeroreal;b,c:R] : R := ``(-b+(sqrt (Delta a b c)))/(2*a)``.
-
-Definition sol_x2 [a:nonzeroreal;b,c:R] : R := ``(-b-(sqrt (Delta a b c)))/(2*a)``.
-
-Lemma Rsqr_sol_eq_0_1 : (a:nonzeroreal;b,c,x:R) (Delta_is_pos a b c) -> (x==(sol_x1 a b c))\/(x==(sol_x2 a b c)) -> ``a*(Rsqr x)+b*x+c==0``.
-Intros; Elim H0; Intro.
-Unfold sol_x1 in H1; Unfold Delta in H1; Rewrite H1; Unfold Rdiv; Repeat Rewrite Rsqr_times; Rewrite Rsqr_plus; Rewrite <- Rsqr_neg; Rewrite Rsqr_sqrt.
-Rewrite Rsqr_inv.
-Unfold Rsqr; Repeat Rewrite Rinv_Rmult.
-Repeat Rewrite Rmult_assoc; Rewrite (Rmult_sym a).
-Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Rewrite Rmult_Rplus_distrl.
-Repeat Rewrite Rmult_assoc.
-Pattern 2 ``2``; Rewrite (Rmult_sym ``2``).
-Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Rewrite (Rmult_Rplus_distrl ``-b`` ``(sqrt (b*b-(2*(2*(a*c)))))`` ``(/2*/a)``).
-Rewrite Rmult_Rplus_distr; Repeat Rewrite Rplus_assoc.
-Replace ``( -b*((sqrt (b*b-(2*(2*(a*c)))))*(/2*/a))+(b*( -b*(/2*/a))+(b*((sqrt (b*b-(2*(2*(a*c)))))*(/2*/a))+c)))`` with ``(b*( -b*(/2*/a)))+c``.
-Unfold Rminus; Repeat Rewrite <- Rplus_assoc.
-Replace ``b*b+b*b`` with ``2*(b*b)``.
-Rewrite Rmult_Rplus_distrl; Repeat Rewrite Rmult_assoc.
-Rewrite (Rmult_sym ``2``); Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Rewrite Ropp_mul1; Repeat Rewrite Rmult_assoc; Rewrite (Rmult_sym ``2``).
-Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Rewrite (Rmult_sym ``/2``); Repeat Rewrite Rmult_assoc; Rewrite (Rmult_sym ``2``).
-Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Repeat Rewrite Rmult_assoc.
-Rewrite (Rmult_sym a); Rewrite Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Rewrite <- Ropp_mul2.
-Ring.
-Apply (cond_nonzero a).
-DiscrR.
-DiscrR.
-DiscrR.
-Ring.
-Ring.
-DiscrR.
-Apply (cond_nonzero a).
-DiscrR.
-Apply (cond_nonzero a).
-Apply prod_neq_R0; [DiscrR | Apply (cond_nonzero a)].
-Apply prod_neq_R0; [DiscrR | Apply (cond_nonzero a)].
-Apply prod_neq_R0; [DiscrR | Apply (cond_nonzero a)].
-Assumption.
-Unfold sol_x2 in H1; Unfold Delta in H1; Rewrite H1; Unfold Rdiv; Repeat Rewrite Rsqr_times; Rewrite Rsqr_minus; Rewrite <- Rsqr_neg; Rewrite Rsqr_sqrt.
-Rewrite Rsqr_inv.
-Unfold Rsqr; Repeat Rewrite Rinv_Rmult; Repeat Rewrite Rmult_assoc.
-Rewrite (Rmult_sym a); Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Unfold Rminus; Rewrite Rmult_Rplus_distrl.
-Rewrite Ropp_mul1; Repeat Rewrite Rmult_assoc; Pattern 2 ``2``; Rewrite (Rmult_sym ``2``).
-Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Rewrite (Rmult_Rplus_distrl ``-b`` ``-(sqrt (b*b+ -(2*(2*(a*c))))) `` ``(/2*/a)``).
-Rewrite Rmult_Rplus_distr; Repeat Rewrite Rplus_assoc.
-Rewrite Ropp_mul1; Rewrite Ropp_Ropp.
-Replace ``(b*((sqrt (b*b+ -(2*(2*(a*c)))))*(/2*/a))+(b*( -b*(/2*/a))+(b*( -(sqrt (b*b+ -(2*(2*(a*c)))))*(/2*/a))+c)))`` with ``(b*( -b*(/2*/a)))+c``.
-Repeat Rewrite <- Rplus_assoc; Replace ``b*b+b*b`` with ``2*(b*b)``.
-Rewrite Rmult_Rplus_distrl; Repeat Rewrite Rmult_assoc; Rewrite (Rmult_sym ``2``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Ropp_mul1; Repeat Rewrite Rmult_assoc.
-Rewrite (Rmult_sym ``2``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Rewrite (Rmult_sym ``/2``); Repeat Rewrite Rmult_assoc.
-Rewrite (Rmult_sym ``2``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Repeat Rewrite Rmult_assoc; Rewrite (Rmult_sym a); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Rewrite <- Ropp_mul2; Ring.
-Apply (cond_nonzero a).
-DiscrR.
-DiscrR.
-DiscrR.
-Ring.
-Ring.
-DiscrR.
-Apply (cond_nonzero a).
-DiscrR.
-DiscrR.
-Apply (cond_nonzero a).
-Apply prod_neq_R0; DiscrR Orelse Apply (cond_nonzero a).
-Apply prod_neq_R0; DiscrR Orelse Apply (cond_nonzero a).
-Apply prod_neq_R0; DiscrR Orelse Apply (cond_nonzero a).
-Assumption.
-Qed.
-
-Lemma Rsqr_sol_eq_0_0 : (a:nonzeroreal;b,c,x:R) (Delta_is_pos a b c) -> ``a*(Rsqr x)+b*x+c==0`` -> (x==(sol_x1 a b c))\/(x==(sol_x2 a b c)).
-Intros; Rewrite (canonical_Rsqr a b c x) in H0; Rewrite Rplus_sym in H0; Generalize (Rplus_Ropp ``(4*a*c-(Rsqr b))/(4*a)`` ``a*(Rsqr (x+b/(2*a)))`` H0); Cut ``(Rsqr b)-4*a*c==(Delta a b c)``.
-Intro; Replace ``-((4*a*c-(Rsqr b))/(4*a))`` with ``((Rsqr b)-4*a*c)/(4*a)``.
-Rewrite H1; Intro; Generalize (Rmult_mult_r ``/a`` ``a*(Rsqr (x+b/(2*a)))`` ``(Delta a b c)/(4*a)`` H2); Replace ``/a*(a*(Rsqr (x+b/(2*a))))`` with ``(Rsqr (x+b/(2*a)))``.
-Replace ``/a*(Delta a b c)/(4*a)`` with ``(Rsqr ((sqrt (Delta a b c))/(2*a)))``.
-Intro; Generalize (Rsqr_eq ``(x+b/(2*a))`` ``((sqrt (Delta a b c))/(2*a))`` H3); Intro; Elim H4; Intro.
-Left; Unfold sol_x1; Generalize (Rplus_plus_r ``-(b/(2*a))`` ``x+b/(2*a)`` ``(sqrt (Delta a b c))/(2*a)`` H5); Replace `` -(b/(2*a))+(x+b/(2*a))`` with x.
-Intro; Rewrite H6; Unfold Rdiv; Ring.
-Ring.
-Right; Unfold sol_x2; Generalize (Rplus_plus_r ``-(b/(2*a))`` ``x+b/(2*a)`` ``-((sqrt (Delta a b c))/(2*a))`` H5); Replace `` -(b/(2*a))+(x+b/(2*a))`` with x.
-Intro; Rewrite H6; Unfold Rdiv; Ring.
-Ring.
-Rewrite Rsqr_div.
-Rewrite Rsqr_sqrt.
-Unfold Rdiv.
-Repeat Rewrite Rmult_assoc.
-Rewrite (Rmult_sym ``/a``).
-Rewrite Rmult_assoc.
-Rewrite <- Rinv_Rmult.
-Replace ``(2*(2*a))*a`` with ``(Rsqr (2*a))``.
-Reflexivity.
-SqRing.
-Rewrite <- Rmult_assoc; Apply prod_neq_R0; [DiscrR | Apply (cond_nonzero a)].
-Apply (cond_nonzero a).
-Assumption.
-Apply prod_neq_R0; [DiscrR | Apply (cond_nonzero a)].
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
-Symmetry; Apply Rmult_1l.
-Apply (cond_nonzero a).
-Unfold Rdiv; Rewrite <- Ropp_mul1.
-Rewrite Ropp_distr2.
-Reflexivity.
-Reflexivity.
+Definition Delta (a:nonzeroreal) (b c:R) : R := Rsqr b - 4 * a * c.
+
+Definition Delta_is_pos (a:nonzeroreal) (b c:R) : Prop := 0 <= Delta a b c.
+
+Definition sol_x1 (a:nonzeroreal) (b c:R) : R :=
+ (- b + sqrt (Delta a b c)) / (2 * a).
+
+Definition sol_x2 (a:nonzeroreal) (b c:R) : R :=
+ (- b - sqrt (Delta a b c)) / (2 * a).
+
+Lemma Rsqr_sol_eq_0_1 :
+ forall (a:nonzeroreal) (b c x:R),
+ Delta_is_pos a b c ->
+ x = sol_x1 a b c \/ x = sol_x2 a b c -> a * Rsqr x + b * x + c = 0.
+intros; elim H0; intro.
+unfold sol_x1 in H1; unfold Delta in H1; rewrite H1; unfold Rdiv in |- *;
+ repeat rewrite Rsqr_mult; rewrite Rsqr_plus; rewrite <- Rsqr_neg;
+ rewrite Rsqr_sqrt.
+rewrite Rsqr_inv.
+unfold Rsqr in |- *; repeat rewrite Rinv_mult_distr.
+repeat rewrite Rmult_assoc; rewrite (Rmult_comm a).
+repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r; rewrite Rmult_plus_distr_r.
+repeat rewrite Rmult_assoc.
+pattern 2 at 2 in |- *; rewrite (Rmult_comm 2).
+repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r.
+rewrite
+ (Rmult_plus_distr_r (- b) (sqrt (b * b - 2 * (2 * (a * c)))) (/ 2 * / a))
+ .
+rewrite Rmult_plus_distr_l; repeat rewrite Rplus_assoc.
+replace
+ (- b * (sqrt (b * b - 2 * (2 * (a * c))) * (/ 2 * / a)) +
+ (b * (- b * (/ 2 * / a)) +
+ (b * (sqrt (b * b - 2 * (2 * (a * c))) * (/ 2 * / a)) + c))) with
+ (b * (- b * (/ 2 * / a)) + c).
+unfold Rminus in |- *; repeat rewrite <- Rplus_assoc.
+replace (b * b + b * b) with (2 * (b * b)).
+rewrite Rmult_plus_distr_r; repeat rewrite Rmult_assoc.
+rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc.
+rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r.
+rewrite Ropp_mult_distr_l_reverse; repeat rewrite Rmult_assoc;
+ rewrite (Rmult_comm 2).
+repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r; rewrite (Rmult_comm (/ 2)); repeat rewrite Rmult_assoc;
+ rewrite (Rmult_comm 2).
+repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r; repeat rewrite Rmult_assoc.
+rewrite (Rmult_comm a); rewrite Rmult_assoc.
+rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r; rewrite <- Rmult_opp_opp.
+ring.
+apply (cond_nonzero a).
+discrR.
+discrR.
+discrR.
+ring.
+ring.
+discrR.
+apply (cond_nonzero a).
+discrR.
+apply (cond_nonzero a).
+apply prod_neq_R0; [ discrR | apply (cond_nonzero a) ].
+apply prod_neq_R0; [ discrR | apply (cond_nonzero a) ].
+apply prod_neq_R0; [ discrR | apply (cond_nonzero a) ].
+assumption.
+unfold sol_x2 in H1; unfold Delta in H1; rewrite H1; unfold Rdiv in |- *;
+ repeat rewrite Rsqr_mult; rewrite Rsqr_minus; rewrite <- Rsqr_neg;
+ rewrite Rsqr_sqrt.
+rewrite Rsqr_inv.
+unfold Rsqr in |- *; repeat rewrite Rinv_mult_distr;
+ repeat rewrite Rmult_assoc.
+rewrite (Rmult_comm a); repeat rewrite Rmult_assoc.
+rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r; unfold Rminus in |- *; rewrite Rmult_plus_distr_r.
+rewrite Ropp_mult_distr_l_reverse; repeat rewrite Rmult_assoc;
+ pattern 2 at 2 in |- *; rewrite (Rmult_comm 2).
+repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r;
+ rewrite
+ (Rmult_plus_distr_r (- b) (- sqrt (b * b + - (2 * (2 * (a * c)))))
+ (/ 2 * / a)).
+rewrite Rmult_plus_distr_l; repeat rewrite Rplus_assoc.
+rewrite Ropp_mult_distr_l_reverse; rewrite Ropp_involutive.
+replace
+ (b * (sqrt (b * b + - (2 * (2 * (a * c)))) * (/ 2 * / a)) +
+ (b * (- b * (/ 2 * / a)) +
+ (b * (- sqrt (b * b + - (2 * (2 * (a * c)))) * (/ 2 * / a)) + c))) with
+ (b * (- b * (/ 2 * / a)) + c).
+repeat rewrite <- Rplus_assoc; replace (b * b + b * b) with (2 * (b * b)).
+rewrite Rmult_plus_distr_r; repeat rewrite Rmult_assoc;
+ rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc;
+ rewrite <- Rinv_l_sym.
+rewrite Ropp_mult_distr_l_reverse; repeat rewrite Rmult_assoc.
+rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r; rewrite (Rmult_comm (/ 2)); repeat rewrite Rmult_assoc.
+rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r; repeat rewrite Rmult_assoc; rewrite (Rmult_comm a);
+ rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r; rewrite <- Rmult_opp_opp; ring.
+apply (cond_nonzero a).
+discrR.
+discrR.
+discrR.
+ring.
+ring.
+discrR.
+apply (cond_nonzero a).
+discrR.
+discrR.
+apply (cond_nonzero a).
+apply prod_neq_R0; discrR || apply (cond_nonzero a).
+apply prod_neq_R0; discrR || apply (cond_nonzero a).
+apply prod_neq_R0; discrR || apply (cond_nonzero a).
+assumption.
Qed.
+
+Lemma Rsqr_sol_eq_0_0 :
+ forall (a:nonzeroreal) (b c x:R),
+ Delta_is_pos a b c ->
+ a * Rsqr x + b * x + c = 0 -> x = sol_x1 a b c \/ x = sol_x2 a b c.
+intros; rewrite (canonical_Rsqr a b c x) in H0; rewrite Rplus_comm in H0;
+ generalize
+ (Rplus_opp_r_uniq ((4 * a * c - Rsqr b) / (4 * a))
+ (a * Rsqr (x + b / (2 * a))) H0); cut (Rsqr b - 4 * a * c = Delta a b c).
+intro;
+ replace (- ((4 * a * c - Rsqr b) / (4 * a))) with
+ ((Rsqr b - 4 * a * c) / (4 * a)).
+rewrite H1; intro;
+ generalize
+ (Rmult_eq_compat_l (/ a) (a * Rsqr (x + b / (2 * a)))
+ (Delta a b c / (4 * a)) H2);
+ replace (/ a * (a * Rsqr (x + b / (2 * a)))) with (Rsqr (x + b / (2 * a))).
+replace (/ a * (Delta a b c / (4 * a))) with
+ (Rsqr (sqrt (Delta a b c) / (2 * a))).
+intro;
+ generalize (Rsqr_eq (x + b / (2 * a)) (sqrt (Delta a b c) / (2 * a)) H3);
+ intro; elim H4; intro.
+left; unfold sol_x1 in |- *;
+ generalize
+ (Rplus_eq_compat_l (- (b / (2 * a))) (x + b / (2 * a))
+ (sqrt (Delta a b c) / (2 * a)) H5);
+ replace (- (b / (2 * a)) + (x + b / (2 * a))) with x.
+intro; rewrite H6; unfold Rdiv in |- *; ring.
+ring.
+right; unfold sol_x2 in |- *;
+ generalize
+ (Rplus_eq_compat_l (- (b / (2 * a))) (x + b / (2 * a))
+ (- (sqrt (Delta a b c) / (2 * a))) H5);
+ replace (- (b / (2 * a)) + (x + b / (2 * a))) with x.
+intro; rewrite H6; unfold Rdiv in |- *; ring.
+ring.
+rewrite Rsqr_div.
+rewrite Rsqr_sqrt.
+unfold Rdiv in |- *.
+repeat rewrite Rmult_assoc.
+rewrite (Rmult_comm (/ a)).
+rewrite Rmult_assoc.
+rewrite <- Rinv_mult_distr.
+replace (2 * (2 * a) * a) with (Rsqr (2 * a)).
+reflexivity.
+ring_Rsqr.
+rewrite <- Rmult_assoc; apply prod_neq_R0;
+ [ discrR | apply (cond_nonzero a) ].
+apply (cond_nonzero a).
+assumption.
+apply prod_neq_R0; [ discrR | apply (cond_nonzero a) ].
+rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
+symmetry in |- *; apply Rmult_1_l.
+apply (cond_nonzero a).
+unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse.
+rewrite Ropp_minus_distr.
+reflexivity.
+reflexivity.
+Qed. \ No newline at end of file
diff --git a/theories/Reals/Ranalysis.v b/theories/Reals/Ranalysis.v
index 4f944995c..eee3f2daf 100644
--- a/theories/Reals/Ranalysis.v
+++ b/theories/Reals/Ranalysis.v
@@ -8,10 +8,10 @@
(*i $Id$ i*)
-Require Rbase.
-Require Rfunctions.
-Require Rtrigo.
-Require SeqSeries.
+Require Import Rbase.
+Require Import Rfunctions.
+Require Import Rtrigo.
+Require Import SeqSeries.
Require Export Ranalysis1.
Require Export Ranalysis2.
Require Export Ranalysis3.
@@ -27,451 +27,776 @@ Require Export Rgeom.
Require Export RList.
Require Export Sqrt_reg.
Require Export Ranalysis4.
-Require Export Rpower.
-V7only [Import R_scope.]. Open Local Scope R_scope.
+Require Export Rpower. Open Local Scope R_scope.
Axiom AppVar : R.
(**********)
-Recursive Tactic Definition IntroHypG trm :=
-Match trm With
-|[(plus_fct ?1 ?2)] ->
- (Match Context With
- |[|-(derivable ?)] -> IntroHypG ?1; IntroHypG ?2
- |[|-(continuity ?)] -> IntroHypG ?1; IntroHypG ?2
- | _ -> Idtac)
-|[(minus_fct ?1 ?2)] ->
- (Match Context With
- |[|-(derivable ?)] -> IntroHypG ?1; IntroHypG ?2
- |[|-(continuity ?)] -> IntroHypG ?1; IntroHypG ?2
- | _ -> Idtac)
-|[(mult_fct ?1 ?2)] ->
- (Match Context With
- |[|-(derivable ?)] -> IntroHypG ?1; IntroHypG ?2
- |[|-(continuity ?)] -> IntroHypG ?1; IntroHypG ?2
- | _ -> Idtac)
-|[(div_fct ?1 ?2)] -> Let aux = ?2 In
- (Match Context With
- |[_:(x0:R)``(aux x0)<>0``|-(derivable ?)] -> IntroHypG ?1; IntroHypG ?2
- |[_:(x0:R)``(aux x0)<>0``|-(continuity ?)] -> IntroHypG ?1; IntroHypG ?2
- |[|-(derivable ?)] -> Cut ((x0:R)``(aux x0)<>0``); [Intro; IntroHypG ?1; IntroHypG ?2 | Try Assumption]
- |[|-(continuity ?)] -> Cut ((x0:R)``(aux x0)<>0``); [Intro; IntroHypG ?1; IntroHypG ?2 | Try Assumption]
- | _ -> Idtac)
-|[(comp ?1 ?2)] ->
- (Match Context With
- |[|-(derivable ?)] -> IntroHypG ?1; IntroHypG ?2
- |[|-(continuity ?)] -> IntroHypG ?1; IntroHypG ?2
- | _ -> Idtac)
-|[(opp_fct ?1)] ->
- (Match Context With
- |[|-(derivable ?)] -> IntroHypG ?1
- |[|-(continuity ?)] -> IntroHypG ?1
- | _ -> Idtac)
-|[(inv_fct ?1)] -> Let aux = ?1 In
- (Match Context With
- |[_:(x0:R)``(aux x0)<>0``|-(derivable ?)] -> IntroHypG ?1
- |[_:(x0:R)``(aux x0)<>0``|-(continuity ?)] -> IntroHypG ?1
- |[|-(derivable ?)] -> Cut ((x0:R)``(aux x0)<>0``); [Intro; IntroHypG ?1 | Try Assumption]
- |[|-(continuity ?)] -> Cut ((x0:R)``(aux x0)<>0``); [Intro; IntroHypG ?1| Try Assumption]
- | _ -> Idtac)
-|[cos] -> Idtac
-|[sin] -> Idtac
-|[cosh] -> Idtac
-|[sinh] -> Idtac
-|[exp] -> Idtac
-|[Rsqr] -> Idtac
-|[sqrt] -> Idtac
-|[id] -> Idtac
-|[(fct_cte ?)] -> Idtac
-|[(pow_fct ?)] -> Idtac
-|[Rabsolu] -> Idtac
-|[?1] -> Let p = ?1 In
- (Match Context With
- |[_:(derivable p)|- ?] -> Idtac
- |[|-(derivable p)] -> Idtac
- |[|-(derivable ?)] -> Cut True -> (derivable p); [Intro HYPPD; Cut (derivable p); [Intro; Clear HYPPD | Apply HYPPD; Clear HYPPD; Trivial] | Idtac]
- | [_:(continuity p)|- ?] -> Idtac
- |[|-(continuity p)] -> Idtac
- |[|-(continuity ?)] -> Cut True -> (continuity p); [Intro HYPPD; Cut (continuity p); [Intro; Clear HYPPD | Apply HYPPD; Clear HYPPD; Trivial] | Idtac]
- | _ -> Idtac).
+Ltac intro_hyp_glob trm :=
+ match constr:trm with
+ | (?X1 + ?X2)%F =>
+ match goal with
+ | |- (derivable _) => intro_hyp_glob X1; intro_hyp_glob X2
+ | |- (continuity _) => intro_hyp_glob X1; intro_hyp_glob X2
+ | _ => idtac
+ end
+ | (?X1 - ?X2)%F =>
+ match goal with
+ | |- (derivable _) => intro_hyp_glob X1; intro_hyp_glob X2
+ | |- (continuity _) => intro_hyp_glob X1; intro_hyp_glob X2
+ | _ => idtac
+ end
+ | (?X1 * ?X2)%F =>
+ match goal with
+ | |- (derivable _) => intro_hyp_glob X1; intro_hyp_glob X2
+ | |- (continuity _) => intro_hyp_glob X1; intro_hyp_glob X2
+ | _ => idtac
+ end
+ | (?X1 / ?X2)%F =>
+ let aux := constr:X2 in
+ match goal with
+ | _:(forall x0:R, aux x0 <> 0) |- (derivable _) =>
+ intro_hyp_glob X1; intro_hyp_glob X2
+ | _:(forall x0:R, aux x0 <> 0) |- (continuity _) =>
+ intro_hyp_glob X1; intro_hyp_glob X2
+ | |- (derivable _) =>
+ cut (forall x0:R, aux x0 <> 0);
+ [ intro; intro_hyp_glob X1; intro_hyp_glob X2 | try assumption ]
+ | |- (continuity _) =>
+ cut (forall x0:R, aux x0 <> 0);
+ [ intro; intro_hyp_glob X1; intro_hyp_glob X2 | try assumption ]
+ | _ => idtac
+ end
+ | (comp ?X1 ?X2) =>
+ match goal with
+ | |- (derivable _) => intro_hyp_glob X1; intro_hyp_glob X2
+ | |- (continuity _) => intro_hyp_glob X1; intro_hyp_glob X2
+ | _ => idtac
+ end
+ | (- ?X1)%F =>
+ match goal with
+ | |- (derivable _) => intro_hyp_glob X1
+ | |- (continuity _) => intro_hyp_glob X1
+ | _ => idtac
+ end
+ | (/ ?X1)%F =>
+ let aux := constr:X1 in
+ match goal with
+ | _:(forall x0:R, aux x0 <> 0) |- (derivable _) =>
+ intro_hyp_glob X1
+ | _:(forall x0:R, aux x0 <> 0) |- (continuity _) =>
+ intro_hyp_glob X1
+ | |- (derivable _) =>
+ cut (forall x0:R, aux x0 <> 0);
+ [ intro; intro_hyp_glob X1 | try assumption ]
+ | |- (continuity _) =>
+ cut (forall x0:R, aux x0 <> 0);
+ [ intro; intro_hyp_glob X1 | try assumption ]
+ | _ => idtac
+ end
+ | cos => idtac
+ | sin => idtac
+ | cosh => idtac
+ | sinh => idtac
+ | exp => idtac
+ | Rsqr => idtac
+ | sqrt => idtac
+ | id => idtac
+ | (fct_cte _) => idtac
+ | (pow_fct _) => idtac
+ | Rabs => idtac
+ | ?X1 =>
+ let p := constr:X1 in
+ match goal with
+ | _:(derivable p) |- _ => idtac
+ | |- (derivable p) => idtac
+ | |- (derivable _) =>
+ cut (True -> derivable p);
+ [ intro HYPPD; cut (derivable p);
+ [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ]
+ | idtac ]
+ | _:(continuity p) |- _ => idtac
+ | |- (continuity p) => idtac
+ | |- (continuity _) =>
+ cut (True -> continuity p);
+ [ intro HYPPD; cut (continuity p);
+ [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ]
+ | idtac ]
+ | _ => idtac
+ end
+ end.
(**********)
-Recursive Tactic Definition IntroHypL trm pt :=
-Match trm With
-|[(plus_fct ?1 ?2)] ->
- (Match Context With
- |[|-(derivable_pt ? ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt
- |[|-(continuity_pt ? ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt
- |[|-(eqT ? (derive_pt ? ? ?) ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt
- | _ -> Idtac)
-|[(minus_fct ?1 ?2)] ->
- (Match Context With
- |[|-(derivable_pt ? ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt
- |[|-(continuity_pt ? ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt
- |[|-(eqT ? (derive_pt ? ? ?) ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt
- | _ -> Idtac)
-|[(mult_fct ?1 ?2)] ->
- (Match Context With
- |[|-(derivable_pt ? ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt
- |[|-(continuity_pt ? ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt
- |[|-(eqT ? (derive_pt ? ? ?) ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt
- | _ -> Idtac)
-|[(div_fct ?1 ?2)] -> Let aux = ?2 In
- (Match Context With
- |[_:``(aux pt)<>0``|-(derivable_pt ? ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt
- |[_:``(aux pt)<>0``|-(continuity_pt ? ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt
- |[_:``(aux pt)<>0``|-(eqT ? (derive_pt ? ? ?) ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt
- |[id:(x0:R)``(aux x0)<>0``|-(derivable_pt ? ?)] -> Generalize (id pt); Intro; IntroHypL ?1 pt; IntroHypL ?2 pt
- |[id:(x0:R)``(aux x0)<>0``|-(continuity_pt ? ?)] -> Generalize (id pt); Intro; IntroHypL ?1 pt; IntroHypL ?2 pt
- |[id:(x0:R)``(aux x0)<>0``|-(eqT ? (derive_pt ? ? ?) ?)] -> Generalize (id pt); Intro; IntroHypL ?1 pt; IntroHypL ?2 pt
- |[|-(derivable_pt ? ?)] -> Cut ``(aux pt)<>0``; [Intro; IntroHypL ?1 pt; IntroHypL ?2 pt | Try Assumption]
- |[|-(continuity_pt ? ?)] -> Cut ``(aux pt)<>0``; [Intro; IntroHypL ?1 pt; IntroHypL ?2 pt | Try Assumption]
- |[|-(eqT ? (derive_pt ? ? ?) ?)] -> Cut ``(aux pt)<>0``; [Intro; IntroHypL ?1 pt; IntroHypL ?2 pt | Try Assumption]
- | _ -> Idtac)
-|[(comp ?1 ?2)] ->
- (Match Context With
- |[|-(derivable_pt ? ?)] -> Let pt_f1 = (Eval Cbv Beta in (?2 pt)) In IntroHypL ?1 pt_f1; IntroHypL ?2 pt
- |[|-(continuity_pt ? ?)] -> Let pt_f1 = (Eval Cbv Beta in (?2 pt)) In IntroHypL ?1 pt_f1; IntroHypL ?2 pt
- |[|-(eqT ? (derive_pt ? ? ?) ?)] -> Let pt_f1 = (Eval Cbv Beta in (?2 pt)) In IntroHypL ?1 pt_f1; IntroHypL ?2 pt
- | _ -> Idtac)
-|[(opp_fct ?1)] ->
- (Match Context With
- |[|-(derivable_pt ? ?)] -> IntroHypL ?1 pt
- |[|-(continuity_pt ? ?)] -> IntroHypL ?1 pt
- |[|-(eqT ? (derive_pt ? ? ?) ?)] -> IntroHypL ?1 pt
- | _ -> Idtac)
-|[(inv_fct ?1)] -> Let aux = ?1 In
- (Match Context With
- |[_:``(aux pt)<>0``|-(derivable_pt ? ?)] -> IntroHypL ?1 pt
- |[_:``(aux pt)<>0``|-(continuity_pt ? ?)] -> IntroHypL ?1 pt
- |[_:``(aux pt)<>0``|-(eqT ? (derive_pt ? ? ?) ?)] -> IntroHypL ?1 pt
- |[id:(x0:R)``(aux x0)<>0``|-(derivable_pt ? ?)] -> Generalize (id pt); Intro; IntroHypL ?1 pt
- |[id:(x0:R)``(aux x0)<>0``|-(continuity_pt ? ?)] -> Generalize (id pt); Intro; IntroHypL ?1 pt
- |[id:(x0:R)``(aux x0)<>0``|-(eqT ? (derive_pt ? ? ?) ?)] -> Generalize (id pt); Intro; IntroHypL ?1 pt
- |[|-(derivable_pt ? ?)] -> Cut ``(aux pt)<>0``; [Intro; IntroHypL ?1 pt | Try Assumption]
- |[|-(continuity_pt ? ?)] -> Cut ``(aux pt)<>0``; [Intro; IntroHypL ?1 pt| Try Assumption]
- |[|-(eqT ? (derive_pt ? ? ?) ?)] -> Cut ``(aux pt)<>0``; [Intro; IntroHypL ?1 pt | Try Assumption]
- | _ -> Idtac)
-|[cos] -> Idtac
-|[sin] -> Idtac
-|[cosh] -> Idtac
-|[sinh] -> Idtac
-|[exp] -> Idtac
-|[Rsqr] -> Idtac
-|[id] -> Idtac
-|[(fct_cte ?)] -> Idtac
-|[(pow_fct ?)] -> Idtac
-|[sqrt] ->
- (Match Context With
- |[|-(derivable_pt ? ?)] -> Cut ``0<pt``; [Intro | Try Assumption]
- |[|-(continuity_pt ? ?)] -> Cut ``0<=pt``; [Intro | Try Assumption]
- |[|-(eqT ? (derive_pt ? ? ?) ?)] -> Cut ``0<pt``; [Intro | Try Assumption]
- | _ -> Idtac)
-|[Rabsolu] ->
- (Match Context With
- |[|-(derivable_pt ? ?)] -> Cut ``pt<>0``; [Intro | Try Assumption]
- | _ -> Idtac)
-|[?1] -> Let p = ?1 In
- (Match Context With
- |[_:(derivable_pt p pt)|- ?] -> Idtac
- |[|-(derivable_pt p pt)] -> Idtac
- |[|-(derivable_pt ? ?)] -> Cut True -> (derivable_pt p pt); [Intro HYPPD; Cut (derivable_pt p pt); [Intro; Clear HYPPD | Apply HYPPD; Clear HYPPD; Trivial] | Idtac]
- |[_:(continuity_pt p pt)|- ?] -> Idtac
- |[|-(continuity_pt p pt)] -> Idtac
- |[|-(continuity_pt ? ?)] -> Cut True -> (continuity_pt p pt); [Intro HYPPD; Cut (continuity_pt p pt); [Intro; Clear HYPPD | Apply HYPPD; Clear HYPPD; Trivial] | Idtac]
- |[|-(eqT ? (derive_pt ? ? ?) ?)] -> Cut True -> (derivable_pt p pt); [Intro HYPPD; Cut (derivable_pt p pt); [Intro; Clear HYPPD | Apply HYPPD; Clear HYPPD; Trivial] | Idtac]
- | _ -> Idtac).
+Ltac intro_hyp_pt trm pt :=
+ match constr:trm with
+ | (?X1 + ?X2)%F =>
+ match goal with
+ | |- (derivable_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
+ | |- (continuity_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
+ | |- (derive_pt _ _ _ = _) =>
+ intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
+ | _ => idtac
+ end
+ | (?X1 - ?X2)%F =>
+ match goal with
+ | |- (derivable_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
+ | |- (continuity_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
+ | |- (derive_pt _ _ _ = _) =>
+ intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
+ | _ => idtac
+ end
+ | (?X1 * ?X2)%F =>
+ match goal with
+ | |- (derivable_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
+ | |- (continuity_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
+ | |- (derive_pt _ _ _ = _) =>
+ intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
+ | _ => idtac
+ end
+ | (?X1 / ?X2)%F =>
+ let aux := constr:X2 in
+ match goal with
+ | _:(aux pt <> 0) |- (derivable_pt _ _) =>
+ intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
+ | _:(aux pt <> 0) |- (continuity_pt _ _) =>
+ intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
+ | _:(aux pt <> 0) |- (derive_pt _ _ _ = _) =>
+ intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
+ | id:(forall x0:R, aux x0 <> 0) |- (derivable_pt _ _) =>
+ generalize (id pt); intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
+ | id:(forall x0:R, aux x0 <> 0) |- (continuity_pt _ _) =>
+ generalize (id pt); intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
+ | id:(forall x0:R, aux x0 <> 0) |- (derive_pt _ _ _ = _) =>
+ generalize (id pt); intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
+ | |- (derivable_pt _ _) =>
+ cut (aux pt <> 0);
+ [ intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt | try assumption ]
+ | |- (continuity_pt _ _) =>
+ cut (aux pt <> 0);
+ [ intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt | try assumption ]
+ | |- (derive_pt _ _ _ = _) =>
+ cut (aux pt <> 0);
+ [ intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt | try assumption ]
+ | _ => idtac
+ end
+ | (comp ?X1 ?X2) =>
+ match goal with
+ | |- (derivable_pt _ _) =>
+ let pt_f1 := eval cbv beta in (X2 pt) in
+ (intro_hyp_pt X1 pt_f1; intro_hyp_pt X2 pt)
+ | |- (continuity_pt _ _) =>
+ let pt_f1 := eval cbv beta in (X2 pt) in
+ (intro_hyp_pt X1 pt_f1; intro_hyp_pt X2 pt)
+ | |- (derive_pt _ _ _ = _) =>
+ let pt_f1 := eval cbv beta in (X2 pt) in
+ (intro_hyp_pt X1 pt_f1; intro_hyp_pt X2 pt)
+ | _ => idtac
+ end
+ | (- ?X1)%F =>
+ match goal with
+ | |- (derivable_pt _ _) => intro_hyp_pt X1 pt
+ | |- (continuity_pt _ _) => intro_hyp_pt X1 pt
+ | |- (derive_pt _ _ _ = _) => intro_hyp_pt X1 pt
+ | _ => idtac
+ end
+ | (/ ?X1)%F =>
+ let aux := constr:X1 in
+ match goal with
+ | _:(aux pt <> 0) |- (derivable_pt _ _) =>
+ intro_hyp_pt X1 pt
+ | _:(aux pt <> 0) |- (continuity_pt _ _) =>
+ intro_hyp_pt X1 pt
+ | _:(aux pt <> 0) |- (derive_pt _ _ _ = _) =>
+ intro_hyp_pt X1 pt
+ | id:(forall x0:R, aux x0 <> 0) |- (derivable_pt _ _) =>
+ generalize (id pt); intro; intro_hyp_pt X1 pt
+ | id:(forall x0:R, aux x0 <> 0) |- (continuity_pt _ _) =>
+ generalize (id pt); intro; intro_hyp_pt X1 pt
+ | id:(forall x0:R, aux x0 <> 0) |- (derive_pt _ _ _ = _) =>
+ generalize (id pt); intro; intro_hyp_pt X1 pt
+ | |- (derivable_pt _ _) =>
+ cut (aux pt <> 0); [ intro; intro_hyp_pt X1 pt | try assumption ]
+ | |- (continuity_pt _ _) =>
+ cut (aux pt <> 0); [ intro; intro_hyp_pt X1 pt | try assumption ]
+ | |- (derive_pt _ _ _ = _) =>
+ cut (aux pt <> 0); [ intro; intro_hyp_pt X1 pt | try assumption ]
+ | _ => idtac
+ end
+ | cos => idtac
+ | sin => idtac
+ | cosh => idtac
+ | sinh => idtac
+ | exp => idtac
+ | Rsqr => idtac
+ | id => idtac
+ | (fct_cte _) => idtac
+ | (pow_fct _) => idtac
+ | sqrt =>
+ match goal with
+ | |- (derivable_pt _ _) => cut (0 < pt); [ intro | try assumption ]
+ | |- (continuity_pt _ _) =>
+ cut (0 <= pt); [ intro | try assumption ]
+ | |- (derive_pt _ _ _ = _) =>
+ cut (0 < pt); [ intro | try assumption ]
+ | _ => idtac
+ end
+ | Rabs =>
+ match goal with
+ | |- (derivable_pt _ _) =>
+ cut (pt <> 0); [ intro | try assumption ]
+ | _ => idtac
+ end
+ | ?X1 =>
+ let p := constr:X1 in
+ match goal with
+ | _:(derivable_pt p pt) |- _ => idtac
+ | |- (derivable_pt p pt) => idtac
+ | |- (derivable_pt _ _) =>
+ cut (True -> derivable_pt p pt);
+ [ intro HYPPD; cut (derivable_pt p pt);
+ [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ]
+ | idtac ]
+ | _:(continuity_pt p pt) |- _ => idtac
+ | |- (continuity_pt p pt) => idtac
+ | |- (continuity_pt _ _) =>
+ cut (True -> continuity_pt p pt);
+ [ intro HYPPD; cut (continuity_pt p pt);
+ [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ]
+ | idtac ]
+ | |- (derive_pt _ _ _ = _) =>
+ cut (True -> derivable_pt p pt);
+ [ intro HYPPD; cut (derivable_pt p pt);
+ [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ]
+ | idtac ]
+ | _ => idtac
+ end
+ end.
(**********)
-Recursive Tactic Definition IsDiff_pt :=
-Match Context With
- (* fonctions de base *)
- [|-(derivable_pt Rsqr ?)] -> Apply derivable_pt_Rsqr
-|[|-(derivable_pt id ?1)] -> Apply (derivable_pt_id ?1)
-|[|-(derivable_pt (fct_cte ?) ?)] -> Apply derivable_pt_const
-|[|-(derivable_pt sin ?)] -> Apply derivable_pt_sin
-|[|-(derivable_pt cos ?)] -> Apply derivable_pt_cos
-|[|-(derivable_pt sinh ?)] -> Apply derivable_pt_sinh
-|[|-(derivable_pt cosh ?)] -> Apply derivable_pt_cosh
-|[|-(derivable_pt exp ?)] -> Apply derivable_pt_exp
-|[|-(derivable_pt (pow_fct ?) ?)] -> Unfold pow_fct; Apply derivable_pt_pow
-|[|-(derivable_pt sqrt ?1)] -> Apply (derivable_pt_sqrt ?1); Assumption Orelse Unfold plus_fct minus_fct opp_fct mult_fct div_fct inv_fct comp id fct_cte pow_fct
-|[|-(derivable_pt Rabsolu ?1)] -> Apply (derivable_pt_Rabsolu ?1); Assumption Orelse Unfold plus_fct minus_fct opp_fct mult_fct div_fct inv_fct comp id fct_cte pow_fct
- (* regles de differentiabilite *)
- (* PLUS *)
-|[|-(derivable_pt (plus_fct ?1 ?2) ?3)] -> Apply (derivable_pt_plus ?1 ?2 ?3); IsDiff_pt
- (* MOINS *)
-|[|-(derivable_pt (minus_fct ?1 ?2) ?3)] -> Apply (derivable_pt_minus ?1 ?2 ?3); IsDiff_pt
- (* OPPOSE *)
-|[|-(derivable_pt (opp_fct ?1) ?2)] -> Apply (derivable_pt_opp ?1 ?2); IsDiff_pt
- (* MULTIPLICATION PAR UN SCALAIRE *)
-|[|-(derivable_pt (mult_real_fct ?1 ?2) ?3)] -> Apply (derivable_pt_scal ?2 ?1 ?3); IsDiff_pt
- (* MULTIPLICATION *)
-|[|-(derivable_pt (mult_fct ?1 ?2) ?3)] -> Apply (derivable_pt_mult ?1 ?2 ?3); IsDiff_pt
- (* DIVISION *)
- |[|-(derivable_pt (div_fct ?1 ?2) ?3)] -> Apply (derivable_pt_div ?1 ?2 ?3); [IsDiff_pt | IsDiff_pt | Try Assumption Orelse Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct comp pow_fct id fct_cte]
- (* INVERSION *)
- |[|-(derivable_pt (inv_fct ?1) ?2)] -> Apply (derivable_pt_inv ?1 ?2); [Assumption Orelse Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct comp pow_fct id fct_cte | IsDiff_pt]
- (* COMPOSITION *)
-|[|-(derivable_pt (comp ?1 ?2) ?3)] -> Apply (derivable_pt_comp ?2 ?1 ?3); IsDiff_pt
-|[_:(derivable_pt ?1 ?2)|-(derivable_pt ?1 ?2)] -> Assumption
-|[_:(derivable ?1) |- (derivable_pt ?1 ?2)] -> Cut (derivable ?1); [Intro HypDDPT; Apply HypDDPT | Assumption]
-|[|-True->(derivable_pt ? ?)] -> Intro HypTruE; Clear HypTruE; IsDiff_pt
-| _ -> Try Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct id fct_cte comp pow_fct.
+Ltac is_diff_pt :=
+ match goal with
+ | |- (derivable_pt Rsqr _) =>
+
+ (* fonctions de base *)
+ apply derivable_pt_Rsqr
+ | |- (derivable_pt id ?X1) => apply (derivable_pt_id X1)
+ | |- (derivable_pt (fct_cte _) _) => apply derivable_pt_const
+ | |- (derivable_pt sin _) => apply derivable_pt_sin
+ | |- (derivable_pt cos _) => apply derivable_pt_cos
+ | |- (derivable_pt sinh _) => apply derivable_pt_sinh
+ | |- (derivable_pt cosh _) => apply derivable_pt_cosh
+ | |- (derivable_pt exp _) => apply derivable_pt_exp
+ | |- (derivable_pt (pow_fct _) _) =>
+ unfold pow_fct in |- *; apply derivable_pt_pow
+ | |- (derivable_pt sqrt ?X1) =>
+ apply (derivable_pt_sqrt X1);
+ assumption ||
+ unfold plus_fct, minus_fct, opp_fct, mult_fct, div_fct, inv_fct,
+ comp, id, fct_cte, pow_fct in |- *
+ | |- (derivable_pt Rabs ?X1) =>
+ apply (Rderivable_pt_abs X1);
+ assumption ||
+ unfold plus_fct, minus_fct, opp_fct, mult_fct, div_fct, inv_fct,
+ comp, id, fct_cte, pow_fct in |- *
+ (* regles de differentiabilite *)
+ (* PLUS *)
+ | |- (derivable_pt (?X1 + ?X2) ?X3) =>
+ apply (derivable_pt_plus X1 X2 X3); is_diff_pt
+ (* MOINS *)
+ | |- (derivable_pt (?X1 - ?X2) ?X3) =>
+ apply (derivable_pt_minus X1 X2 X3); is_diff_pt
+ (* OPPOSE *)
+ | |- (derivable_pt (- ?X1) ?X2) =>
+ apply (derivable_pt_opp X1 X2);
+ is_diff_pt
+ (* MULTIPLICATION PAR UN SCALAIRE *)
+ | |- (derivable_pt (mult_real_fct ?X1 ?X2) ?X3) =>
+ apply (derivable_pt_scal X2 X1 X3); is_diff_pt
+ (* MULTIPLICATION *)
+ | |- (derivable_pt (?X1 * ?X2) ?X3) =>
+ apply (derivable_pt_mult X1 X2 X3); is_diff_pt
+ (* DIVISION *)
+ | |- (derivable_pt (?X1 / ?X2) ?X3) =>
+ apply (derivable_pt_div X1 X2 X3);
+ [ is_diff_pt
+ | is_diff_pt
+ | try
+ assumption ||
+ unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct,
+ comp, pow_fct, id, fct_cte in |- * ]
+ | |- (derivable_pt (/ ?X1) ?X2) =>
+
+ (* INVERSION *)
+ apply (derivable_pt_inv X1 X2);
+ [ assumption ||
+ unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct,
+ comp, pow_fct, id, fct_cte in |- *
+ | is_diff_pt ]
+ | |- (derivable_pt (comp ?X1 ?X2) ?X3) =>
+
+ (* COMPOSITION *)
+ apply (derivable_pt_comp X2 X1 X3); is_diff_pt
+ | _:(derivable_pt ?X1 ?X2) |- (derivable_pt ?X1 ?X2) =>
+ assumption
+ | _:(derivable ?X1) |- (derivable_pt ?X1 ?X2) =>
+ cut (derivable X1); [ intro HypDDPT; apply HypDDPT | assumption ]
+ | |- (True -> derivable_pt _ _) =>
+ intro HypTruE; clear HypTruE; is_diff_pt
+ | _ =>
+ try
+ unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, id,
+ fct_cte, comp, pow_fct in |- *
+ end.
(**********)
-Recursive Tactic Definition IsDiff_glob :=
-Match Context With
- (* fonctions de base *)
- [|-(derivable Rsqr)] -> Apply derivable_Rsqr
- |[|-(derivable id)] -> Apply derivable_id
- |[|-(derivable (fct_cte ?))] -> Apply derivable_const
- |[|-(derivable sin)] -> Apply derivable_sin
- |[|-(derivable cos)] -> Apply derivable_cos
- |[|-(derivable cosh)] -> Apply derivable_cosh
- |[|-(derivable sinh)] -> Apply derivable_sinh
- |[|-(derivable exp)] -> Apply derivable_exp
- |[|-(derivable (pow_fct ?))] -> Unfold pow_fct; Apply derivable_pow
- (* regles de differentiabilite *)
- (* PLUS *)
- |[|-(derivable (plus_fct ?1 ?2))] -> Apply (derivable_plus ?1 ?2); IsDiff_glob
- (* MOINS *)
- |[|-(derivable (minus_fct ?1 ?2))] -> Apply (derivable_minus ?1 ?2); IsDiff_glob
- (* OPPOSE *)
- |[|-(derivable (opp_fct ?1))] -> Apply (derivable_opp ?1); IsDiff_glob
- (* MULTIPLICATION PAR UN SCALAIRE *)
- |[|-(derivable (mult_real_fct ?1 ?2))] -> Apply (derivable_scal ?2 ?1); IsDiff_glob
- (* MULTIPLICATION *)
- |[|-(derivable (mult_fct ?1 ?2))] -> Apply (derivable_mult ?1 ?2); IsDiff_glob
- (* DIVISION *)
- |[|-(derivable (div_fct ?1 ?2))] -> Apply (derivable_div ?1 ?2); [IsDiff_glob | IsDiff_glob | Try Assumption Orelse Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct id fct_cte comp pow_fct]
- (* INVERSION *)
- |[|-(derivable (inv_fct ?1))] -> Apply (derivable_inv ?1); [Try Assumption Orelse Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct id fct_cte comp pow_fct | IsDiff_glob]
- (* COMPOSITION *)
- |[|-(derivable (comp sqrt ?))] -> Unfold derivable; Intro; Try IsDiff_pt
- |[|-(derivable (comp Rabsolu ?))] -> Unfold derivable; Intro; Try IsDiff_pt
- |[|-(derivable (comp ?1 ?2))] -> Apply (derivable_comp ?2 ?1); IsDiff_glob
- |[_:(derivable ?1)|-(derivable ?1)] -> Assumption
- |[|-True->(derivable ?)] -> Intro HypTruE; Clear HypTruE; IsDiff_glob
- | _ -> Try Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct id fct_cte comp pow_fct.
+Ltac is_diff_glob :=
+ match goal with
+ | |- (derivable Rsqr) =>
+ (* fonctions de base *)
+ apply derivable_Rsqr
+ | |- (derivable id) => apply derivable_id
+ | |- (derivable (fct_cte _)) => apply derivable_const
+ | |- (derivable sin) => apply derivable_sin
+ | |- (derivable cos) => apply derivable_cos
+ | |- (derivable cosh) => apply derivable_cosh
+ | |- (derivable sinh) => apply derivable_sinh
+ | |- (derivable exp) => apply derivable_exp
+ | |- (derivable (pow_fct _)) =>
+ unfold pow_fct in |- *;
+ apply derivable_pow
+ (* regles de differentiabilite *)
+ (* PLUS *)
+ | |- (derivable (?X1 + ?X2)) =>
+ apply (derivable_plus X1 X2); is_diff_glob
+ (* MOINS *)
+ | |- (derivable (?X1 - ?X2)) =>
+ apply (derivable_minus X1 X2); is_diff_glob
+ (* OPPOSE *)
+ | |- (derivable (- ?X1)) =>
+ apply (derivable_opp X1);
+ is_diff_glob
+ (* MULTIPLICATION PAR UN SCALAIRE *)
+ | |- (derivable (mult_real_fct ?X1 ?X2)) =>
+ apply (derivable_scal X2 X1); is_diff_glob
+ (* MULTIPLICATION *)
+ | |- (derivable (?X1 * ?X2)) =>
+ apply (derivable_mult X1 X2); is_diff_glob
+ (* DIVISION *)
+ | |- (derivable (?X1 / ?X2)) =>
+ apply (derivable_div X1 X2);
+ [ is_diff_glob
+ | is_diff_glob
+ | try
+ assumption ||
+ unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct,
+ id, fct_cte, comp, pow_fct in |- * ]
+ | |- (derivable (/ ?X1)) =>
+
+ (* INVERSION *)
+ apply (derivable_inv X1);
+ [ try
+ assumption ||
+ unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct,
+ id, fct_cte, comp, pow_fct in |- *
+ | is_diff_glob ]
+ | |- (derivable (comp sqrt _)) =>
+
+ (* COMPOSITION *)
+ unfold derivable in |- *; intro; try is_diff_pt
+ | |- (derivable (comp Rabs _)) =>
+ unfold derivable in |- *; intro; try is_diff_pt
+ | |- (derivable (comp ?X1 ?X2)) =>
+ apply (derivable_comp X2 X1); is_diff_glob
+ | _:(derivable ?X1) |- (derivable ?X1) => assumption
+ | |- (True -> derivable _) =>
+ intro HypTruE; clear HypTruE; is_diff_glob
+ | _ =>
+ try
+ unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, id,
+ fct_cte, comp, pow_fct in |- *
+ end.
(**********)
-Recursive Tactic Definition IsCont_pt :=
-Match Context With
- (* fonctions de base *)
- [|-(continuity_pt Rsqr ?)] -> Apply derivable_continuous_pt; Apply derivable_pt_Rsqr
-|[|-(continuity_pt id ?1)] -> Apply derivable_continuous_pt; Apply (derivable_pt_id ?1)
-|[|-(continuity_pt (fct_cte ?) ?)] -> Apply derivable_continuous_pt; Apply derivable_pt_const
-|[|-(continuity_pt sin ?)] -> Apply derivable_continuous_pt; Apply derivable_pt_sin
-|[|-(continuity_pt cos ?)] -> Apply derivable_continuous_pt; Apply derivable_pt_cos
-|[|-(continuity_pt sinh ?)] -> Apply derivable_continuous_pt; Apply derivable_pt_sinh
-|[|-(continuity_pt cosh ?)] -> Apply derivable_continuous_pt; Apply derivable_pt_cosh
-|[|-(continuity_pt exp ?)] -> Apply derivable_continuous_pt; Apply derivable_pt_exp
-|[|-(continuity_pt (pow_fct ?) ?)] -> Unfold pow_fct; Apply derivable_continuous_pt; Apply derivable_pt_pow
-|[|-(continuity_pt sqrt ?1)] -> Apply continuity_pt_sqrt; Assumption Orelse Unfold plus_fct minus_fct opp_fct mult_fct div_fct inv_fct comp id fct_cte pow_fct
-|[|-(continuity_pt Rabsolu ?1)] -> Apply (continuity_Rabsolu ?1)
- (* regles de differentiabilite *)
- (* PLUS *)
-|[|-(continuity_pt (plus_fct ?1 ?2) ?3)] -> Apply (continuity_pt_plus ?1 ?2 ?3); IsCont_pt
- (* MOINS *)
-|[|-(continuity_pt (minus_fct ?1 ?2) ?3)] -> Apply (continuity_pt_minus ?1 ?2 ?3); IsCont_pt
- (* OPPOSE *)
-|[|-(continuity_pt (opp_fct ?1) ?2)] -> Apply (continuity_pt_opp ?1 ?2); IsCont_pt
- (* MULTIPLICATION PAR UN SCALAIRE *)
-|[|-(continuity_pt (mult_real_fct ?1 ?2) ?3)] -> Apply (continuity_pt_scal ?2 ?1 ?3); IsCont_pt
- (* MULTIPLICATION *)
-|[|-(continuity_pt (mult_fct ?1 ?2) ?3)] -> Apply (continuity_pt_mult ?1 ?2 ?3); IsCont_pt
- (* DIVISION *)
- |[|-(continuity_pt (div_fct ?1 ?2) ?3)] -> Apply (continuity_pt_div ?1 ?2 ?3); [IsCont_pt | IsCont_pt | Try Assumption Orelse Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct comp id fct_cte pow_fct]
- (* INVERSION *)
- |[|-(continuity_pt (inv_fct ?1) ?2)] -> Apply (continuity_pt_inv ?1 ?2); [IsCont_pt | Assumption Orelse Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct comp id fct_cte pow_fct]
- (* COMPOSITION *)
-|[|-(continuity_pt (comp ?1 ?2) ?3)] -> Apply (continuity_pt_comp ?2 ?1 ?3); IsCont_pt
-|[_:(continuity_pt ?1 ?2)|-(continuity_pt ?1 ?2)] -> Assumption
-|[_:(continuity ?1) |- (continuity_pt ?1 ?2)] -> Cut (continuity ?1); [Intro HypDDPT; Apply HypDDPT | Assumption]
-|[_:(derivable_pt ?1 ?2)|-(continuity_pt ?1 ?2)] -> Apply derivable_continuous_pt; Assumption
-|[_:(derivable ?1)|-(continuity_pt ?1 ?2)] -> Cut (continuity ?1); [Intro HypDDPT; Apply HypDDPT | Apply derivable_continuous; Assumption]
-|[|-True->(continuity_pt ? ?)] -> Intro HypTruE; Clear HypTruE; IsCont_pt
-| _ -> Try Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct id fct_cte comp pow_fct.
+Ltac is_cont_pt :=
+ match goal with
+ | |- (continuity_pt Rsqr _) =>
+
+ (* fonctions de base *)
+ apply derivable_continuous_pt; apply derivable_pt_Rsqr
+ | |- (continuity_pt id ?X1) =>
+ apply derivable_continuous_pt; apply (derivable_pt_id X1)
+ | |- (continuity_pt (fct_cte _) _) =>
+ apply derivable_continuous_pt; apply derivable_pt_const
+ | |- (continuity_pt sin _) =>
+ apply derivable_continuous_pt; apply derivable_pt_sin
+ | |- (continuity_pt cos _) =>
+ apply derivable_continuous_pt; apply derivable_pt_cos
+ | |- (continuity_pt sinh _) =>
+ apply derivable_continuous_pt; apply derivable_pt_sinh
+ | |- (continuity_pt cosh _) =>
+ apply derivable_continuous_pt; apply derivable_pt_cosh
+ | |- (continuity_pt exp _) =>
+ apply derivable_continuous_pt; apply derivable_pt_exp
+ | |- (continuity_pt (pow_fct _) _) =>
+ unfold pow_fct in |- *; apply derivable_continuous_pt;
+ apply derivable_pt_pow
+ | |- (continuity_pt sqrt ?X1) =>
+ apply continuity_pt_sqrt;
+ assumption ||
+ unfold plus_fct, minus_fct, opp_fct, mult_fct, div_fct, inv_fct,
+ comp, id, fct_cte, pow_fct in |- *
+ | |- (continuity_pt Rabs ?X1) =>
+ apply (Rcontinuity_abs X1)
+ (* regles de differentiabilite *)
+ (* PLUS *)
+ | |- (continuity_pt (?X1 + ?X2) ?X3) =>
+ apply (continuity_pt_plus X1 X2 X3); is_cont_pt
+ (* MOINS *)
+ | |- (continuity_pt (?X1 - ?X2) ?X3) =>
+ apply (continuity_pt_minus X1 X2 X3); is_cont_pt
+ (* OPPOSE *)
+ | |- (continuity_pt (- ?X1) ?X2) =>
+ apply (continuity_pt_opp X1 X2);
+ is_cont_pt
+ (* MULTIPLICATION PAR UN SCALAIRE *)
+ | |- (continuity_pt (mult_real_fct ?X1 ?X2) ?X3) =>
+ apply (continuity_pt_scal X2 X1 X3); is_cont_pt
+ (* MULTIPLICATION *)
+ | |- (continuity_pt (?X1 * ?X2) ?X3) =>
+ apply (continuity_pt_mult X1 X2 X3); is_cont_pt
+ (* DIVISION *)
+ | |- (continuity_pt (?X1 / ?X2) ?X3) =>
+ apply (continuity_pt_div X1 X2 X3);
+ [ is_cont_pt
+ | is_cont_pt
+ | try
+ assumption ||
+ unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct,
+ comp, id, fct_cte, pow_fct in |- * ]
+ | |- (continuity_pt (/ ?X1) ?X2) =>
+
+ (* INVERSION *)
+ apply (continuity_pt_inv X1 X2);
+ [ is_cont_pt
+ | assumption ||
+ unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct,
+ comp, id, fct_cte, pow_fct in |- * ]
+ | |- (continuity_pt (comp ?X1 ?X2) ?X3) =>
+
+ (* COMPOSITION *)
+ apply (continuity_pt_comp X2 X1 X3); is_cont_pt
+ | _:(continuity_pt ?X1 ?X2) |- (continuity_pt ?X1 ?X2) =>
+ assumption
+ | _:(continuity ?X1) |- (continuity_pt ?X1 ?X2) =>
+ cut (continuity X1); [ intro HypDDPT; apply HypDDPT | assumption ]
+ | _:(derivable_pt ?X1 ?X2) |- (continuity_pt ?X1 ?X2) =>
+ apply derivable_continuous_pt; assumption
+ | _:(derivable ?X1) |- (continuity_pt ?X1 ?X2) =>
+ cut (continuity X1);
+ [ intro HypDDPT; apply HypDDPT
+ | apply derivable_continuous; assumption ]
+ | |- (True -> continuity_pt _ _) =>
+ intro HypTruE; clear HypTruE; is_cont_pt
+ | _ =>
+ try
+ unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, id,
+ fct_cte, comp, pow_fct in |- *
+ end.
(**********)
-Recursive Tactic Definition IsCont_glob :=
-Match Context With
- (* fonctions de base *)
- [|-(continuity Rsqr)] -> Apply derivable_continuous; Apply derivable_Rsqr
- |[|-(continuity id)] -> Apply derivable_continuous; Apply derivable_id
- |[|-(continuity (fct_cte ?))] -> Apply derivable_continuous; Apply derivable_const
- |[|-(continuity sin)] -> Apply derivable_continuous; Apply derivable_sin
- |[|-(continuity cos)] -> Apply derivable_continuous; Apply derivable_cos
- |[|-(continuity exp)] -> Apply derivable_continuous; Apply derivable_exp
- |[|-(continuity (pow_fct ?))] -> Unfold pow_fct; Apply derivable_continuous; Apply derivable_pow
- |[|-(continuity sinh)] -> Apply derivable_continuous; Apply derivable_sinh
- |[|-(continuity cosh)] -> Apply derivable_continuous; Apply derivable_cosh
- |[|-(continuity Rabsolu)] -> Apply continuity_Rabsolu
- (* regles de continuite *)
- (* PLUS *)
-|[|-(continuity (plus_fct ?1 ?2))] -> Apply (continuity_plus ?1 ?2); Try IsCont_glob Orelse Assumption
- (* MOINS *)
-|[|-(continuity (minus_fct ?1 ?2))] -> Apply (continuity_minus ?1 ?2); Try IsCont_glob Orelse Assumption
- (* OPPOSE *)
-|[|-(continuity (opp_fct ?1))] -> Apply (continuity_opp ?1); Try IsCont_glob Orelse Assumption
- (* INVERSE *)
-|[|-(continuity (inv_fct ?1))] -> Apply (continuity_inv ?1); Try IsCont_glob Orelse Assumption
- (* MULTIPLICATION PAR UN SCALAIRE *)
-|[|-(continuity (mult_real_fct ?1 ?2))] -> Apply (continuity_scal ?2 ?1); Try IsCont_glob Orelse Assumption
- (* MULTIPLICATION *)
-|[|-(continuity (mult_fct ?1 ?2))] -> Apply (continuity_mult ?1 ?2); Try IsCont_glob Orelse Assumption
- (* DIVISION *)
- |[|-(continuity (div_fct ?1 ?2))] -> Apply (continuity_div ?1 ?2); [Try IsCont_glob Orelse Assumption | Try IsCont_glob Orelse Assumption | Try Assumption Orelse Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct id fct_cte pow_fct]
- (* COMPOSITION *)
- |[|-(continuity (comp sqrt ?))] -> Unfold continuity_pt; Intro; Try IsCont_pt
- |[|-(continuity (comp ?1 ?2))] -> Apply (continuity_comp ?2 ?1); Try IsCont_glob Orelse Assumption
- |[_:(continuity ?1)|-(continuity ?1)] -> Assumption
- |[|-True->(continuity ?)] -> Intro HypTruE; Clear HypTruE; IsCont_glob
- |[_:(derivable ?1)|-(continuity ?1)] -> Apply derivable_continuous; Assumption
- | _ -> Try Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct id fct_cte comp pow_fct.
+Ltac is_cont_glob :=
+ match goal with
+ | |- (continuity Rsqr) =>
+
+ (* fonctions de base *)
+ apply derivable_continuous; apply derivable_Rsqr
+ | |- (continuity id) => apply derivable_continuous; apply derivable_id
+ | |- (continuity (fct_cte _)) =>
+ apply derivable_continuous; apply derivable_const
+ | |- (continuity sin) => apply derivable_continuous; apply derivable_sin
+ | |- (continuity cos) => apply derivable_continuous; apply derivable_cos
+ | |- (continuity exp) => apply derivable_continuous; apply derivable_exp
+ | |- (continuity (pow_fct _)) =>
+ unfold pow_fct in |- *; apply derivable_continuous; apply derivable_pow
+ | |- (continuity sinh) =>
+ apply derivable_continuous; apply derivable_sinh
+ | |- (continuity cosh) =>
+ apply derivable_continuous; apply derivable_cosh
+ | |- (continuity Rabs) =>
+ apply Rcontinuity_abs
+ (* regles de continuite *)
+ (* PLUS *)
+ | |- (continuity (?X1 + ?X2)) =>
+ apply (continuity_plus X1 X2);
+ try is_cont_glob || assumption
+ (* MOINS *)
+ | |- (continuity (?X1 - ?X2)) =>
+ apply (continuity_minus X1 X2);
+ try is_cont_glob || assumption
+ (* OPPOSE *)
+ | |- (continuity (- ?X1)) =>
+ apply (continuity_opp X1); try is_cont_glob || assumption
+ (* INVERSE *)
+ | |- (continuity (/ ?X1)) =>
+ apply (continuity_inv X1);
+ try is_cont_glob || assumption
+ (* MULTIPLICATION PAR UN SCALAIRE *)
+ | |- (continuity (mult_real_fct ?X1 ?X2)) =>
+ apply (continuity_scal X2 X1);
+ try is_cont_glob || assumption
+ (* MULTIPLICATION *)
+ | |- (continuity (?X1 * ?X2)) =>
+ apply (continuity_mult X1 X2);
+ try is_cont_glob || assumption
+ (* DIVISION *)
+ | |- (continuity (?X1 / ?X2)) =>
+ apply (continuity_div X1 X2);
+ [ try is_cont_glob || assumption
+ | try is_cont_glob || assumption
+ | try
+ assumption ||
+ unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct,
+ id, fct_cte, pow_fct in |- * ]
+ | |- (continuity (comp sqrt _)) =>
+
+ (* COMPOSITION *)
+ unfold continuity_pt in |- *; intro; try is_cont_pt
+ | |- (continuity (comp ?X1 ?X2)) =>
+ apply (continuity_comp X2 X1); try is_cont_glob || assumption
+ | _:(continuity ?X1) |- (continuity ?X1) => assumption
+ | |- (True -> continuity _) =>
+ intro HypTruE; clear HypTruE; is_cont_glob
+ | _:(derivable ?X1) |- (continuity ?X1) =>
+ apply derivable_continuous; assumption
+ | _ =>
+ try
+ unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, id,
+ fct_cte, comp, pow_fct in |- *
+ end.
(**********)
-Recursive Tactic Definition RewTerm trm :=
-Match trm With
-| [(Rplus ?1 ?2)] -> Let p1= (RewTerm ?1) And p2 = (RewTerm ?2) In
- (Match p1 With
- [(fct_cte ?3)] ->
- (Match p2 With
- | [(fct_cte ?4)] -> '(fct_cte (Rplus ?3 ?4))
- | _ -> '(plus_fct p1 p2))
- | _ -> '(plus_fct p1 p2))
-| [(Rminus ?1 ?2)] -> Let p1 = (RewTerm ?1) And p2 = (RewTerm ?2) In
- (Match p1 With
- [(fct_cte ?3)] ->
- (Match p2 With
- | [(fct_cte ?4)] -> '(fct_cte (Rminus ?3 ?4))
- | _ -> '(minus_fct p1 p2))
- | _ -> '(minus_fct p1 p2))
-| [(Rdiv ?1 ?2)] -> Let p1 = (RewTerm ?1) And p2 = (RewTerm ?2) In
- (Match p1 With
- [(fct_cte ?3)] ->
- (Match p2 With
- | [(fct_cte ?4)] -> '(fct_cte (Rdiv ?3 ?4))
- | _ -> '(div_fct p1 p2))
- | _ ->
- (Match p2 With
- | [(fct_cte ?4)] -> '(mult_fct p1 (fct_cte (Rinv ?4)))
- | _ -> '(div_fct p1 p2)))
-| [(Rmult ?1 (Rinv ?2))] -> Let p1 = (RewTerm ?1) And p2 = (RewTerm ?2) In
- (Match p1 With
- [(fct_cte ?3)] ->
- (Match p2 With
- | [(fct_cte ?4)] -> '(fct_cte (Rdiv ?3 ?4))
- | _ -> '(div_fct p1 p2))
- | _ ->
- (Match p2 With
- | [(fct_cte ?4)] -> '(mult_fct p1 (fct_cte (Rinv ?4)))
- | _ -> '(div_fct p1 p2)))
-| [(Rmult ?1 ?2)] -> Let p1 = (RewTerm ?1) And p2 = (RewTerm ?2) In
- (Match p1 With
- [(fct_cte ?3)] ->
- (Match p2 With
- | [(fct_cte ?4)] -> '(fct_cte (Rmult ?3 ?4))
- | _ -> '(mult_fct p1 p2))
- | _ -> '(mult_fct p1 p2))
-| [(Ropp ?1)] -> Let p = (RewTerm ?1) In
- (Match p With
- [(fct_cte ?2)] -> '(fct_cte (Ropp ?2))
- | _ -> '(opp_fct p))
-| [(Rinv ?1)] -> Let p = (RewTerm ?1) In
- (Match p With
- [(fct_cte ?2)] -> '(fct_cte (Rinv ?2))
- | _ -> '(inv_fct p))
-| [(?1 AppVar)] -> '?1
-| [(?1 ?2)] -> Let p = (RewTerm ?2) In
- (Match p With
- | [(fct_cte ?3)] -> '(fct_cte (?1 ?3))
- | _ -> '(comp ?1 p))
-| [AppVar] -> 'id
-| [(pow AppVar ?1)] -> '(pow_fct ?1)
-| [(pow ?1 ?2)] -> Let p = (RewTerm ?1) In
- (Match p With
- | [(fct_cte ?3)] -> '(fct_cte (pow_fct ?2 ?3))
- | _ -> '(comp (pow_fct ?2) p))
-| [?1]-> '(fct_cte ?1).
+Ltac rew_term trm :=
+ match constr:trm with
+ | (?X1 + ?X2) =>
+ let p1 := rew_term X1 with p2 := rew_term X2 in
+ match constr:p1 with
+ | (fct_cte ?X3) =>
+ match constr:p2 with
+ | (fct_cte ?X4) => constr:(fct_cte (X3 + X4))
+ | _ => constr:(p1 + p2)%F
+ end
+ | _ => constr:(p1 + p2)%F
+ end
+ | (?X1 - ?X2) =>
+ let p1 := rew_term X1 with p2 := rew_term X2 in
+ match constr:p1 with
+ | (fct_cte ?X3) =>
+ match constr:p2 with
+ | (fct_cte ?X4) => constr:(fct_cte (X3 - X4))
+ | _ => constr:(p1 - p2)%F
+ end
+ | _ => constr:(p1 - p2)%F
+ end
+ | (?X1 / ?X2) =>
+ let p1 := rew_term X1 with p2 := rew_term X2 in
+ match constr:p1 with
+ | (fct_cte ?X3) =>
+ match constr:p2 with
+ | (fct_cte ?X4) => constr:(fct_cte (X3 / X4))
+ | _ => constr:(p1 / p2)%F
+ end
+ | _ =>
+ match constr:p2 with
+ | (fct_cte ?X4) => constr:(p1 * fct_cte (/ X4))%F
+ | _ => constr:(p1 / p2)%F
+ end
+ end
+ | (?X1 * / ?X2) =>
+ let p1 := rew_term X1 with p2 := rew_term X2 in
+ match constr:p1 with
+ | (fct_cte ?X3) =>
+ match constr:p2 with
+ | (fct_cte ?X4) => constr:(fct_cte (X3 / X4))
+ | _ => constr:(p1 / p2)%F
+ end
+ | _ =>
+ match constr:p2 with
+ | (fct_cte ?X4) => constr:(p1 * fct_cte (/ X4))%F
+ | _ => constr:(p1 / p2)%F
+ end
+ end
+ | (?X1 * ?X2) =>
+ let p1 := rew_term X1 with p2 := rew_term X2 in
+ match constr:p1 with
+ | (fct_cte ?X3) =>
+ match constr:p2 with
+ | (fct_cte ?X4) => constr:(fct_cte (X3 * X4))
+ | _ => constr:(p1 * p2)%F
+ end
+ | _ => constr:(p1 * p2)%F
+ end
+ | (- ?X1) =>
+ let p := rew_term X1 in
+ match constr:p with
+ | (fct_cte ?X2) => constr:(fct_cte (- X2))
+ | _ => constr:(- p)%F
+ end
+ | (/ ?X1) =>
+ let p := rew_term X1 in
+ match constr:p with
+ | (fct_cte ?X2) => constr:(fct_cte (/ X2))
+ | _ => constr:(/ p)%F
+ end
+ | (?X1 AppVar) => constr:X1
+ | (?X1 ?X2) =>
+ let p := rew_term X2 in
+ match constr:p with
+ | (fct_cte ?X3) => constr:(fct_cte (X1 X3))
+ | _ => constr:(comp X1 p)
+ end
+ | AppVar => constr:id
+ | (AppVar ^ ?X1) => constr:(pow_fct X1)
+ | (?X1 ^ ?X2) =>
+ let p := rew_term X1 in
+ match constr:p with
+ | (fct_cte ?X3) => constr:(fct_cte (pow_fct X2 X3))
+ | _ => constr:(comp (pow_fct X2) p)
+ end
+ | ?X1 => constr:(fct_cte X1)
+ end.
(**********)
-Recursive Tactic Definition ConsProof trm pt :=
-Match trm With
-| [(plus_fct ?1 ?2)] -> Let p1 = (ConsProof ?1 pt) And p2 = (ConsProof ?2 pt) In '(derivable_pt_plus ?1 ?2 pt p1 p2)
-| [(minus_fct ?1 ?2)] -> Let p1 = (ConsProof ?1 pt) And p2 = (ConsProof ?2 pt) In '(derivable_pt_minus ?1 ?2 pt p1 p2)
-| [(mult_fct ?1 ?2)] -> Let p1 = (ConsProof ?1 pt) And p2 = (ConsProof ?2 pt) In '(derivable_pt_mult ?1 ?2 pt p1 p2)
-| [(div_fct ?1 ?2)] ->
- (Match Context With
- |[id:~((?2 pt)==R0) |- ?] -> Let p1 = (ConsProof ?1 pt) And p2 = (ConsProof ?2 pt) In '(derivable_pt_div ?1 ?2 pt p1 p2 id)
- | _ -> 'False)
-| [(inv_fct ?1)] ->
- (Match Context With
- |[id:~((?1 pt)==R0) |- ?] -> Let p1 = (ConsProof ?1 pt) In '(derivable_pt_inv ?1 pt p1 id)
- | _ -> 'False)
-| [(comp ?1 ?2)] -> Let pt_f1 = (Eval Cbv Beta in (?2 pt)) In Let p1 = (ConsProof ?1 pt_f1) And p2 = (ConsProof ?2 pt) In '(derivable_pt_comp ?2 ?1 pt p2 p1)
-| [(opp_fct ?1)] -> Let p1 = (ConsProof ?1 pt) In '(derivable_pt_opp ?1 pt p1)
-| [sin] -> '(derivable_pt_sin pt)
-| [cos] -> '(derivable_pt_cos pt)
-| [sinh] -> '(derivable_pt_sinh pt)
-| [cosh] -> '(derivable_pt_cosh pt)
-| [exp] -> '(derivable_pt_exp pt)
-| [id] -> '(derivable_pt_id pt)
-| [Rsqr] -> '(derivable_pt_Rsqr pt)
-| [sqrt] ->
- (Match Context With
- |[id:(Rlt R0 pt) |- ?] -> '(derivable_pt_sqrt pt id)
- | _ -> 'False)
-| [(fct_cte ?1)] -> '(derivable_pt_const ?1 pt)
-| [?1] -> Let aux = ?1 In
- (Match Context With
- [ id : (derivable_pt aux pt) |- ?] -> 'id
- |[ id : (derivable aux) |- ?] -> '(id pt)
- | _ -> 'False).
+Ltac deriv_proof trm pt :=
+ match constr:trm with
+ | (?X1 + ?X2)%F =>
+ let p1 := deriv_proof X1 pt with p2 := deriv_proof X2 pt in
+ constr:(derivable_pt_plus X1 X2 pt p1 p2)
+ | (?X1 - ?X2)%F =>
+ let p1 := deriv_proof X1 pt with p2 := deriv_proof X2 pt in
+ constr:(derivable_pt_minus X1 X2 pt p1 p2)
+ | (?X1 * ?X2)%F =>
+ let p1 := deriv_proof X1 pt with p2 := deriv_proof X2 pt in
+ constr:(derivable_pt_mult X1 X2 pt p1 p2)
+ | (?X1 / ?X2)%F =>
+ match goal with
+ | id:(?X2 pt <> 0) |- _ =>
+ let p1 := deriv_proof X1 pt with p2 := deriv_proof X2 pt in
+ constr:(derivable_pt_div X1 X2 pt p1 p2 id)
+ | _ => constr:False
+ end
+ | (/ ?X1)%F =>
+ match goal with
+ | id:(?X1 pt <> 0) |- _ =>
+ let p1 := deriv_proof X1 pt in
+ constr:(derivable_pt_inv X1 pt p1 id)
+ | _ => constr:False
+ end
+ | (comp ?X1 ?X2) =>
+ let pt_f1 := eval cbv beta in (X2 pt) in
+ let p1 := deriv_proof X1 pt_f1 with p2 := deriv_proof X2 pt in
+ constr:(derivable_pt_comp X2 X1 pt p2 p1)
+ | (- ?X1)%F =>
+ let p1 := deriv_proof X1 pt in
+ constr:(derivable_pt_opp X1 pt p1)
+ | sin => constr:(derivable_pt_sin pt)
+ | cos => constr:(derivable_pt_cos pt)
+ | sinh => constr:(derivable_pt_sinh pt)
+ | cosh => constr:(derivable_pt_cosh pt)
+ | exp => constr:(derivable_pt_exp pt)
+ | id => constr:(derivable_pt_id pt)
+ | Rsqr => constr:(derivable_pt_Rsqr pt)
+ | sqrt =>
+ match goal with
+ | id:(0 < pt) |- _ => constr:(derivable_pt_sqrt pt id)
+ | _ => constr:False
+ end
+ | (fct_cte ?X1) => constr:(derivable_pt_const X1 pt)
+ | ?X1 =>
+ let aux := constr:X1 in
+ match goal with
+ | id:(derivable_pt aux pt) |- _ => constr:id
+ | id:(derivable aux) |- _ => constr:(id pt)
+ | _ => constr:False
+ end
+ end.
(**********)
-Recursive Tactic Definition SimplifyDerive trm pt :=
-Match trm With
-| [(plus_fct ?1 ?2)] -> Try Rewrite derive_pt_plus; SimplifyDerive ?1 pt; SimplifyDerive ?2 pt
-| [(minus_fct ?1 ?2)] -> Try Rewrite derive_pt_minus; SimplifyDerive ?1 pt; SimplifyDerive ?2 pt
-| [(mult_fct ?1 ?2)] -> Try Rewrite derive_pt_mult; SimplifyDerive ?1 pt; SimplifyDerive ?2 pt
-| [(div_fct ?1 ?2)] -> Try Rewrite derive_pt_div; SimplifyDerive ?1 pt; SimplifyDerive ?2 pt
-| [(comp ?1 ?2)] -> Let pt_f1 = (Eval Cbv Beta in (?2 pt)) In Try Rewrite derive_pt_comp; SimplifyDerive ?1 pt_f1; SimplifyDerive ?2 pt
-| [(opp_fct ?1)] -> Try Rewrite derive_pt_opp; SimplifyDerive ?1 pt
-| [(inv_fct ?1)] -> Try Rewrite derive_pt_inv; SimplifyDerive ?1 pt
-| [(fct_cte ?1)] -> Try Rewrite derive_pt_const
-| [id] -> Try Rewrite derive_pt_id
-| [sin] -> Try Rewrite derive_pt_sin
-| [cos] -> Try Rewrite derive_pt_cos
-| [sinh] -> Try Rewrite derive_pt_sinh
-| [cosh] -> Try Rewrite derive_pt_cosh
-| [exp] -> Try Rewrite derive_pt_exp
-| [Rsqr] -> Try Rewrite derive_pt_Rsqr
-| [sqrt] -> Try Rewrite derive_pt_sqrt
-| [?1] -> Let aux = ?1 In
- (Match Context With
- [ id : (eqT ? (derive_pt aux pt ?2) ?); H : (derivable aux) |- ? ] -> Try Replace (derive_pt aux pt (H pt)) with (derive_pt aux pt ?2); [Rewrite id | Apply pr_nu]
- |[ id : (eqT ? (derive_pt aux pt ?2) ?); H : (derivable_pt aux pt) |- ? ] -> Try Replace (derive_pt aux pt H) with (derive_pt aux pt ?2); [Rewrite id | Apply pr_nu]
- | _ -> Idtac )
-| _ -> Idtac.
+Ltac simplify_derive trm pt :=
+ match constr:trm with
+ | (?X1 + ?X2)%F =>
+ try rewrite derive_pt_plus; simplify_derive X1 pt;
+ simplify_derive X2 pt
+ | (?X1 - ?X2)%F =>
+ try rewrite derive_pt_minus; simplify_derive X1 pt;
+ simplify_derive X2 pt
+ | (?X1 * ?X2)%F =>
+ try rewrite derive_pt_mult; simplify_derive X1 pt;
+ simplify_derive X2 pt
+ | (?X1 / ?X2)%F =>
+ try rewrite derive_pt_div; simplify_derive X1 pt; simplify_derive X2 pt
+ | (comp ?X1 ?X2) =>
+ let pt_f1 := eval cbv beta in (X2 pt) in
+ (try rewrite derive_pt_comp; simplify_derive X1 pt_f1;
+ simplify_derive X2 pt)
+ | (- ?X1)%F => try rewrite derive_pt_opp; simplify_derive X1 pt
+ | (/ ?X1)%F =>
+ try rewrite derive_pt_inv; simplify_derive X1 pt
+ | (fct_cte ?X1) => try rewrite derive_pt_const
+ | id => try rewrite derive_pt_id
+ | sin => try rewrite derive_pt_sin
+ | cos => try rewrite derive_pt_cos
+ | sinh => try rewrite derive_pt_sinh
+ | cosh => try rewrite derive_pt_cosh
+ | exp => try rewrite derive_pt_exp
+ | Rsqr => try rewrite derive_pt_Rsqr
+ | sqrt => try rewrite derive_pt_sqrt
+ | ?X1 =>
+ let aux := constr:X1 in
+ match goal with
+ | id:(derive_pt aux pt ?X2 = _),H:(derivable aux) |- _ =>
+ try replace (derive_pt aux pt (H pt)) with (derive_pt aux pt X2);
+ [ rewrite id | apply pr_nu ]
+ | id:(derive_pt aux pt ?X2 = _),H:(derivable_pt aux pt) |- _ =>
+ try replace (derive_pt aux pt H) with (derive_pt aux pt X2);
+ [ rewrite id | apply pr_nu ]
+ | _ => idtac
+ end
+ | _ => idtac
+ end.
(**********)
-Tactic Definition Reg :=
-Match Context With
-| [|-(derivable_pt ?1 ?2)] ->
-Let trm = Eval Cbv Beta in (?1 AppVar) In
-Let aux = (RewTerm trm) In IntroHypL aux ?2; Try (Change (derivable_pt aux ?2); IsDiff_pt) Orelse IsDiff_pt
-| [|-(derivable ?1)] ->
-Let trm = Eval Cbv Beta in (?1 AppVar) In
-Let aux = (RewTerm trm) In IntroHypG aux; Try (Change (derivable aux); IsDiff_glob) Orelse IsDiff_glob
-| [|-(continuity ?1)] ->
-Let trm = Eval Cbv Beta in (?1 AppVar) In
-Let aux = (RewTerm trm) In IntroHypG aux; Try (Change (continuity aux); IsCont_glob) Orelse IsCont_glob
-| [|-(continuity_pt ?1 ?2)] ->
-Let trm = Eval Cbv Beta in (?1 AppVar) In
-Let aux = (RewTerm trm) In IntroHypL aux ?2; Try (Change (continuity_pt aux ?2); IsCont_pt) Orelse IsCont_pt
-| [|-(eqT ? (derive_pt ?1 ?2 ?3) ?4)] ->
-Let trm = Eval Cbv Beta in (?1 AppVar) In
-Let aux = (RewTerm trm) In
-IntroHypL aux ?2; Let aux2 = (ConsProof aux ?2) In Try (Replace (derive_pt ?1 ?2 ?3) with (derive_pt aux ?2 aux2); [SimplifyDerive aux ?2; Try Unfold plus_fct minus_fct mult_fct div_fct id fct_cte inv_fct opp_fct; Try Ring | Try Apply pr_nu]) Orelse IsDiff_pt.
+Ltac reg :=
+ match goal with
+ | |- (derivable_pt ?X1 ?X2) =>
+ let trm := eval cbv beta in (X1 AppVar) in
+ let aux := rew_term trm in
+ (intro_hyp_pt aux X2;
+ try (change (derivable_pt aux X2) in |- *; is_diff_pt) || is_diff_pt)
+ | |- (derivable ?X1) =>
+ let trm := eval cbv beta in (X1 AppVar) in
+ let aux := rew_term trm in
+ (intro_hyp_glob aux;
+ try (change (derivable aux) in |- *; is_diff_glob) || is_diff_glob)
+ | |- (continuity ?X1) =>
+ let trm := eval cbv beta in (X1 AppVar) in
+ let aux := rew_term trm in
+ (intro_hyp_glob aux;
+ try (change (continuity aux) in |- *; is_cont_glob) || is_cont_glob)
+ | |- (continuity_pt ?X1 ?X2) =>
+ let trm := eval cbv beta in (X1 AppVar) in
+ let aux := rew_term trm in
+ (intro_hyp_pt aux X2;
+ try (change (continuity_pt aux X2) in |- *; is_cont_pt) || is_cont_pt)
+ | |- (derive_pt ?X1 ?X2 ?X3 = ?X4) =>
+ let trm := eval cbv beta in (X1 AppVar) in
+ let aux := rew_term trm in
+ (intro_hyp_pt aux X2;
+ let aux2 := deriv_proof aux X2 in
+ (try
+ (replace (derive_pt X1 X2 X3) with (derive_pt aux X2 aux2);
+ [ simplify_derive aux X2;
+ try
+ unfold plus_fct, minus_fct, mult_fct, div_fct, id, fct_cte,
+ inv_fct, opp_fct in |- *; try ring
+ | try apply pr_nu ]) || is_diff_pt))
+ end. \ No newline at end of file
diff --git a/theories/Reals/Ranalysis1.v b/theories/Reals/Ranalysis1.v
index b8c5c2f4c..f60c609a0 100644
--- a/theories/Reals/Ranalysis1.v
+++ b/theories/Reals/Ranalysis1.v
@@ -8,177 +8,222 @@
(*i $Id$ i*)
-Require Rbase.
-Require Rfunctions.
+Require Import Rbase.
+Require Import Rfunctions.
Require Export Rlimit.
-Require Export Rderiv.
-V7only [Import R_scope.]. Open Local Scope R_scope.
-Implicit Variable Type f:R->R.
+Require Export Rderiv. Open Local Scope R_scope.
+Implicit Type f : R -> R.
(****************************************************)
(** Basic operations on functions *)
(****************************************************)
-Definition plus_fct [f1,f2:R->R] : R->R := [x:R] ``(f1 x)+(f2 x)``.
-Definition opp_fct [f:R->R] : R->R := [x:R] ``-(f x)``.
-Definition mult_fct [f1,f2:R->R] : R->R := [x:R] ``(f1 x)*(f2 x)``.
-Definition mult_real_fct [a:R;f:R->R] : R->R := [x:R] ``a*(f x)``.
-Definition minus_fct [f1,f2:R->R] : R->R := [x:R] ``(f1 x)-(f2 x)``.
-Definition div_fct [f1,f2:R->R] : R->R := [x:R] ``(f1 x)/(f2 x)``.
-Definition div_real_fct [a:R;f:R->R] : R->R := [x:R] ``a/(f x)``.
-Definition comp [f1,f2:R->R] : R->R := [x:R] ``(f1 (f2 x))``.
-Definition inv_fct [f:R->R] : R->R := [x:R]``/(f x)``.
-
-V8Infix "+" plus_fct : Rfun_scope.
-V8Notation "- x" := (opp_fct x) : Rfun_scope.
-V8Infix "*" mult_fct : Rfun_scope.
-V8Infix "-" minus_fct : Rfun_scope.
-V8Infix "/" div_fct : Rfun_scope.
-Notation Local "f1 'o' f2" := (comp f1 f2) (at level 2, right associativity)
- : Rfun_scope
- V8only (at level 20, right associativity).
-V8Notation "/ x" := (inv_fct x) : Rfun_scope.
-
-Delimits Scope Rfun_scope with F.
-
-Definition fct_cte [a:R] : R->R := [x:R]a.
-Definition id := [x:R]x.
+Definition plus_fct f1 f2 (x:R) : R := f1 x + f2 x.
+Definition opp_fct f (x:R) : R := - f x.
+Definition mult_fct f1 f2 (x:R) : R := f1 x * f2 x.
+Definition mult_real_fct (a:R) f (x:R) : R := a * f x.
+Definition minus_fct f1 f2 (x:R) : R := f1 x - f2 x.
+Definition div_fct f1 f2 (x:R) : R := f1 x / f2 x.
+Definition div_real_fct (a:R) f (x:R) : R := a / f x.
+Definition comp f1 f2 (x:R) : R := f1 (f2 x).
+Definition inv_fct f (x:R) : R := / f x.
+
+Infix "+" := plus_fct : Rfun_scope.
+Notation "- x" := (opp_fct x) : Rfun_scope.
+Infix "*" := mult_fct : Rfun_scope.
+Infix "-" := minus_fct : Rfun_scope.
+Infix "/" := div_fct : Rfun_scope.
+Notation Local "f1 'o' f2" := (comp f1 f2)
+ (at level 20, right associativity) : Rfun_scope.
+Notation "/ x" := (inv_fct x) : Rfun_scope.
+
+Delimit Scope Rfun_scope with F.
+
+Definition fct_cte (a x:R) : R := a.
+Definition id (x:R) := x.
(****************************************************)
(** Variations of functions *)
(****************************************************)
-Definition increasing [f:R->R] : Prop := (x,y:R) ``x<=y``->``(f x)<=(f y)``.
-Definition decreasing [f:R->R] : Prop := (x,y:R) ``x<=y``->``(f y)<=(f x)``.
-Definition strict_increasing [f:R->R] : Prop := (x,y:R) ``x<y``->``(f x)<(f y)``.
-Definition strict_decreasing [f:R->R] : Prop := (x,y:R) ``x<y``->``(f y)<(f x)``.
-Definition constant [f:R->R] : Prop := (x,y:R) ``(f x)==(f y)``.
+Definition increasing f : Prop := forall x y:R, x <= y -> f x <= f y.
+Definition decreasing f : Prop := forall x y:R, x <= y -> f y <= f x.
+Definition strict_increasing f : Prop := forall x y:R, x < y -> f x < f y.
+Definition strict_decreasing f : Prop := forall x y:R, x < y -> f y < f x.
+Definition constant f : Prop := forall x y:R, f x = f y.
(**********)
-Definition no_cond : R->Prop := [x:R] True.
+Definition no_cond (x:R) : Prop := True.
(**********)
-Definition constant_D_eq [f:R->R;D:R->Prop;c:R] : Prop := (x:R) (D x) -> (f x)==c.
+Definition constant_D_eq f (D:R -> Prop) (c:R) : Prop :=
+ forall x:R, D x -> f x = c.
(***************************************************)
(** Definition of continuity as a limit *)
(***************************************************)
(**********)
-Definition continuity_pt [f:R->R; x0:R] : Prop := (continue_in f no_cond x0).
-Definition continuity [f:R->R] : Prop := (x:R) (continuity_pt f x).
+Definition continuity_pt f (x0:R) : Prop := continue_in f no_cond x0.
+Definition continuity f : Prop := forall x:R, continuity_pt f x.
Arguments Scope continuity_pt [Rfun_scope R_scope].
Arguments Scope continuity [Rfun_scope].
(**********)
-Lemma continuity_pt_plus : (f1,f2:R->R; x0:R) (continuity_pt f1 x0) -> (continuity_pt f2 x0) -> (continuity_pt (plus_fct f1 f2) x0).
-Unfold continuity_pt plus_fct; Unfold continue_in; Intros; Apply limit_plus; Assumption.
+Lemma continuity_pt_plus :
+ forall f1 f2 (x0:R),
+ continuity_pt f1 x0 -> continuity_pt f2 x0 -> continuity_pt (f1 + f2) x0.
+unfold continuity_pt, plus_fct in |- *; unfold continue_in in |- *; intros;
+ apply limit_plus; assumption.
Qed.
-Lemma continuity_pt_opp : (f:R->R; x0:R) (continuity_pt f x0) -> (continuity_pt (opp_fct f) x0).
-Unfold continuity_pt opp_fct; Unfold continue_in; Intros; Apply limit_Ropp; Assumption.
+Lemma continuity_pt_opp :
+ forall f (x0:R), continuity_pt f x0 -> continuity_pt (- f) x0.
+unfold continuity_pt, opp_fct in |- *; unfold continue_in in |- *; intros;
+ apply limit_Ropp; assumption.
Qed.
-Lemma continuity_pt_minus : (f1,f2:R->R; x0:R) (continuity_pt f1 x0) -> (continuity_pt f2 x0) -> (continuity_pt (minus_fct f1 f2) x0).
-Unfold continuity_pt minus_fct; Unfold continue_in; Intros; Apply limit_minus; Assumption.
-Qed.
-
-Lemma continuity_pt_mult : (f1,f2:R->R; x0:R) (continuity_pt f1 x0) -> (continuity_pt f2 x0) -> (continuity_pt (mult_fct f1 f2) x0).
-Unfold continuity_pt mult_fct; Unfold continue_in; Intros; Apply limit_mul; Assumption.
-Qed.
-
-Lemma continuity_pt_const : (f:R->R; x0:R) (constant f) -> (continuity_pt f x0).
-Unfold constant continuity_pt; Unfold continue_in; Unfold limit1_in; Unfold limit_in; Intros; Exists ``1``; Split; [Apply Rlt_R0_R1 | Intros; Generalize (H x x0); Intro; Rewrite H2; Simpl; Rewrite R_dist_eq; Assumption].
-Qed.
-
-Lemma continuity_pt_scal : (f:R->R;a:R; x0:R) (continuity_pt f x0) -> (continuity_pt (mult_real_fct a f) x0).
-Unfold continuity_pt mult_real_fct; Unfold continue_in; Intros; Apply (limit_mul ([x:R] a) f (D_x no_cond x0) a (f x0) x0).
-Unfold limit1_in; Unfold limit_in; Intros; Exists ``1``; Split.
-Apply Rlt_R0_R1.
-Intros; Rewrite R_dist_eq; Assumption.
-Assumption.
-Qed.
-
-Lemma continuity_pt_inv : (f:R->R; x0:R) (continuity_pt f x0) -> ~``(f x0)==0`` -> (continuity_pt (inv_fct f) x0).
-Intros.
-Replace (inv_fct f) with [x:R]``/(f x)``.
-Unfold continuity_pt; Unfold continue_in; Intros; Apply limit_inv; Assumption.
-Unfold inv_fct; Reflexivity.
+Lemma continuity_pt_minus :
+ forall f1 f2 (x0:R),
+ continuity_pt f1 x0 -> continuity_pt f2 x0 -> continuity_pt (f1 - f2) x0.
+unfold continuity_pt, minus_fct in |- *; unfold continue_in in |- *; intros;
+ apply limit_minus; assumption.
+Qed.
+
+Lemma continuity_pt_mult :
+ forall f1 f2 (x0:R),
+ continuity_pt f1 x0 -> continuity_pt f2 x0 -> continuity_pt (f1 * f2) x0.
+unfold continuity_pt, mult_fct in |- *; unfold continue_in in |- *; intros;
+ apply limit_mul; assumption.
+Qed.
+
+Lemma continuity_pt_const : forall f (x0:R), constant f -> continuity_pt f x0.
+unfold constant, continuity_pt in |- *; unfold continue_in in |- *;
+ unfold limit1_in in |- *; unfold limit_in in |- *;
+ intros; exists 1; split;
+ [ apply Rlt_0_1
+ | intros; generalize (H x x0); intro; rewrite H2; simpl in |- *;
+ rewrite R_dist_eq; assumption ].
+Qed.
+
+Lemma continuity_pt_scal :
+ forall f (a x0:R),
+ continuity_pt f x0 -> continuity_pt (mult_real_fct a f) x0.
+unfold continuity_pt, mult_real_fct in |- *; unfold continue_in in |- *;
+ intros; apply (limit_mul (fun x:R => a) f (D_x no_cond x0) a (f x0) x0).
+unfold limit1_in in |- *; unfold limit_in in |- *; intros; exists 1; split.
+apply Rlt_0_1.
+intros; rewrite R_dist_eq; assumption.
+assumption.
+Qed.
+
+Lemma continuity_pt_inv :
+ forall f (x0:R), continuity_pt f x0 -> f x0 <> 0 -> continuity_pt (/ f) x0.
+intros.
+replace (/ f)%F with (fun x:R => / f x).
+unfold continuity_pt in |- *; unfold continue_in in |- *; intros;
+ apply limit_inv; assumption.
+unfold inv_fct in |- *; reflexivity.
Qed.
-Lemma div_eq_inv : (f1,f2:R->R) (div_fct f1 f2)==(mult_fct f1 (inv_fct f2)).
-Intros; Reflexivity.
+Lemma div_eq_inv : forall f1 f2, (f1 / f2)%F = (f1 * / f2)%F.
+intros; reflexivity.
Qed.
-Lemma continuity_pt_div : (f1,f2:R->R; x0:R) (continuity_pt f1 x0) -> (continuity_pt f2 x0) -> ~``(f2 x0)==0`` -> (continuity_pt (div_fct f1 f2) x0).
-Intros; Rewrite -> (div_eq_inv f1 f2); Apply continuity_pt_mult; [Assumption | Apply continuity_pt_inv; Assumption].
-Qed.
-
-Lemma continuity_pt_comp : (f1,f2:R->R;x:R) (continuity_pt f1 x) -> (continuity_pt f2 (f1 x)) -> (continuity_pt (comp f2 f1) x).
-Unfold continuity_pt; Unfold continue_in; Intros; Unfold comp.
-Cut (limit1_in [x0:R](f2 (f1 x0)) (Dgf (D_x no_cond x) (D_x no_cond (f1 x)) f1)
-(f2 (f1 x)) x) -> (limit1_in [x0:R](f2 (f1 x0)) (D_x no_cond x) (f2 (f1 x)) x).
-Intro; Apply H1.
-EApply limit_comp.
-Apply H.
-Apply H0.
-Unfold limit1_in; Unfold limit_in; Unfold dist; Simpl; Unfold R_dist; Intros.
-Assert H3 := (H1 eps H2).
-Elim H3; Intros.
-Exists x0.
-Split.
-Elim H4; Intros; Assumption.
-Intros; Case (Req_EM (f1 x) (f1 x1)); Intro.
-Rewrite H6; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption.
-Elim H4; Intros; Apply H8.
-Split.
-Unfold Dgf D_x no_cond.
-Split.
-Split.
-Trivial.
-Elim H5; Unfold D_x no_cond; Intros.
-Elim H9; Intros; Assumption.
-Split.
-Trivial.
-Assumption.
-Elim H5; Intros; Assumption.
+Lemma continuity_pt_div :
+ forall f1 f2 (x0:R),
+ continuity_pt f1 x0 ->
+ continuity_pt f2 x0 -> f2 x0 <> 0 -> continuity_pt (f1 / f2) x0.
+intros; rewrite (div_eq_inv f1 f2); apply continuity_pt_mult;
+ [ assumption | apply continuity_pt_inv; assumption ].
+Qed.
+
+Lemma continuity_pt_comp :
+ forall f1 f2 (x:R),
+ continuity_pt f1 x -> continuity_pt f2 (f1 x) -> continuity_pt (f2 o f1) x.
+unfold continuity_pt in |- *; unfold continue_in in |- *; intros;
+ unfold comp in |- *.
+cut
+ (limit1_in (fun x0:R => f2 (f1 x0))
+ (Dgf (D_x no_cond x) (D_x no_cond (f1 x)) f1) (
+ f2 (f1 x)) x ->
+ limit1_in (fun x0:R => f2 (f1 x0)) (D_x no_cond x) (f2 (f1 x)) x).
+intro; apply H1.
+eapply limit_comp.
+apply H.
+apply H0.
+unfold limit1_in in |- *; unfold limit_in in |- *; unfold dist in |- *;
+ simpl in |- *; unfold R_dist in |- *; intros.
+assert (H3 := H1 eps H2).
+elim H3; intros.
+exists x0.
+split.
+elim H4; intros; assumption.
+intros; case (Req_dec (f1 x) (f1 x1)); intro.
+rewrite H6; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+ assumption.
+elim H4; intros; apply H8.
+split.
+unfold Dgf, D_x, no_cond in |- *.
+split.
+split.
+trivial.
+elim H5; unfold D_x, no_cond in |- *; intros.
+elim H9; intros; assumption.
+split.
+trivial.
+assumption.
+elim H5; intros; assumption.
Qed.
(**********)
-Lemma continuity_plus : (f1,f2:R->R) (continuity f1)->(continuity f2)->(continuity (plus_fct f1 f2)).
-Unfold continuity; Intros; Apply (continuity_pt_plus f1 f2 x (H x) (H0 x)).
+Lemma continuity_plus :
+ forall f1 f2, continuity f1 -> continuity f2 -> continuity (f1 + f2).
+unfold continuity in |- *; intros;
+ apply (continuity_pt_plus f1 f2 x (H x) (H0 x)).
Qed.
-Lemma continuity_opp : (f:R->R) (continuity f)->(continuity (opp_fct f)).
-Unfold continuity; Intros; Apply (continuity_pt_opp f x (H x)).
+Lemma continuity_opp : forall f, continuity f -> continuity (- f).
+unfold continuity in |- *; intros; apply (continuity_pt_opp f x (H x)).
Qed.
-Lemma continuity_minus : (f1,f2:R->R) (continuity f1)->(continuity f2)->(continuity (minus_fct f1 f2)).
-Unfold continuity; Intros; Apply (continuity_pt_minus f1 f2 x (H x) (H0 x)).
+Lemma continuity_minus :
+ forall f1 f2, continuity f1 -> continuity f2 -> continuity (f1 - f2).
+unfold continuity in |- *; intros;
+ apply (continuity_pt_minus f1 f2 x (H x) (H0 x)).
Qed.
-Lemma continuity_mult : (f1,f2:R->R) (continuity f1)->(continuity f2)->(continuity (mult_fct f1 f2)).
-Unfold continuity; Intros; Apply (continuity_pt_mult f1 f2 x (H x) (H0 x)).
+Lemma continuity_mult :
+ forall f1 f2, continuity f1 -> continuity f2 -> continuity (f1 * f2).
+unfold continuity in |- *; intros;
+ apply (continuity_pt_mult f1 f2 x (H x) (H0 x)).
Qed.
-Lemma continuity_const : (f:R->R) (constant f) -> (continuity f).
-Unfold continuity; Intros; Apply (continuity_pt_const f x H).
+Lemma continuity_const : forall f, constant f -> continuity f.
+unfold continuity in |- *; intros; apply (continuity_pt_const f x H).
Qed.
-Lemma continuity_scal : (f:R->R;a:R) (continuity f) -> (continuity (mult_real_fct a f)).
-Unfold continuity; Intros; Apply (continuity_pt_scal f a x (H x)).
+Lemma continuity_scal :
+ forall f (a:R), continuity f -> continuity (mult_real_fct a f).
+unfold continuity in |- *; intros; apply (continuity_pt_scal f a x (H x)).
Qed.
-Lemma continuity_inv : (f:R->R) (continuity f)->((x:R) ~``(f x)==0``)->(continuity (inv_fct f)).
-Unfold continuity; Intros; Apply (continuity_pt_inv f x (H x) (H0 x)).
+Lemma continuity_inv :
+ forall f, continuity f -> (forall x:R, f x <> 0) -> continuity (/ f).
+unfold continuity in |- *; intros; apply (continuity_pt_inv f x (H x) (H0 x)).
Qed.
-Lemma continuity_div : (f1,f2:R->R) (continuity f1)->(continuity f2)->((x:R) ~``(f2 x)==0``)->(continuity (div_fct f1 f2)).
-Unfold continuity; Intros; Apply (continuity_pt_div f1 f2 x (H x) (H0 x) (H1 x)).
+Lemma continuity_div :
+ forall f1 f2,
+ continuity f1 ->
+ continuity f2 -> (forall x:R, f2 x <> 0) -> continuity (f1 / f2).
+unfold continuity in |- *; intros;
+ apply (continuity_pt_div f1 f2 x (H x) (H0 x) (H1 x)).
Qed.
-Lemma continuity_comp : (f1,f2:R->R) (continuity f1) -> (continuity f2) -> (continuity (comp f2 f1)).
-Unfold continuity; Intros.
-Apply (continuity_pt_comp f1 f2 x (H x) (H0 (f1 x))).
+Lemma continuity_comp :
+ forall f1 f2, continuity f1 -> continuity f2 -> continuity (f2 o f1).
+unfold continuity in |- *; intros.
+apply (continuity_pt_comp f1 f2 x (H x) (H0 (f1 x))).
Qed.
@@ -186,15 +231,20 @@ Qed.
(** Derivative's definition using Landau's kernel *)
(*****************************************************)
-Definition derivable_pt_lim [f:R->R;x,l:R] : Prop := ((eps:R) ``0<eps``->(EXT delta : posreal | ((h:R) ~``h==0``->``(Rabsolu h)<delta`` -> ``(Rabsolu ((((f (x+h))-(f x))/h)-l))<eps``))).
+Definition derivable_pt_lim f (x l:R) : Prop :=
+ forall eps:R,
+ 0 < eps ->
+ exists delta : posreal
+ | (forall h:R,
+ h <> 0 -> Rabs h < delta -> Rabs ((f (x + h) - f x) / h - l) < eps).
-Definition derivable_pt_abs [f:R->R;x:R] : R -> Prop := [l:R](derivable_pt_lim f x l).
+Definition derivable_pt_abs f (x l:R) : Prop := derivable_pt_lim f x l.
-Definition derivable_pt [f:R->R;x:R] := (SigT R (derivable_pt_abs f x)).
-Definition derivable [f:R->R] := (x:R)(derivable_pt f x).
+Definition derivable_pt f (x:R) := sigT (derivable_pt_abs f x).
+Definition derivable f := forall x:R, derivable_pt f x.
-Definition derive_pt [f:R->R;x:R;pr:(derivable_pt f x)] := (projT1 ? ? pr).
-Definition derive [f:R->R;pr:(derivable f)] := [x:R](derive_pt f x (pr x)).
+Definition derive_pt f (x:R) (pr:derivable_pt f x) := projT1 pr.
+Definition derive f (pr:derivable f) (x:R) := derive_pt f x (pr x).
Arguments Scope derivable_pt_lim [Rfun_scope R_scope].
Arguments Scope derivable_pt_abs [Rfun_scope R_scope R_scope].
@@ -203,125 +253,191 @@ Arguments Scope derivable [Rfun_scope].
Arguments Scope derive_pt [Rfun_scope R_scope _].
Arguments Scope derive [Rfun_scope _].
-Definition antiderivative [f,g:R->R;a,b:R] : Prop := ((x:R)``a<=x<=b``->(EXT pr : (derivable_pt g x) | (f x)==(derive_pt g x pr)))/\``a<=b``.
+Definition antiderivative f (g:R -> R) (a b:R) : Prop :=
+ (forall x:R,
+ a <= x <= b -> exists pr : derivable_pt g x | f x = derive_pt g x pr) /\
+ a <= b.
(************************************)
(** Class of differential functions *)
(************************************)
-Record Differential : Type := mkDifferential {
-d1 :> R->R;
-cond_diff : (derivable d1) }.
+Record Differential : Type := mkDifferential
+ {d1 :> R -> R; cond_diff : derivable d1}.
-Record Differential_D2 : Type := mkDifferential_D2 {
-d2 :> R->R;
-cond_D1 : (derivable d2);
-cond_D2 : (derivable (derive d2 cond_D1)) }.
+Record Differential_D2 : Type := mkDifferential_D2
+ {d2 :> R -> R;
+ cond_D1 : derivable d2;
+ cond_D2 : derivable (derive d2 cond_D1)}.
(**********)
-Lemma unicite_step1 : (f:R->R;x,l1,l2:R) (limit1_in [h:R]``((f (x+h))-(f x))/h`` [h:R]``h<>0`` l1 R0) -> (limit1_in [h:R]``((f (x+h))-(f x))/h`` [h:R]``h<>0`` l2 R0) -> l1 == l2.
-Intros; Apply (single_limit [h:R]``((f (x+h))-(f x))/h`` [h:R]``h<>0`` l1 l2 R0); Try Assumption.
-Unfold adhDa; Intros; Exists ``alp/2``.
-Split.
-Unfold Rdiv; Apply prod_neq_R0.
-Red; Intro; Rewrite H2 in H1; Elim (Rlt_antirefl ? H1).
-Apply Rinv_neq_R0; DiscrR.
-Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Unfold Rdiv; Rewrite Rabsolu_mult.
-Replace ``(Rabsolu (/2))`` with ``/2``.
-Replace (Rabsolu alp) with alp.
-Apply Rlt_monotony_contra with ``2``.
-Sup0.
-Rewrite (Rmult_sym ``2``); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Idtac | DiscrR]; Rewrite Rmult_1r; Rewrite double; Pattern 1 alp; Replace alp with ``alp+0``; [Idtac | Ring]; Apply Rlt_compatibility; Assumption.
-Symmetry; Apply Rabsolu_right; Left; Assumption.
-Symmetry; Apply Rabsolu_right; Left; Change ``0</2``; Apply Rlt_Rinv; Sup0.
-Qed.
-
-Lemma unicite_step2 : (f:R->R;x,l:R) (derivable_pt_lim f x l) -> (limit1_in [h:R]``((f (x+h))-(f x))/h`` [h:R]``h<>0`` l R0).
-Unfold derivable_pt_lim; Intros; Unfold limit1_in; Unfold limit_in; Intros.
-Assert H1 := (H eps H0).
-Elim H1 ; Intros.
-Exists (pos x0).
-Split.
-Apply (cond_pos x0).
-Simpl; Unfold R_dist; Intros.
-Elim H3; Intros.
-Apply H2; [Assumption |Unfold Rminus in H5; Rewrite Ropp_O in H5; Rewrite Rplus_Or in H5; Assumption].
-Qed.
-
-Lemma unicite_step3 : (f:R->R;x,l:R) (limit1_in [h:R]``((f (x+h))-(f x))/h`` [h:R]``h<>0`` l R0) -> (derivable_pt_lim f x l).
-Unfold limit1_in derivable_pt_lim; Unfold limit_in; Unfold dist; Simpl; Intros.
-Elim (H eps H0).
-Intros; Elim H1; Intros.
-Exists (mkposreal x0 H2).
-Simpl; Intros; Unfold R_dist in H3; Apply (H3 h).
-Split; [Assumption | Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Assumption].
-Qed.
-
-Lemma unicite_limite : (f:R->R;x,l1,l2:R) (derivable_pt_lim f x l1) -> (derivable_pt_lim f x l2) -> l1==l2.
-Intros.
-Assert H1 := (unicite_step2 ? ? ? H).
-Assert H2 := (unicite_step2 ? ? ? H0).
-Assert H3 := (unicite_step1 ? ? ? ? H1 H2).
-Assumption.
-Qed.
-
-Lemma derive_pt_eq : (f:R->R;x,l:R;pr:(derivable_pt f x)) (derive_pt f x pr)==l <-> (derivable_pt_lim f x l).
-Intros; Split.
-Intro; Assert H1 := (projT2 ? ? pr); Unfold derive_pt in H; Rewrite H in H1; Assumption.
-Intro; Assert H1 := (projT2 ? ? pr); Unfold derivable_pt_abs in H1.
-Assert H2 := (unicite_limite ? ? ? ? H H1).
-Unfold derive_pt; Unfold derivable_pt_abs.
-Symmetry; Assumption.
+Lemma uniqueness_step1 :
+ forall f (x l1 l2:R),
+ limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) l1 0 ->
+ limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) l2 0 ->
+ l1 = l2.
+intros;
+ apply
+ (single_limit (fun h:R => (f (x + h) - f x) / h) (
+ fun h:R => h <> 0) l1 l2 0); try assumption.
+unfold adhDa in |- *; intros; exists (alp / 2).
+split.
+unfold Rdiv in |- *; apply prod_neq_R0.
+red in |- *; intro; rewrite H2 in H1; elim (Rlt_irrefl _ H1).
+apply Rinv_neq_0_compat; discrR.
+unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0;
+ rewrite Rplus_0_r; unfold Rdiv in |- *; rewrite Rabs_mult.
+replace (Rabs (/ 2)) with (/ 2).
+replace (Rabs alp) with alp.
+apply Rmult_lt_reg_l with 2.
+prove_sup0.
+rewrite (Rmult_comm 2); rewrite Rmult_assoc; rewrite <- Rinv_l_sym;
+ [ idtac | discrR ]; rewrite Rmult_1_r; rewrite double;
+ pattern alp at 1 in |- *; replace alp with (alp + 0);
+ [ idtac | ring ]; apply Rplus_lt_compat_l; assumption.
+symmetry in |- *; apply Rabs_right; left; assumption.
+symmetry in |- *; apply Rabs_right; left; change (0 < / 2) in |- *;
+ apply Rinv_0_lt_compat; prove_sup0.
+Qed.
+
+Lemma uniqueness_step2 :
+ forall f (x l:R),
+ derivable_pt_lim f x l ->
+ limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) l 0.
+unfold derivable_pt_lim in |- *; intros; unfold limit1_in in |- *;
+ unfold limit_in in |- *; intros.
+assert (H1 := H eps H0).
+elim H1; intros.
+exists (pos x0).
+split.
+apply (cond_pos x0).
+simpl in |- *; unfold R_dist in |- *; intros.
+elim H3; intros.
+apply H2;
+ [ assumption
+ | unfold Rminus in H5; rewrite Ropp_0 in H5; rewrite Rplus_0_r in H5;
+ assumption ].
+Qed.
+
+Lemma uniqueness_step3 :
+ forall f (x l:R),
+ limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) l 0 ->
+ derivable_pt_lim f x l.
+unfold limit1_in, derivable_pt_lim in |- *; unfold limit_in in |- *;
+ unfold dist in |- *; simpl in |- *; intros.
+elim (H eps H0).
+intros; elim H1; intros.
+exists (mkposreal x0 H2).
+simpl in |- *; intros; unfold R_dist in H3; apply (H3 h).
+split;
+ [ assumption
+ | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; assumption ].
+Qed.
+
+Lemma uniqueness_limite :
+ forall f (x l1 l2:R),
+ derivable_pt_lim f x l1 -> derivable_pt_lim f x l2 -> l1 = l2.
+intros.
+assert (H1 := uniqueness_step2 _ _ _ H).
+assert (H2 := uniqueness_step2 _ _ _ H0).
+assert (H3 := uniqueness_step1 _ _ _ _ H1 H2).
+assumption.
+Qed.
+
+Lemma derive_pt_eq :
+ forall f (x l:R) (pr:derivable_pt f x),
+ derive_pt f x pr = l <-> derivable_pt_lim f x l.
+intros; split.
+intro; assert (H1 := projT2 pr); unfold derive_pt in H; rewrite H in H1;
+ assumption.
+intro; assert (H1 := projT2 pr); unfold derivable_pt_abs in H1.
+assert (H2 := uniqueness_limite _ _ _ _ H H1).
+unfold derive_pt in |- *; unfold derivable_pt_abs in |- *.
+symmetry in |- *; assumption.
Qed.
(**********)
-Lemma derive_pt_eq_0 : (f:R->R;x,l:R;pr:(derivable_pt f x)) (derivable_pt_lim f x l) -> (derive_pt f x pr)==l.
-Intros; Elim (derive_pt_eq f x l pr); Intros.
-Apply (H1 H).
+Lemma derive_pt_eq_0 :
+ forall f (x l:R) (pr:derivable_pt f x),
+ derivable_pt_lim f x l -> derive_pt f x pr = l.
+intros; elim (derive_pt_eq f x l pr); intros.
+apply (H1 H).
Qed.
(**********)
-Lemma derive_pt_eq_1 : (f:R->R;x,l:R;pr:(derivable_pt f x)) (derive_pt f x pr)==l -> (derivable_pt_lim f x l).
-Intros; Elim (derive_pt_eq f x l pr); Intros.
-Apply (H0 H).
+Lemma derive_pt_eq_1 :
+ forall f (x l:R) (pr:derivable_pt f x),
+ derive_pt f x pr = l -> derivable_pt_lim f x l.
+intros; elim (derive_pt_eq f x l pr); intros.
+apply (H0 H).
Qed.
(********************************************************************)
(** Equivalence of this definition with the one using limit concept *)
(********************************************************************)
-Lemma derive_pt_D_in : (f,df:R->R;x:R;pr:(derivable_pt f x)) (D_in f df no_cond x) <-> (derive_pt f x pr)==(df x).
-Intros; Split.
-Unfold D_in; Unfold limit1_in; Unfold limit_in; Simpl; Unfold R_dist; Intros.
-Apply derive_pt_eq_0.
-Unfold derivable_pt_lim.
-Intros; Elim (H eps H0); Intros alpha H1; Elim H1; Intros; Exists (mkposreal alpha H2); Intros; Generalize (H3 ``x+h``); Intro; Cut ``x+h-x==h``; [Intro; Cut ``(D_x no_cond x (x+h))``/\``(Rabsolu (x+h-x)) < alpha``; [Intro; Generalize (H6 H8); Rewrite H7; Intro; Assumption | Split; [Unfold D_x; Split; [Unfold no_cond; Trivial | Apply Rminus_not_eq_right; Rewrite H7; Assumption] | Rewrite H7; Assumption]] | Ring].
-Intro.
-Assert H0 := (derive_pt_eq_1 f x (df x) pr H).
-Unfold D_in; Unfold limit1_in; Unfold limit_in; Unfold dist; Simpl; Unfold R_dist; Intros.
-Elim (H0 eps H1); Intros alpha H2; Exists (pos alpha); Split.
-Apply (cond_pos alpha).
-Intros; Elim H3; Intros; Unfold D_x in H4; Elim H4; Intros; Cut ``x0-x<>0``.
-Intro; Generalize (H2 ``x0-x`` H8 H5); Replace ``x+(x0-x)`` with x0.
-Intro; Assumption.
-Ring.
-Auto with real.
-Qed.
-
-Lemma derivable_pt_lim_D_in : (f,df:R->R;x:R) (D_in f df no_cond x) <-> (derivable_pt_lim f x (df x)).
-Intros; Split.
-Unfold D_in; Unfold limit1_in; Unfold limit_in; Simpl; Unfold R_dist; Intros.
-Unfold derivable_pt_lim.
-Intros; Elim (H eps H0); Intros alpha H1; Elim H1; Intros; Exists (mkposreal alpha H2); Intros; Generalize (H3 ``x+h``); Intro; Cut ``x+h-x==h``; [Intro; Cut ``(D_x no_cond x (x+h))``/\``(Rabsolu (x+h-x)) < alpha``; [Intro; Generalize (H6 H8); Rewrite H7; Intro; Assumption | Split; [Unfold D_x; Split; [Unfold no_cond; Trivial | Apply Rminus_not_eq_right; Rewrite H7; Assumption] | Rewrite H7; Assumption]] | Ring].
-Intro.
-Unfold derivable_pt_lim in H.
-Unfold D_in; Unfold limit1_in; Unfold limit_in; Unfold dist; Simpl; Unfold R_dist; Intros.
-Elim (H eps H0); Intros alpha H2; Exists (pos alpha); Split.
-Apply (cond_pos alpha).
-Intros.
-Elim H1; Intros; Unfold D_x in H3; Elim H3; Intros; Cut ``x0-x<>0``.
-Intro; Generalize (H2 ``x0-x`` H7 H4); Replace ``x+(x0-x)`` with x0.
-Intro; Assumption.
-Ring.
-Auto with real.
+Lemma derive_pt_D_in :
+ forall f (df:R -> R) (x:R) (pr:derivable_pt f x),
+ D_in f df no_cond x <-> derive_pt f x pr = df x.
+intros; split.
+unfold D_in in |- *; unfold limit1_in in |- *; unfold limit_in in |- *;
+ simpl in |- *; unfold R_dist in |- *; intros.
+apply derive_pt_eq_0.
+unfold derivable_pt_lim in |- *.
+intros; elim (H eps H0); intros alpha H1; elim H1; intros;
+ exists (mkposreal alpha H2); intros; generalize (H3 (x + h));
+ intro; cut (x + h - x = h);
+ [ intro; cut (D_x no_cond x (x + h) /\ Rabs (x + h - x) < alpha);
+ [ intro; generalize (H6 H8); rewrite H7; intro; assumption
+ | split;
+ [ unfold D_x in |- *; split;
+ [ unfold no_cond in |- *; trivial
+ | apply Rminus_not_eq_right; rewrite H7; assumption ]
+ | rewrite H7; assumption ] ]
+ | ring ].
+intro.
+assert (H0 := derive_pt_eq_1 f x (df x) pr H).
+unfold D_in in |- *; unfold limit1_in in |- *; unfold limit_in in |- *;
+ unfold dist in |- *; simpl in |- *; unfold R_dist in |- *;
+ intros.
+elim (H0 eps H1); intros alpha H2; exists (pos alpha); split.
+apply (cond_pos alpha).
+intros; elim H3; intros; unfold D_x in H4; elim H4; intros; cut (x0 - x <> 0).
+intro; generalize (H2 (x0 - x) H8 H5); replace (x + (x0 - x)) with x0.
+intro; assumption.
+ring.
+auto with real.
+Qed.
+
+Lemma derivable_pt_lim_D_in :
+ forall f (df:R -> R) (x:R),
+ D_in f df no_cond x <-> derivable_pt_lim f x (df x).
+intros; split.
+unfold D_in in |- *; unfold limit1_in in |- *; unfold limit_in in |- *;
+ simpl in |- *; unfold R_dist in |- *; intros.
+unfold derivable_pt_lim in |- *.
+intros; elim (H eps H0); intros alpha H1; elim H1; intros;
+ exists (mkposreal alpha H2); intros; generalize (H3 (x + h));
+ intro; cut (x + h - x = h);
+ [ intro; cut (D_x no_cond x (x + h) /\ Rabs (x + h - x) < alpha);
+ [ intro; generalize (H6 H8); rewrite H7; intro; assumption
+ | split;
+ [ unfold D_x in |- *; split;
+ [ unfold no_cond in |- *; trivial
+ | apply Rminus_not_eq_right; rewrite H7; assumption ]
+ | rewrite H7; assumption ] ]
+ | ring ].
+intro.
+unfold derivable_pt_lim in H.
+unfold D_in in |- *; unfold limit1_in in |- *; unfold limit_in in |- *;
+ unfold dist in |- *; simpl in |- *; unfold R_dist in |- *;
+ intros.
+elim (H eps H0); intros alpha H2; exists (pos alpha); split.
+apply (cond_pos alpha).
+intros.
+elim H1; intros; unfold D_x in H3; elim H3; intros; cut (x0 - x <> 0).
+intro; generalize (H2 (x0 - x) H7 H4); replace (x + (x0 - x)) with x0.
+intro; assumption.
+ring.
+auto with real.
Qed.
@@ -329,457 +445,555 @@ Qed.
(** derivability -> continuity *)
(***********************************)
(**********)
-Lemma derivable_derive : (f:R->R;x:R;pr:(derivable_pt f x)) (EXT l : R | (derive_pt f x pr)==l).
-Intros; Exists (projT1 ? ? pr).
-Unfold derive_pt; Reflexivity.
+Lemma derivable_derive :
+ forall f (x:R) (pr:derivable_pt f x), exists l : R | derive_pt f x pr = l.
+intros; exists (projT1 pr).
+unfold derive_pt in |- *; reflexivity.
Qed.
-Theorem derivable_continuous_pt : (f:R->R;x:R) (derivable_pt f x) -> (continuity_pt f x).
-Intros.
-Generalize (derivable_derive f x X); Intro.
-Elim H; Intros l H1.
-Cut l==((fct_cte l) x).
-Intro.
-Rewrite H0 in H1.
-Generalize (derive_pt_D_in f (fct_cte l) x); Intro.
-Elim (H2 X); Intros.
-Generalize (H4 H1); Intro.
-Unfold continuity_pt.
-Apply (cont_deriv f (fct_cte l) no_cond x H5).
-Unfold fct_cte; Reflexivity.
+Theorem derivable_continuous_pt :
+ forall f (x:R), derivable_pt f x -> continuity_pt f x.
+intros.
+generalize (derivable_derive f x X); intro.
+elim H; intros l H1.
+cut (l = fct_cte l x).
+intro.
+rewrite H0 in H1.
+generalize (derive_pt_D_in f (fct_cte l) x); intro.
+elim (H2 X); intros.
+generalize (H4 H1); intro.
+unfold continuity_pt in |- *.
+apply (cont_deriv f (fct_cte l) no_cond x H5).
+unfold fct_cte in |- *; reflexivity.
Qed.
-Theorem derivable_continuous : (f:R->R) (derivable f) -> (continuity f).
-Unfold derivable continuity; Intros.
-Apply (derivable_continuous_pt f x (X x)).
+Theorem derivable_continuous : forall f, derivable f -> continuity f.
+unfold derivable, continuity in |- *; intros.
+apply (derivable_continuous_pt f x (X x)).
Qed.
(****************************************************************)
(** Main rules *)
(****************************************************************)
-Lemma derivable_pt_lim_plus : (f1,f2:R->R;x,l1,l2:R) (derivable_pt_lim f1 x l1) -> (derivable_pt_lim f2 x l2) -> (derivable_pt_lim (plus_fct f1 f2) x ``l1+l2``).
-Intros.
-Apply unicite_step3.
-Assert H1 := (unicite_step2 ? ? ? H).
-Assert H2 := (unicite_step2 ? ? ? H0).
-Unfold plus_fct.
-Cut (h:R)``((f1 (x+h))+(f2 (x+h))-((f1 x)+(f2 x)))/h``==``((f1 (x+h))-(f1 x))/h+((f2 (x+h))-(f2 x))/h``.
-Intro.
-Generalize(limit_plus [h':R]``((f1 (x+h'))-(f1 x))/h'`` [h':R]``((f2 (x+h'))-(f2 x))/h'`` [h:R]``h <> 0`` l1 l2 ``0`` H1 H2).
-Unfold limit1_in; Unfold limit_in; Unfold dist; Simpl; Unfold R_dist; Intros.
-Elim (H4 eps H5); Intros.
-Exists x0.
-Elim H6; Intros.
-Split.
-Assumption.
-Intros; Rewrite H3; Apply H8; Assumption.
-Intro; Unfold Rdiv; Ring.
-Qed.
-
-Lemma derivable_pt_lim_opp : (f:R->R;x,l:R) (derivable_pt_lim f x l) -> (derivable_pt_lim (opp_fct f) x (Ropp l)).
-Intros.
-Apply unicite_step3.
-Assert H1 := (unicite_step2 ? ? ? H).
-Unfold opp_fct.
-Cut (h:R) ``( -(f (x+h))- -(f x))/h``==(Ropp ``((f (x+h))-(f x))/h``).
-Intro.
-Generalize (limit_Ropp [h:R]``((f (x+h))-(f x))/h``[h:R]``h <> 0`` l ``0`` H1).
-Unfold limit1_in; Unfold limit_in; Unfold dist; Simpl; Unfold R_dist; Intros.
-Elim (H2 eps H3); Intros.
-Exists x0.
-Elim H4; Intros.
-Split.
-Assumption.
-Intros; Rewrite H0; Apply H6; Assumption.
-Intro; Unfold Rdiv; Ring.
-Qed.
-
-Lemma derivable_pt_lim_minus : (f1,f2:R->R;x,l1,l2:R) (derivable_pt_lim f1 x l1) -> (derivable_pt_lim f2 x l2) -> (derivable_pt_lim (minus_fct f1 f2) x ``l1-l2``).
-Intros.
-Apply unicite_step3.
-Assert H1 := (unicite_step2 ? ? ? H).
-Assert H2 := (unicite_step2 ? ? ? H0).
-Unfold minus_fct.
-Cut (h:R)``((f1 (x+h))-(f1 x))/h-((f2 (x+h))-(f2 x))/h``==``((f1 (x+h))-(f2 (x+h))-((f1 x)-(f2 x)))/h``.
-Intro.
-Generalize (limit_minus [h':R]``((f1 (x+h'))-(f1 x))/h'`` [h':R]``((f2 (x+h'))-(f2 x))/h'`` [h:R]``h <> 0`` l1 l2 ``0`` H1 H2).
-Unfold limit1_in; Unfold limit_in; Unfold dist; Simpl; Unfold R_dist; Intros.
-Elim (H4 eps H5); Intros.
-Exists x0.
-Elim H6; Intros.
-Split.
-Assumption.
-Intros; Rewrite <- H3; Apply H8; Assumption.
-Intro; Unfold Rdiv; Ring.
-Qed.
-
-Lemma derivable_pt_lim_mult : (f1,f2:R->R;x,l1,l2:R) (derivable_pt_lim f1 x l1) -> (derivable_pt_lim f2 x l2) -> (derivable_pt_lim (mult_fct f1 f2) x ``l1*(f2 x)+(f1 x)*l2``).
-Intros.
-Assert H1 := (derivable_pt_lim_D_in f1 [y:R]l1 x).
-Elim H1; Intros.
-Assert H4 := (H3 H).
-Assert H5 := (derivable_pt_lim_D_in f2 [y:R]l2 x).
-Elim H5; Intros.
-Assert H8 := (H7 H0).
-Clear H1 H2 H3 H5 H6 H7.
-Assert H1 := (derivable_pt_lim_D_in (mult_fct f1 f2) [y:R]``l1*(f2 x)+(f1 x)*l2`` x).
-Elim H1; Intros.
-Clear H1 H3.
-Apply H2.
-Unfold mult_fct.
-Apply (Dmult no_cond [y:R]l1 [y:R]l2 f1 f2 x); Assumption.
-Qed.
-
-Lemma derivable_pt_lim_const : (a,x:R) (derivable_pt_lim (fct_cte a) x ``0``).
-Intros; Unfold fct_cte derivable_pt_lim.
-Intros; Exists (mkposreal ``1`` Rlt_R0_R1); Intros; Unfold Rminus; Rewrite Rplus_Ropp_r; Unfold Rdiv; Rewrite Rmult_Ol; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption.
-Qed.
-
-Lemma derivable_pt_lim_scal : (f:R->R;a,x,l:R) (derivable_pt_lim f x l) -> (derivable_pt_lim (mult_real_fct a f) x ``a*l``).
-Intros.
-Assert H0 := (derivable_pt_lim_const a x).
-Replace (mult_real_fct a f) with (mult_fct (fct_cte a) f).
-Replace ``a*l`` with ``0*(f x)+a*l``; [Idtac | Ring].
-Apply (derivable_pt_lim_mult (fct_cte a) f x ``0`` l); Assumption.
-Unfold mult_real_fct mult_fct fct_cte; Reflexivity.
-Qed.
-
-Lemma derivable_pt_lim_id : (x:R) (derivable_pt_lim id x ``1``).
-Intro; Unfold derivable_pt_lim.
-Intros eps Heps; Exists (mkposreal eps Heps); Intros h H1 H2; Unfold id; Replace ``(x+h-x)/h-1`` with ``0``.
-Rewrite Rabsolu_R0; Apply Rle_lt_trans with ``(Rabsolu h)``.
-Apply Rabsolu_pos.
-Assumption.
-Unfold Rminus; Rewrite Rplus_assoc; Rewrite (Rplus_sym x); Rewrite Rplus_assoc.
-Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Unfold Rdiv; Rewrite <- Rinv_r_sym.
-Symmetry; Apply Rplus_Ropp_r.
-Assumption.
-Qed.
-
-Lemma derivable_pt_lim_Rsqr : (x:R) (derivable_pt_lim Rsqr x ``2*x``).
-Intro; Unfold derivable_pt_lim.
-Unfold Rsqr; Intros eps Heps; Exists (mkposreal eps Heps); Intros h H1 H2; Replace ``((x+h)*(x+h)-x*x)/h-2*x`` with ``h``.
-Assumption.
-Replace ``(x+h)*(x+h)-x*x`` with ``2*x*h+h*h``; [Idtac | Ring].
-Unfold Rdiv; Rewrite Rmult_Rplus_distrl.
-Repeat Rewrite Rmult_assoc.
-Repeat Rewrite <- Rinv_r_sym; [Idtac | Assumption].
-Ring.
-Qed.
-
-Lemma derivable_pt_lim_comp : (f1,f2:R->R;x,l1,l2:R) (derivable_pt_lim f1 x l1) -> (derivable_pt_lim f2 (f1 x) l2) -> (derivable_pt_lim (comp f2 f1) x ``l2*l1``).
-Intros; Assert H1 := (derivable_pt_lim_D_in f1 [y:R]l1 x).
-Elim H1; Intros.
-Assert H4 := (H3 H).
-Assert H5 := (derivable_pt_lim_D_in f2 [y:R]l2 (f1 x)).
-Elim H5; Intros.
-Assert H8 := (H7 H0).
-Clear H1 H2 H3 H5 H6 H7.
-Assert H1 := (derivable_pt_lim_D_in (comp f2 f1) [y:R]``l2*l1`` x).
-Elim H1; Intros.
-Clear H1 H3; Apply H2.
-Unfold comp; Cut (D_in [x0:R](f2 (f1 x0)) [y:R]``l2*l1`` (Dgf no_cond no_cond f1) x) -> (D_in [x0:R](f2 (f1 x0)) [y:R]``l2*l1`` no_cond x).
-Intro; Apply H1.
-Rewrite Rmult_sym; Apply (Dcomp no_cond no_cond [y:R]l1 [y:R]l2 f1 f2 x); Assumption.
-Unfold Dgf D_in no_cond; Unfold limit1_in; Unfold limit_in; Unfold dist; Simpl; Unfold R_dist; Intros.
-Elim (H1 eps H3); Intros.
-Exists x0; Intros; Split.
-Elim H5; Intros; Assumption.
-Intros; Elim H5; Intros; Apply H9; Split.
-Unfold D_x; Split.
-Split; Trivial.
-Elim H6; Intros; Unfold D_x in H10; Elim H10; Intros; Assumption.
-Elim H6; Intros; Assumption.
-Qed.
-
-Lemma derivable_pt_plus : (f1,f2:R->R;x:R) (derivable_pt f1 x) -> (derivable_pt f2 x) -> (derivable_pt (plus_fct f1 f2) x).
-Unfold derivable_pt; Intros.
-Elim X; Intros.
-Elim X0; Intros.
-Apply Specif.existT with ``x0+x1``.
-Apply derivable_pt_lim_plus; Assumption.
-Qed.
-
-Lemma derivable_pt_opp : (f:R->R;x:R) (derivable_pt f x) -> (derivable_pt (opp_fct f) x).
-Unfold derivable_pt; Intros.
-Elim X; Intros.
-Apply Specif.existT with ``-x0``.
-Apply derivable_pt_lim_opp; Assumption.
-Qed.
-
-Lemma derivable_pt_minus : (f1,f2:R->R;x:R) (derivable_pt f1 x) -> (derivable_pt f2 x) -> (derivable_pt (minus_fct f1 f2) x).
-Unfold derivable_pt; Intros.
-Elim X; Intros.
-Elim X0; Intros.
-Apply Specif.existT with ``x0-x1``.
-Apply derivable_pt_lim_minus; Assumption.
-Qed.
-
-Lemma derivable_pt_mult : (f1,f2:R->R;x:R) (derivable_pt f1 x) -> (derivable_pt f2 x) -> (derivable_pt (mult_fct f1 f2) x).
-Unfold derivable_pt; Intros.
-Elim X; Intros.
-Elim X0; Intros.
-Apply Specif.existT with ``x0*(f2 x)+(f1 x)*x1``.
-Apply derivable_pt_lim_mult; Assumption.
-Qed.
-
-Lemma derivable_pt_const : (a,x:R) (derivable_pt (fct_cte a) x).
-Intros; Unfold derivable_pt.
-Apply Specif.existT with ``0``.
-Apply derivable_pt_lim_const.
-Qed.
-
-Lemma derivable_pt_scal : (f:R->R;a,x:R) (derivable_pt f x) -> (derivable_pt (mult_real_fct a f) x).
-Unfold derivable_pt; Intros.
-Elim X; Intros.
-Apply Specif.existT with ``a*x0``.
-Apply derivable_pt_lim_scal; Assumption.
-Qed.
-
-Lemma derivable_pt_id : (x:R) (derivable_pt id x).
-Unfold derivable_pt; Intro.
-Exists ``1``.
-Apply derivable_pt_lim_id.
-Qed.
-
-Lemma derivable_pt_Rsqr : (x:R) (derivable_pt Rsqr x).
-Unfold derivable_pt; Intro; Apply Specif.existT with ``2*x``.
-Apply derivable_pt_lim_Rsqr.
-Qed.
-
-Lemma derivable_pt_comp : (f1,f2:R->R;x:R) (derivable_pt f1 x) -> (derivable_pt f2 (f1 x)) -> (derivable_pt (comp f2 f1) x).
-Unfold derivable_pt; Intros.
-Elim X; Intros.
-Elim X0 ;Intros.
-Apply Specif.existT with ``x1*x0``.
-Apply derivable_pt_lim_comp; Assumption.
-Qed.
-
-Lemma derivable_plus : (f1,f2:R->R) (derivable f1) -> (derivable f2) -> (derivable (plus_fct f1 f2)).
-Unfold derivable; Intros.
-Apply (derivable_pt_plus ? ? x (X ?) (X0 ?)).
-Qed.
-
-Lemma derivable_opp : (f:R->R) (derivable f) -> (derivable (opp_fct f)).
-Unfold derivable; Intros.
-Apply (derivable_pt_opp ? x (X ?)).
-Qed.
-
-Lemma derivable_minus : (f1,f2:R->R) (derivable f1) -> (derivable f2) -> (derivable (minus_fct f1 f2)).
-Unfold derivable; Intros.
-Apply (derivable_pt_minus ? ? x (X ?) (X0 ?)).
-Qed.
-
-Lemma derivable_mult : (f1,f2:R->R) (derivable f1) -> (derivable f2) -> (derivable (mult_fct f1 f2)).
-Unfold derivable; Intros.
-Apply (derivable_pt_mult ? ? x (X ?) (X0 ?)).
-Qed.
-
-Lemma derivable_const : (a:R) (derivable (fct_cte a)).
-Unfold derivable; Intros.
-Apply derivable_pt_const.
-Qed.
-
-Lemma derivable_scal : (f:R->R;a:R) (derivable f) -> (derivable (mult_real_fct a f)).
-Unfold derivable; Intros.
-Apply (derivable_pt_scal ? a x (X ?)).
-Qed.
-
-Lemma derivable_id : (derivable id).
-Unfold derivable; Intro; Apply derivable_pt_id.
-Qed.
-
-Lemma derivable_Rsqr : (derivable Rsqr).
-Unfold derivable; Intro; Apply derivable_pt_Rsqr.
-Qed.
-
-Lemma derivable_comp : (f1,f2:R->R) (derivable f1) -> (derivable f2) -> (derivable (comp f2 f1)).
-Unfold derivable; Intros.
-Apply (derivable_pt_comp ? ? x (X ?) (X0 ?)).
-Qed.
-
-Lemma derive_pt_plus : (f1,f2:R->R;x:R;pr1:(derivable_pt f1 x);pr2:(derivable_pt f2 x)) ``(derive_pt (plus_fct f1 f2) x (derivable_pt_plus ? ? ? pr1 pr2)) == (derive_pt f1 x pr1) + (derive_pt f2 x pr2)``.
-Intros.
-Assert H := (derivable_derive f1 x pr1).
-Assert H0 := (derivable_derive f2 x pr2).
-Assert H1 := (derivable_derive (plus_fct f1 f2) x (derivable_pt_plus ? ? ? pr1 pr2)).
-Elim H; Clear H; Intros l1 H.
-Elim H0; Clear H0; Intros l2 H0.
-Elim H1; Clear H1; Intros l H1.
-Rewrite H; Rewrite H0; Apply derive_pt_eq_0.
-Assert H3 := (projT2 ? ? pr1).
-Unfold derive_pt in H; Rewrite H in H3.
-Assert H4 := (projT2 ? ? pr2).
-Unfold derive_pt in H0; Rewrite H0 in H4.
-Apply derivable_pt_lim_plus; Assumption.
-Qed.
-
-Lemma derive_pt_opp : (f:R->R;x:R;pr1:(derivable_pt f x)) ``(derive_pt (opp_fct f) x (derivable_pt_opp ? ? pr1)) == -(derive_pt f x pr1)``.
-Intros.
-Assert H := (derivable_derive f x pr1).
-Assert H0 := (derivable_derive (opp_fct f) x (derivable_pt_opp ? ? pr1)).
-Elim H; Clear H; Intros l1 H.
-Elim H0; Clear H0; Intros l2 H0.
-Rewrite H; Apply derive_pt_eq_0.
-Assert H3 := (projT2 ? ? pr1).
-Unfold derive_pt in H; Rewrite H in H3.
-Apply derivable_pt_lim_opp; Assumption.
-Qed.
-
-Lemma derive_pt_minus : (f1,f2:R->R;x:R;pr1:(derivable_pt f1 x);pr2:(derivable_pt f2 x)) ``(derive_pt (minus_fct f1 f2) x (derivable_pt_minus ? ? ? pr1 pr2)) == (derive_pt f1 x pr1) - (derive_pt f2 x pr2)``.
-Intros.
-Assert H := (derivable_derive f1 x pr1).
-Assert H0 := (derivable_derive f2 x pr2).
-Assert H1 := (derivable_derive (minus_fct f1 f2) x (derivable_pt_minus ? ? ? pr1 pr2)).
-Elim H; Clear H; Intros l1 H.
-Elim H0; Clear H0; Intros l2 H0.
-Elim H1; Clear H1; Intros l H1.
-Rewrite H; Rewrite H0; Apply derive_pt_eq_0.
-Assert H3 := (projT2 ? ? pr1).
-Unfold derive_pt in H; Rewrite H in H3.
-Assert H4 := (projT2 ? ? pr2).
-Unfold derive_pt in H0; Rewrite H0 in H4.
-Apply derivable_pt_lim_minus; Assumption.
-Qed.
-
-Lemma derive_pt_mult : (f1,f2:R->R;x:R;pr1:(derivable_pt f1 x);pr2:(derivable_pt f2 x)) ``(derive_pt (mult_fct f1 f2) x (derivable_pt_mult ? ? ? pr1 pr2)) == (derive_pt f1 x pr1)*(f2 x) + (f1 x)*(derive_pt f2 x pr2)``.
-Intros.
-Assert H := (derivable_derive f1 x pr1).
-Assert H0 := (derivable_derive f2 x pr2).
-Assert H1 := (derivable_derive (mult_fct f1 f2) x (derivable_pt_mult ? ? ? pr1 pr2)).
-Elim H; Clear H; Intros l1 H.
-Elim H0; Clear H0; Intros l2 H0.
-Elim H1; Clear H1; Intros l H1.
-Rewrite H; Rewrite H0; Apply derive_pt_eq_0.
-Assert H3 := (projT2 ? ? pr1).
-Unfold derive_pt in H; Rewrite H in H3.
-Assert H4 := (projT2 ? ? pr2).
-Unfold derive_pt in H0; Rewrite H0 in H4.
-Apply derivable_pt_lim_mult; Assumption.
-Qed.
-
-Lemma derive_pt_const : (a,x:R) (derive_pt (fct_cte a) x (derivable_pt_const a x)) == R0.
-Intros.
-Apply derive_pt_eq_0.
-Apply derivable_pt_lim_const.
-Qed.
-
-Lemma derive_pt_scal : (f:R->R;a,x:R;pr:(derivable_pt f x)) ``(derive_pt (mult_real_fct a f) x (derivable_pt_scal ? ? ? pr)) == a * (derive_pt f x pr)``.
-Intros.
-Assert H := (derivable_derive f x pr).
-Assert H0 := (derivable_derive (mult_real_fct a f) x (derivable_pt_scal ? ? ? pr)).
-Elim H; Clear H; Intros l1 H.
-Elim H0; Clear H0; Intros l2 H0.
-Rewrite H; Apply derive_pt_eq_0.
-Assert H3 := (projT2 ? ? pr).
-Unfold derive_pt in H; Rewrite H in H3.
-Apply derivable_pt_lim_scal; Assumption.
-Qed.
-
-Lemma derive_pt_id : (x:R) (derive_pt id x (derivable_pt_id ?))==R1.
-Intros.
-Apply derive_pt_eq_0.
-Apply derivable_pt_lim_id.
-Qed.
-
-Lemma derive_pt_Rsqr : (x:R) (derive_pt Rsqr x (derivable_pt_Rsqr ?)) == ``2*x``.
-Intros.
-Apply derive_pt_eq_0.
-Apply derivable_pt_lim_Rsqr.
-Qed.
-
-Lemma derive_pt_comp : (f1,f2:R->R;x:R;pr1:(derivable_pt f1 x);pr2:(derivable_pt f2 (f1 x))) ``(derive_pt (comp f2 f1) x (derivable_pt_comp ? ? ? pr1 pr2)) == (derive_pt f2 (f1 x) pr2) * (derive_pt f1 x pr1)``.
-Intros.
-Assert H := (derivable_derive f1 x pr1).
-Assert H0 := (derivable_derive f2 (f1 x) pr2).
-Assert H1 := (derivable_derive (comp f2 f1) x (derivable_pt_comp ? ? ? pr1 pr2)).
-Elim H; Clear H; Intros l1 H.
-Elim H0; Clear H0; Intros l2 H0.
-Elim H1; Clear H1; Intros l H1.
-Rewrite H; Rewrite H0; Apply derive_pt_eq_0.
-Assert H3 := (projT2 ? ? pr1).
-Unfold derive_pt in H; Rewrite H in H3.
-Assert H4 := (projT2 ? ? pr2).
-Unfold derive_pt in H0; Rewrite H0 in H4.
-Apply derivable_pt_lim_comp; Assumption.
+Lemma derivable_pt_lim_plus :
+ forall f1 f2 (x l1 l2:R),
+ derivable_pt_lim f1 x l1 ->
+ derivable_pt_lim f2 x l2 -> derivable_pt_lim (f1 + f2) x (l1 + l2).
+intros.
+apply uniqueness_step3.
+assert (H1 := uniqueness_step2 _ _ _ H).
+assert (H2 := uniqueness_step2 _ _ _ H0).
+unfold plus_fct in |- *.
+cut
+ (forall h:R,
+ (f1 (x + h) + f2 (x + h) - (f1 x + f2 x)) / h =
+ (f1 (x + h) - f1 x) / h + (f2 (x + h) - f2 x) / h).
+intro.
+generalize
+ (limit_plus (fun h':R => (f1 (x + h') - f1 x) / h')
+ (fun h':R => (f2 (x + h') - f2 x) / h') (fun h:R => h <> 0) l1 l2 0 H1 H2).
+unfold limit1_in in |- *; unfold limit_in in |- *; unfold dist in |- *;
+ simpl in |- *; unfold R_dist in |- *; intros.
+elim (H4 eps H5); intros.
+exists x0.
+elim H6; intros.
+split.
+assumption.
+intros; rewrite H3; apply H8; assumption.
+intro; unfold Rdiv in |- *; ring.
+Qed.
+
+Lemma derivable_pt_lim_opp :
+ forall f (x l:R), derivable_pt_lim f x l -> derivable_pt_lim (- f) x (- l).
+intros.
+apply uniqueness_step3.
+assert (H1 := uniqueness_step2 _ _ _ H).
+unfold opp_fct in |- *.
+cut (forall h:R, (- f (x + h) - - f x) / h = - ((f (x + h) - f x) / h)).
+intro.
+generalize
+ (limit_Ropp (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) l 0 H1).
+unfold limit1_in in |- *; unfold limit_in in |- *; unfold dist in |- *;
+ simpl in |- *; unfold R_dist in |- *; intros.
+elim (H2 eps H3); intros.
+exists x0.
+elim H4; intros.
+split.
+assumption.
+intros; rewrite H0; apply H6; assumption.
+intro; unfold Rdiv in |- *; ring.
+Qed.
+
+Lemma derivable_pt_lim_minus :
+ forall f1 f2 (x l1 l2:R),
+ derivable_pt_lim f1 x l1 ->
+ derivable_pt_lim f2 x l2 -> derivable_pt_lim (f1 - f2) x (l1 - l2).
+intros.
+apply uniqueness_step3.
+assert (H1 := uniqueness_step2 _ _ _ H).
+assert (H2 := uniqueness_step2 _ _ _ H0).
+unfold minus_fct in |- *.
+cut
+ (forall h:R,
+ (f1 (x + h) - f1 x) / h - (f2 (x + h) - f2 x) / h =
+ (f1 (x + h) - f2 (x + h) - (f1 x - f2 x)) / h).
+intro.
+generalize
+ (limit_minus (fun h':R => (f1 (x + h') - f1 x) / h')
+ (fun h':R => (f2 (x + h') - f2 x) / h') (fun h:R => h <> 0) l1 l2 0 H1 H2).
+unfold limit1_in in |- *; unfold limit_in in |- *; unfold dist in |- *;
+ simpl in |- *; unfold R_dist in |- *; intros.
+elim (H4 eps H5); intros.
+exists x0.
+elim H6; intros.
+split.
+assumption.
+intros; rewrite <- H3; apply H8; assumption.
+intro; unfold Rdiv in |- *; ring.
+Qed.
+
+Lemma derivable_pt_lim_mult :
+ forall f1 f2 (x l1 l2:R),
+ derivable_pt_lim f1 x l1 ->
+ derivable_pt_lim f2 x l2 ->
+ derivable_pt_lim (f1 * f2) x (l1 * f2 x + f1 x * l2).
+intros.
+assert (H1 := derivable_pt_lim_D_in f1 (fun y:R => l1) x).
+elim H1; intros.
+assert (H4 := H3 H).
+assert (H5 := derivable_pt_lim_D_in f2 (fun y:R => l2) x).
+elim H5; intros.
+assert (H8 := H7 H0).
+clear H1 H2 H3 H5 H6 H7.
+assert
+ (H1 :=
+ derivable_pt_lim_D_in (f1 * f2)%F (fun y:R => l1 * f2 x + f1 x * l2) x).
+elim H1; intros.
+clear H1 H3.
+apply H2.
+unfold mult_fct in |- *.
+apply (Dmult no_cond (fun y:R => l1) (fun y:R => l2) f1 f2 x); assumption.
+Qed.
+
+Lemma derivable_pt_lim_const : forall a x:R, derivable_pt_lim (fct_cte a) x 0.
+intros; unfold fct_cte, derivable_pt_lim in |- *.
+intros; exists (mkposreal 1 Rlt_0_1); intros; unfold Rminus in |- *;
+ rewrite Rplus_opp_r; unfold Rdiv in |- *; rewrite Rmult_0_l;
+ rewrite Rplus_opp_r; rewrite Rabs_R0; assumption.
+Qed.
+
+Lemma derivable_pt_lim_scal :
+ forall f (a x l:R),
+ derivable_pt_lim f x l -> derivable_pt_lim (mult_real_fct a f) x (a * l).
+intros.
+assert (H0 := derivable_pt_lim_const a x).
+replace (mult_real_fct a f) with (fct_cte a * f)%F.
+replace (a * l) with (0 * f x + a * l); [ idtac | ring ].
+apply (derivable_pt_lim_mult (fct_cte a) f x 0 l); assumption.
+unfold mult_real_fct, mult_fct, fct_cte in |- *; reflexivity.
+Qed.
+
+Lemma derivable_pt_lim_id : forall x:R, derivable_pt_lim id x 1.
+intro; unfold derivable_pt_lim in |- *.
+intros eps Heps; exists (mkposreal eps Heps); intros h H1 H2;
+ unfold id in |- *; replace ((x + h - x) / h - 1) with 0.
+rewrite Rabs_R0; apply Rle_lt_trans with (Rabs h).
+apply Rabs_pos.
+assumption.
+unfold Rminus in |- *; rewrite Rplus_assoc; rewrite (Rplus_comm x);
+ rewrite Rplus_assoc.
+rewrite Rplus_opp_l; rewrite Rplus_0_r; unfold Rdiv in |- *;
+ rewrite <- Rinv_r_sym.
+symmetry in |- *; apply Rplus_opp_r.
+assumption.
+Qed.
+
+Lemma derivable_pt_lim_Rsqr : forall x:R, derivable_pt_lim Rsqr x (2 * x).
+intro; unfold derivable_pt_lim in |- *.
+unfold Rsqr in |- *; intros eps Heps; exists (mkposreal eps Heps);
+ intros h H1 H2; replace (((x + h) * (x + h) - x * x) / h - 2 * x) with h.
+assumption.
+replace ((x + h) * (x + h) - x * x) with (2 * x * h + h * h);
+ [ idtac | ring ].
+unfold Rdiv in |- *; rewrite Rmult_plus_distr_r.
+repeat rewrite Rmult_assoc.
+repeat rewrite <- Rinv_r_sym; [ idtac | assumption ].
+ring.
+Qed.
+
+Lemma derivable_pt_lim_comp :
+ forall f1 f2 (x l1 l2:R),
+ derivable_pt_lim f1 x l1 ->
+ derivable_pt_lim f2 (f1 x) l2 -> derivable_pt_lim (f2 o f1) x (l2 * l1).
+intros; assert (H1 := derivable_pt_lim_D_in f1 (fun y:R => l1) x).
+elim H1; intros.
+assert (H4 := H3 H).
+assert (H5 := derivable_pt_lim_D_in f2 (fun y:R => l2) (f1 x)).
+elim H5; intros.
+assert (H8 := H7 H0).
+clear H1 H2 H3 H5 H6 H7.
+assert (H1 := derivable_pt_lim_D_in (f2 o f1)%F (fun y:R => l2 * l1) x).
+elim H1; intros.
+clear H1 H3; apply H2.
+unfold comp in |- *;
+ cut
+ (D_in (fun x0:R => f2 (f1 x0)) (fun y:R => l2 * l1)
+ (Dgf no_cond no_cond f1) x ->
+ D_in (fun x0:R => f2 (f1 x0)) (fun y:R => l2 * l1) no_cond x).
+intro; apply H1.
+rewrite Rmult_comm;
+ apply (Dcomp no_cond no_cond (fun y:R => l1) (fun y:R => l2) f1 f2 x);
+ assumption.
+unfold Dgf, D_in, no_cond in |- *; unfold limit1_in in |- *;
+ unfold limit_in in |- *; unfold dist in |- *; simpl in |- *;
+ unfold R_dist in |- *; intros.
+elim (H1 eps H3); intros.
+exists x0; intros; split.
+elim H5; intros; assumption.
+intros; elim H5; intros; apply H9; split.
+unfold D_x in |- *; split.
+split; trivial.
+elim H6; intros; unfold D_x in H10; elim H10; intros; assumption.
+elim H6; intros; assumption.
+Qed.
+
+Lemma derivable_pt_plus :
+ forall f1 f2 (x:R),
+ derivable_pt f1 x -> derivable_pt f2 x -> derivable_pt (f1 + f2) x.
+unfold derivable_pt in |- *; intros.
+elim X; intros.
+elim X0; intros.
+apply existT with (x0 + x1).
+apply derivable_pt_lim_plus; assumption.
+Qed.
+
+Lemma derivable_pt_opp :
+ forall f (x:R), derivable_pt f x -> derivable_pt (- f) x.
+unfold derivable_pt in |- *; intros.
+elim X; intros.
+apply existT with (- x0).
+apply derivable_pt_lim_opp; assumption.
+Qed.
+
+Lemma derivable_pt_minus :
+ forall f1 f2 (x:R),
+ derivable_pt f1 x -> derivable_pt f2 x -> derivable_pt (f1 - f2) x.
+unfold derivable_pt in |- *; intros.
+elim X; intros.
+elim X0; intros.
+apply existT with (x0 - x1).
+apply derivable_pt_lim_minus; assumption.
+Qed.
+
+Lemma derivable_pt_mult :
+ forall f1 f2 (x:R),
+ derivable_pt f1 x -> derivable_pt f2 x -> derivable_pt (f1 * f2) x.
+unfold derivable_pt in |- *; intros.
+elim X; intros.
+elim X0; intros.
+apply existT with (x0 * f2 x + f1 x * x1).
+apply derivable_pt_lim_mult; assumption.
+Qed.
+
+Lemma derivable_pt_const : forall a x:R, derivable_pt (fct_cte a) x.
+intros; unfold derivable_pt in |- *.
+apply existT with 0.
+apply derivable_pt_lim_const.
+Qed.
+
+Lemma derivable_pt_scal :
+ forall f (a x:R), derivable_pt f x -> derivable_pt (mult_real_fct a f) x.
+unfold derivable_pt in |- *; intros.
+elim X; intros.
+apply existT with (a * x0).
+apply derivable_pt_lim_scal; assumption.
+Qed.
+
+Lemma derivable_pt_id : forall x:R, derivable_pt id x.
+unfold derivable_pt in |- *; intro.
+exists 1.
+apply derivable_pt_lim_id.
+Qed.
+
+Lemma derivable_pt_Rsqr : forall x:R, derivable_pt Rsqr x.
+unfold derivable_pt in |- *; intro; apply existT with (2 * x).
+apply derivable_pt_lim_Rsqr.
+Qed.
+
+Lemma derivable_pt_comp :
+ forall f1 f2 (x:R),
+ derivable_pt f1 x -> derivable_pt f2 (f1 x) -> derivable_pt (f2 o f1) x.
+unfold derivable_pt in |- *; intros.
+elim X; intros.
+elim X0; intros.
+apply existT with (x1 * x0).
+apply derivable_pt_lim_comp; assumption.
+Qed.
+
+Lemma derivable_plus :
+ forall f1 f2, derivable f1 -> derivable f2 -> derivable (f1 + f2).
+unfold derivable in |- *; intros.
+apply (derivable_pt_plus _ _ x (X _) (X0 _)).
+Qed.
+
+Lemma derivable_opp : forall f, derivable f -> derivable (- f).
+unfold derivable in |- *; intros.
+apply (derivable_pt_opp _ x (X _)).
+Qed.
+
+Lemma derivable_minus :
+ forall f1 f2, derivable f1 -> derivable f2 -> derivable (f1 - f2).
+unfold derivable in |- *; intros.
+apply (derivable_pt_minus _ _ x (X _) (X0 _)).
+Qed.
+
+Lemma derivable_mult :
+ forall f1 f2, derivable f1 -> derivable f2 -> derivable (f1 * f2).
+unfold derivable in |- *; intros.
+apply (derivable_pt_mult _ _ x (X _) (X0 _)).
+Qed.
+
+Lemma derivable_const : forall a:R, derivable (fct_cte a).
+unfold derivable in |- *; intros.
+apply derivable_pt_const.
+Qed.
+
+Lemma derivable_scal :
+ forall f (a:R), derivable f -> derivable (mult_real_fct a f).
+unfold derivable in |- *; intros.
+apply (derivable_pt_scal _ a x (X _)).
+Qed.
+
+Lemma derivable_id : derivable id.
+unfold derivable in |- *; intro; apply derivable_pt_id.
+Qed.
+
+Lemma derivable_Rsqr : derivable Rsqr.
+unfold derivable in |- *; intro; apply derivable_pt_Rsqr.
+Qed.
+
+Lemma derivable_comp :
+ forall f1 f2, derivable f1 -> derivable f2 -> derivable (f2 o f1).
+unfold derivable in |- *; intros.
+apply (derivable_pt_comp _ _ x (X _) (X0 _)).
+Qed.
+
+Lemma derive_pt_plus :
+ forall f1 f2 (x:R) (pr1:derivable_pt f1 x) (pr2:derivable_pt f2 x),
+ derive_pt (f1 + f2) x (derivable_pt_plus _ _ _ pr1 pr2) =
+ derive_pt f1 x pr1 + derive_pt f2 x pr2.
+intros.
+assert (H := derivable_derive f1 x pr1).
+assert (H0 := derivable_derive f2 x pr2).
+assert
+ (H1 := derivable_derive (f1 + f2)%F x (derivable_pt_plus _ _ _ pr1 pr2)).
+elim H; clear H; intros l1 H.
+elim H0; clear H0; intros l2 H0.
+elim H1; clear H1; intros l H1.
+rewrite H; rewrite H0; apply derive_pt_eq_0.
+assert (H3 := projT2 pr1).
+unfold derive_pt in H; rewrite H in H3.
+assert (H4 := projT2 pr2).
+unfold derive_pt in H0; rewrite H0 in H4.
+apply derivable_pt_lim_plus; assumption.
+Qed.
+
+Lemma derive_pt_opp :
+ forall f (x:R) (pr1:derivable_pt f x),
+ derive_pt (- f) x (derivable_pt_opp _ _ pr1) = - derive_pt f x pr1.
+intros.
+assert (H := derivable_derive f x pr1).
+assert (H0 := derivable_derive (- f)%F x (derivable_pt_opp _ _ pr1)).
+elim H; clear H; intros l1 H.
+elim H0; clear H0; intros l2 H0.
+rewrite H; apply derive_pt_eq_0.
+assert (H3 := projT2 pr1).
+unfold derive_pt in H; rewrite H in H3.
+apply derivable_pt_lim_opp; assumption.
+Qed.
+
+Lemma derive_pt_minus :
+ forall f1 f2 (x:R) (pr1:derivable_pt f1 x) (pr2:derivable_pt f2 x),
+ derive_pt (f1 - f2) x (derivable_pt_minus _ _ _ pr1 pr2) =
+ derive_pt f1 x pr1 - derive_pt f2 x pr2.
+intros.
+assert (H := derivable_derive f1 x pr1).
+assert (H0 := derivable_derive f2 x pr2).
+assert
+ (H1 := derivable_derive (f1 - f2)%F x (derivable_pt_minus _ _ _ pr1 pr2)).
+elim H; clear H; intros l1 H.
+elim H0; clear H0; intros l2 H0.
+elim H1; clear H1; intros l H1.
+rewrite H; rewrite H0; apply derive_pt_eq_0.
+assert (H3 := projT2 pr1).
+unfold derive_pt in H; rewrite H in H3.
+assert (H4 := projT2 pr2).
+unfold derive_pt in H0; rewrite H0 in H4.
+apply derivable_pt_lim_minus; assumption.
+Qed.
+
+Lemma derive_pt_mult :
+ forall f1 f2 (x:R) (pr1:derivable_pt f1 x) (pr2:derivable_pt f2 x),
+ derive_pt (f1 * f2) x (derivable_pt_mult _ _ _ pr1 pr2) =
+ derive_pt f1 x pr1 * f2 x + f1 x * derive_pt f2 x pr2.
+intros.
+assert (H := derivable_derive f1 x pr1).
+assert (H0 := derivable_derive f2 x pr2).
+assert
+ (H1 := derivable_derive (f1 * f2)%F x (derivable_pt_mult _ _ _ pr1 pr2)).
+elim H; clear H; intros l1 H.
+elim H0; clear H0; intros l2 H0.
+elim H1; clear H1; intros l H1.
+rewrite H; rewrite H0; apply derive_pt_eq_0.
+assert (H3 := projT2 pr1).
+unfold derive_pt in H; rewrite H in H3.
+assert (H4 := projT2 pr2).
+unfold derive_pt in H0; rewrite H0 in H4.
+apply derivable_pt_lim_mult; assumption.
+Qed.
+
+Lemma derive_pt_const :
+ forall a x:R, derive_pt (fct_cte a) x (derivable_pt_const a x) = 0.
+intros.
+apply derive_pt_eq_0.
+apply derivable_pt_lim_const.
+Qed.
+
+Lemma derive_pt_scal :
+ forall f (a x:R) (pr:derivable_pt f x),
+ derive_pt (mult_real_fct a f) x (derivable_pt_scal _ _ _ pr) =
+ a * derive_pt f x pr.
+intros.
+assert (H := derivable_derive f x pr).
+assert
+ (H0 := derivable_derive (mult_real_fct a f) x (derivable_pt_scal _ _ _ pr)).
+elim H; clear H; intros l1 H.
+elim H0; clear H0; intros l2 H0.
+rewrite H; apply derive_pt_eq_0.
+assert (H3 := projT2 pr).
+unfold derive_pt in H; rewrite H in H3.
+apply derivable_pt_lim_scal; assumption.
+Qed.
+
+Lemma derive_pt_id : forall x:R, derive_pt id x (derivable_pt_id _) = 1.
+intros.
+apply derive_pt_eq_0.
+apply derivable_pt_lim_id.
+Qed.
+
+Lemma derive_pt_Rsqr :
+ forall x:R, derive_pt Rsqr x (derivable_pt_Rsqr _) = 2 * x.
+intros.
+apply derive_pt_eq_0.
+apply derivable_pt_lim_Rsqr.
+Qed.
+
+Lemma derive_pt_comp :
+ forall f1 f2 (x:R) (pr1:derivable_pt f1 x) (pr2:derivable_pt f2 (f1 x)),
+ derive_pt (f2 o f1) x (derivable_pt_comp _ _ _ pr1 pr2) =
+ derive_pt f2 (f1 x) pr2 * derive_pt f1 x pr1.
+intros.
+assert (H := derivable_derive f1 x pr1).
+assert (H0 := derivable_derive f2 (f1 x) pr2).
+assert
+ (H1 := derivable_derive (f2 o f1)%F x (derivable_pt_comp _ _ _ pr1 pr2)).
+elim H; clear H; intros l1 H.
+elim H0; clear H0; intros l2 H0.
+elim H1; clear H1; intros l H1.
+rewrite H; rewrite H0; apply derive_pt_eq_0.
+assert (H3 := projT2 pr1).
+unfold derive_pt in H; rewrite H in H3.
+assert (H4 := projT2 pr2).
+unfold derive_pt in H0; rewrite H0 in H4.
+apply derivable_pt_lim_comp; assumption.
Qed.
(* Pow *)
-Definition pow_fct [n:nat] : R->R := [y:R](pow y n).
-
-Lemma derivable_pt_lim_pow_pos : (x:R;n:nat) (lt O n) -> (derivable_pt_lim [y:R](pow y n) x ``(INR n)*(pow x (pred n))``).
-Intros.
-Induction n.
-Elim (lt_n_n ? H).
-Cut n=O\/(lt O n).
-Intro; Elim H0; Intro.
-Rewrite H1; Simpl.
-Replace [y:R]``y*1`` with (mult_fct id (fct_cte R1)).
-Replace ``1*1`` with ``1*(fct_cte R1 x)+(id x)*0``.
-Apply derivable_pt_lim_mult.
-Apply derivable_pt_lim_id.
-Apply derivable_pt_lim_const.
-Unfold fct_cte id; Ring.
-Reflexivity.
-Replace [y:R](pow y (S n)) with [y:R]``y*(pow y n)``.
-Replace (pred (S n)) with n; [Idtac | Reflexivity].
-Replace [y:R]``y*(pow y n)`` with (mult_fct id [y:R](pow y n)).
-Pose f := [y:R](pow y n).
-Replace ``(INR (S n))*(pow x n)`` with (Rplus (Rmult R1 (f x)) (Rmult (id x) (Rmult (INR n) (pow x (pred n))))).
-Apply derivable_pt_lim_mult.
-Apply derivable_pt_lim_id.
-Unfold f; Apply Hrecn; Assumption.
-Unfold f.
-Pattern 1 5 n; Replace n with (S (pred n)).
-Unfold id; Rewrite S_INR; Simpl.
-Ring.
-Symmetry; Apply S_pred with O; Assumption.
-Unfold mult_fct id; Reflexivity.
-Reflexivity.
-Inversion H.
-Left; Reflexivity.
-Right.
-Apply lt_le_trans with (1).
-Apply lt_O_Sn.
-Assumption.
-Qed.
-
-Lemma derivable_pt_lim_pow : (x:R; n:nat) (derivable_pt_lim [y:R](pow y n) x ``(INR n)*(pow x (pred n))``).
-Intros.
-Induction n.
-Simpl.
-Rewrite Rmult_Ol.
-Replace [_:R]``1`` with (fct_cte R1); [Apply derivable_pt_lim_const | Reflexivity].
-Apply derivable_pt_lim_pow_pos.
-Apply lt_O_Sn.
-Qed.
-
-Lemma derivable_pt_pow : (n:nat;x:R) (derivable_pt [y:R](pow y n) x).
-Intros; Unfold derivable_pt.
-Apply Specif.existT with ``(INR n)*(pow x (pred n))``.
-Apply derivable_pt_lim_pow.
-Qed.
-
-Lemma derivable_pow : (n:nat) (derivable [y:R](pow y n)).
-Intro; Unfold derivable; Intro; Apply derivable_pt_pow.
-Qed.
-
-Lemma derive_pt_pow : (n:nat;x:R) (derive_pt [y:R](pow y n) x (derivable_pt_pow n x))==``(INR n)*(pow x (pred n))``.
-Intros; Apply derive_pt_eq_0.
-Apply derivable_pt_lim_pow.
-Qed.
-
-Lemma pr_nu : (f:R->R;x:R;pr1,pr2:(derivable_pt f x)) (derive_pt f x pr1)==(derive_pt f x pr2).
-Intros.
-Unfold derivable_pt in pr1.
-Unfold derivable_pt in pr2.
-Elim pr1; Intros.
-Elim pr2; Intros.
-Unfold derivable_pt_abs in p.
-Unfold derivable_pt_abs in p0.
-Simpl.
-Apply (unicite_limite f x x0 x1 p p0).
+Definition pow_fct (n:nat) (y:R) : R := y ^ n.
+
+Lemma derivable_pt_lim_pow_pos :
+ forall (x:R) (n:nat),
+ (0 < n)%nat -> derivable_pt_lim (fun y:R => y ^ n) x (INR n * x ^ pred n).
+intros.
+induction n as [| n Hrecn].
+elim (lt_irrefl _ H).
+cut (n = 0%nat \/ (0 < n)%nat).
+intro; elim H0; intro.
+rewrite H1; simpl in |- *.
+replace (fun y:R => y * 1) with (id * fct_cte 1)%F.
+replace (1 * 1) with (1 * fct_cte 1 x + id x * 0).
+apply derivable_pt_lim_mult.
+apply derivable_pt_lim_id.
+apply derivable_pt_lim_const.
+unfold fct_cte, id in |- *; ring.
+reflexivity.
+replace (fun y:R => y ^ S n) with (fun y:R => y * y ^ n).
+replace (pred (S n)) with n; [ idtac | reflexivity ].
+replace (fun y:R => y * y ^ n) with (id * (fun y:R => y ^ n))%F.
+pose (f := fun y:R => y ^ n).
+replace (INR (S n) * x ^ n) with (1 * f x + id x * (INR n * x ^ pred n)).
+apply derivable_pt_lim_mult.
+apply derivable_pt_lim_id.
+unfold f in |- *; apply Hrecn; assumption.
+unfold f in |- *.
+pattern n at 1 5 in |- *; replace n with (S (pred n)).
+unfold id in |- *; rewrite S_INR; simpl in |- *.
+ring.
+symmetry in |- *; apply S_pred with 0%nat; assumption.
+unfold mult_fct, id in |- *; reflexivity.
+reflexivity.
+inversion H.
+left; reflexivity.
+right.
+apply lt_le_trans with 1%nat.
+apply lt_O_Sn.
+assumption.
+Qed.
+
+Lemma derivable_pt_lim_pow :
+ forall (x:R) (n:nat),
+ derivable_pt_lim (fun y:R => y ^ n) x (INR n * x ^ pred n).
+intros.
+induction n as [| n Hrecn].
+simpl in |- *.
+rewrite Rmult_0_l.
+replace (fun _:R => 1) with (fct_cte 1);
+ [ apply derivable_pt_lim_const | reflexivity ].
+apply derivable_pt_lim_pow_pos.
+apply lt_O_Sn.
+Qed.
+
+Lemma derivable_pt_pow :
+ forall (n:nat) (x:R), derivable_pt (fun y:R => y ^ n) x.
+intros; unfold derivable_pt in |- *.
+apply existT with (INR n * x ^ pred n).
+apply derivable_pt_lim_pow.
+Qed.
+
+Lemma derivable_pow : forall n:nat, derivable (fun y:R => y ^ n).
+intro; unfold derivable in |- *; intro; apply derivable_pt_pow.
+Qed.
+
+Lemma derive_pt_pow :
+ forall (n:nat) (x:R),
+ derive_pt (fun y:R => y ^ n) x (derivable_pt_pow n x) = INR n * x ^ pred n.
+intros; apply derive_pt_eq_0.
+apply derivable_pt_lim_pow.
+Qed.
+
+Lemma pr_nu :
+ forall f (x:R) (pr1 pr2:derivable_pt f x),
+ derive_pt f x pr1 = derive_pt f x pr2.
+intros.
+unfold derivable_pt in pr1.
+unfold derivable_pt in pr2.
+elim pr1; intros.
+elim pr2; intros.
+unfold derivable_pt_abs in p.
+unfold derivable_pt_abs in p0.
+simpl in |- *.
+apply (uniqueness_limite f x x0 x1 p p0).
Qed.
@@ -787,260 +1001,479 @@ Qed.
(** Local extremum's condition *)
(************************************************************)
-Theorem deriv_maximum : (f:R->R;a,b,c:R;pr:(derivable_pt f c)) ``a<c``->``c<b``->((x:R) ``a<x``->``x<b``->``(f x)<=(f c)``)->``(derive_pt f c pr)==0``.
-Intros; Case (total_order R0 (derive_pt f c pr)); Intro.
-Assert H3 := (derivable_derive f c pr).
-Elim H3; Intros l H4; Rewrite H4 in H2.
-Assert H5 := (derive_pt_eq_1 f c l pr H4).
-Cut ``0<l/2``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]].
-Elim (H5 ``l/2`` H6); Intros delta H7.
-Cut ``0<(b-c)/2``.
-Intro; Cut ``(Rmin delta/2 ((b-c)/2))<>0``.
-Intro; Cut ``(Rabsolu (Rmin delta/2 ((b-c)/2)))<delta``.
-Intro.
-Assert H11 := (H7 ``(Rmin delta/2 ((b-c)/2))`` H9 H10).
-Cut ``0<(Rmin (delta/2) ((b-c)/2))``.
-Intro; Cut ``a<c+(Rmin (delta/2) ((b-c)/2))``.
-Intro; Cut ``c+(Rmin (delta/2) ((b-c)/2))<b``.
-Intro; Assert H15 := (H1 ``c+(Rmin (delta/2) ((b-c)/2))`` H13 H14).
-Cut ``((f (c+(Rmin (delta/2) ((b-c)/2))))-(f c))/(Rmin (delta/2) ((b-c)/2))<=0``.
-Intro; Cut ``-l<0``.
-Intro; Unfold Rminus in H11.
-Cut ``((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2))+ -l<0``.
-Intro; Cut ``(Rabsolu (((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2))+ -l)) < l/2``.
-Unfold Rabsolu; Case (case_Rabsolu ``((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2))+ -l``); Intro.
-Replace `` -(((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2))+ -l)`` with ``l+ -(((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2)))``.
-Intro; Generalize (Rlt_compatibility ``-l`` ``l+ -(((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2)))`` ``l/2`` H19); Repeat Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Replace ``-l+l/2`` with ``-(l/2)``.
-Intro; Generalize (Rlt_Ropp ``-(((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2)))`` ``-(l/2)`` H20); Repeat Rewrite Ropp_Ropp; Intro; Generalize (Rlt_trans ``0`` ``l/2`` ``((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2))`` H6 H21); Intro; Elim (Rlt_antirefl ``0`` (Rlt_le_trans ``0`` ``((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2))`` ``0`` H22 H16)).
-Pattern 2 l; Rewrite double_var.
-Ring.
-Ring.
-Intro.
-Assert H20 := (Rle_sym2 ``0`` ``((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2))+ -l`` r).
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H20 H18)).
-Assumption.
-Rewrite <- Ropp_O; Replace ``((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2))+ -l`` with ``-(l+ -(((f (c+(Rmin (delta/2) ((b+ -c)/2))))-(f c))/(Rmin (delta/2) ((b+ -c)/2))))``.
-Apply Rgt_Ropp; Change ``0<l+ -(((f (c+(Rmin (delta/2) ((b+ -c)/2))))-(f c))/(Rmin (delta/2) ((b+ -c)/2)))``; Apply gt0_plus_ge0_is_gt0; [Assumption | Rewrite <- Ropp_O; Apply Rge_Ropp; Apply Rle_sym1; Assumption].
-Ring.
-Rewrite <- Ropp_O; Apply Rlt_Ropp; Assumption.
-Replace ``((f (c+(Rmin (delta/2) ((b-c)/2))))-(f c))/(Rmin (delta/2) ((b-c)/2))`` with ``- (((f c)-(f (c+(Rmin (delta/2) ((b-c)/2)))))/(Rmin (delta/2) ((b-c)/2)))``.
-Rewrite <- Ropp_O; Apply Rge_Ropp; Apply Rle_sym1; Unfold Rdiv; Apply Rmult_le_pos; [Generalize (Rle_compatibility_r ``-(f (c+(Rmin (delta*/2) ((b-c)*/2))))`` ``(f (c+(Rmin (delta*/2) ((b-c)*/2))))`` (f c) H15); Rewrite Rplus_Ropp_r; Intro; Assumption | Left; Apply Rlt_Rinv; Assumption].
-Unfold Rdiv.
-Rewrite <- Ropp_mul1.
-Repeat Rewrite <- (Rmult_sym ``/(Rmin (delta*/2) ((b-c)*/2))``).
-Apply r_Rmult_mult with ``(Rmin (delta*/2) ((b-c)*/2))``.
-Repeat Rewrite <- Rmult_assoc.
-Rewrite <- Rinv_r_sym.
-Repeat Rewrite Rmult_1l.
-Ring.
-Red; Intro.
-Unfold Rdiv in H12; Rewrite H16 in H12; Elim (Rlt_antirefl ``0`` H12).
-Red; Intro.
-Unfold Rdiv in H12; Rewrite H16 in H12; Elim (Rlt_antirefl ``0`` H12).
-Assert H14 := (Rmin_r ``(delta/2)`` ``((b-c)/2)``).
-Assert H15 := (Rle_compatibility ``c`` ``(Rmin (delta/2) ((b-c)/2))`` ``(b-c)/2`` H14).
-Apply Rle_lt_trans with ``c+(b-c)/2``.
-Assumption.
-Apply Rlt_monotony_contra with ``2``.
-Sup0.
-Replace ``2*(c+(b-c)/2)`` with ``c+b``.
-Replace ``2*b`` with ``b+b``.
-Apply Rlt_compatibility_r; Assumption.
-Ring.
-Unfold Rdiv; Rewrite Rmult_Rplus_distr.
-Repeat Rewrite (Rmult_sym ``2``).
-Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Ring.
-DiscrR.
-Apply Rlt_trans with c.
-Assumption.
-Pattern 1 c; Rewrite <- (Rplus_Or c); Apply Rlt_compatibility; Assumption.
-Cut ``0<delta/2``.
-Intro; Apply (Rmin_stable_in_posreal (mkposreal ``delta/2`` H12) (mkposreal ``(b-c)/2`` H8)).
-Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos delta) | Apply Rlt_Rinv; Sup0].
-Unfold Rabsolu; Case (case_Rabsolu (Rmin ``delta/2`` ``(b-c)/2``)).
-Intro.
-Cut ``0<delta/2``.
-Intro.
-Generalize (Rmin_stable_in_posreal (mkposreal ``delta/2`` H10) (mkposreal ``(b-c)/2`` H8)); Simpl; Intro; Elim (Rlt_antirefl ``0`` (Rlt_trans ``0`` ``(Rmin (delta/2) ((b-c)/2))`` ``0`` H11 r)).
-Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos delta) | Apply Rlt_Rinv; Sup0].
-Intro; Apply Rle_lt_trans with ``delta/2``.
-Apply Rmin_l.
-Unfold Rdiv; Apply Rlt_monotony_contra with ``2``.
-Sup0.
-Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1l.
-Replace ``2*delta`` with ``delta+delta``.
-Pattern 2 delta; Rewrite <- (Rplus_Or delta); Apply Rlt_compatibility.
-Rewrite Rplus_Or; Apply (cond_pos delta).
-Symmetry; Apply double.
-DiscrR.
-Cut ``0<delta/2``.
-Intro; Generalize (Rmin_stable_in_posreal (mkposreal ``delta/2`` H9) (mkposreal ``(b-c)/2`` H8)); Simpl; Intro; Red; Intro; Rewrite H11 in H10; Elim (Rlt_antirefl ``0`` H10).
-Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos delta) | Apply Rlt_Rinv; Sup0].
-Unfold Rdiv; Apply Rmult_lt_pos.
-Generalize (Rlt_compatibility_r ``-c`` c b H0); Rewrite Rplus_Ropp_r; Intro; Assumption.
-Apply Rlt_Rinv; Sup0.
-Elim H2; Intro.
-Symmetry; Assumption.
-Generalize (derivable_derive f c pr); Intro; Elim H4; Intros l H5.
-Rewrite H5 in H3; Generalize (derive_pt_eq_1 f c l pr H5); Intro; Cut ``0< -(l/2)``.
-Intro; Elim (H6 ``-(l/2)`` H7); Intros delta H9.
-Cut ``0<(c-a)/2``.
-Intro; Cut ``(Rmax (-(delta/2)) ((a-c)/2))<0``.
-Intro; Cut ``(Rmax (-(delta/2)) ((a-c)/2))<>0``.
-Intro; Cut ``(Rabsolu (Rmax (-(delta/2)) ((a-c)/2)))<delta``.
-Intro; Generalize (H9 ``(Rmax (-(delta/2)) ((a-c)/2))`` H11 H12); Intro; Cut ``a<c+(Rmax (-(delta/2)) ((a-c)/2))``.
-Cut ``c+(Rmax (-(delta/2)) ((a-c)/2))<b``.
-Intros; Generalize (H1 ``c+(Rmax (-(delta/2)) ((a-c)/2))`` H15 H14); Intro; Cut ``0<=((f (c+(Rmax (-(delta/2)) ((a-c)/2))))-(f c))/(Rmax (-(delta/2)) ((a-c)/2))``.
-Intro; Cut ``0< -l``.
-Intro; Unfold Rminus in H13; Cut ``0<((f (c+(Rmax (-(delta/2)) ((a+ -c)/2))))+ -(f c))/(Rmax (-(delta/2)) ((a+ -c)/2))+ -l``.
-Intro; Cut ``(Rabsolu (((f (c+(Rmax (-(delta/2)) ((a+ -c)/2))))+ -(f c))/(Rmax (-(delta/2)) ((a+ -c)/2))+ -l)) < -(l/2)``.
-Unfold Rabsolu; Case (case_Rabsolu ``((f (c+(Rmax (-(delta/2)) ((a+ -c)/2))))+ -(f c))/(Rmax (-(delta/2)) ((a+ -c)/2))+ -l``).
-Intro; Elim (Rlt_antirefl ``0`` (Rlt_trans ``0`` ``((f (c+(Rmax ( -(delta/2)) ((a+ -c)/2))))+ -(f c))/(Rmax ( -(delta/2)) ((a+ -c)/2))+ -l`` ``0`` H19 r)).
-Intros; Generalize (Rlt_compatibility_r ``l`` ``(((f (c+(Rmax (-(delta/2)) ((a+ -c)/2))))+ -(f c))/(Rmax (-(delta/2)) ((a+ -c)/2)))+ -l`` ``-(l/2)`` H20); Repeat Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Replace ``-(l/2)+l`` with ``l/2``.
-Cut ``l/2<0``.
-Intros; Generalize (Rlt_trans ``((f (c+(Rmax ( -(delta/2)) ((a+ -c)/2))))+ -(f c))/(Rmax ( -(delta/2)) ((a+ -c)/2))`` ``l/2`` ``0`` H22 H21); Intro; Elim (Rlt_antirefl ``0`` (Rle_lt_trans ``0`` ``((f (c+(Rmax ( -(delta/2)) ((a-c)/2))))-(f c))/(Rmax ( -(delta/2)) ((a-c)/2))`` ``0`` H17 H23)).
-Rewrite <- (Ropp_Ropp ``l/2``); Rewrite <- Ropp_O; Apply Rlt_Ropp; Assumption.
-Pattern 3 l; Rewrite double_var.
-Ring.
-Assumption.
-Apply ge0_plus_gt0_is_gt0; Assumption.
-Rewrite <- Ropp_O; Apply Rlt_Ropp; Assumption.
-Unfold Rdiv; Replace ``((f (c+(Rmax ( -(delta*/2)) ((a-c)*/2))))-(f c))*/(Rmax ( -(delta*/2)) ((a-c)*/2))`` with ``(-((f (c+(Rmax ( -(delta*/2)) ((a-c)*/2))))-(f c)))*/(-(Rmax ( -(delta*/2)) ((a-c)*/2)))``.
-Apply Rmult_le_pos.
-Generalize (Rle_compatibility ``-(f (c+(Rmax (-(delta*/2)) ((a-c)*/2))))`` ``(f (c+(Rmax (-(delta*/2)) ((a-c)*/2))))`` (f c) H16); Rewrite Rplus_Ropp_l; Replace ``-((f (c+(Rmax ( -(delta*/2)) ((a-c)*/2))))-(f c))`` with ``-((f (c+(Rmax ( -(delta*/2)) ((a-c)*/2)))))+(f c)``.
-Intro; Assumption.
-Ring.
-Left; Apply Rlt_Rinv; Rewrite <- Ropp_O; Apply Rlt_Ropp; Assumption.
-Unfold Rdiv.
-Rewrite <- Ropp_Rinv.
-Rewrite Ropp_mul2.
-Reflexivity.
-Unfold Rdiv in H11; Assumption.
-Generalize (Rlt_compatibility c ``(Rmax ( -(delta/2)) ((a-c)/2))`` ``0`` H10); Rewrite Rplus_Or; Intro; Apply Rlt_trans with ``c``; Assumption.
-Generalize (RmaxLess2 ``(-(delta/2))`` ``((a-c)/2)``); Intro; Generalize (Rle_compatibility c ``(a-c)/2`` ``(Rmax ( -(delta/2)) ((a-c)/2))`` H14); Intro; Apply Rlt_le_trans with ``c+(a-c)/2``.
-Apply Rlt_monotony_contra with ``2``.
-Sup0.
-Replace ``2*(c+(a-c)/2)`` with ``a+c``.
-Rewrite double.
-Apply Rlt_compatibility; Assumption.
-Ring.
-Rewrite <- Rplus_assoc.
-Rewrite <- double_var.
-Ring.
-Assumption.
-Unfold Rabsolu; Case (case_Rabsolu (Rmax ``-(delta/2)`` ``(a-c)/2``)).
-Intro; Generalize (RmaxLess1 ``-(delta/2)`` ``(a-c)/2``); Intro; Generalize (Rle_Ropp ``-(delta/2)`` ``(Rmax ( -(delta/2)) ((a-c)/2))`` H12); Rewrite Ropp_Ropp; Intro; Generalize (Rle_sym2 ``-(Rmax ( -(delta/2)) ((a-c)/2))`` ``delta/2`` H13); Intro; Apply Rle_lt_trans with ``delta/2``.
-Assumption.
-Apply Rlt_monotony_contra with ``2``.
-Sup0.
-Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1l; Rewrite double.
-Pattern 2 delta; Rewrite <- (Rplus_Or delta); Apply Rlt_compatibility; Rewrite Rplus_Or; Apply (cond_pos delta).
-DiscrR.
-Cut ``-(delta/2) < 0``.
-Cut ``(a-c)/2<0``.
-Intros; Generalize (Rmax_stable_in_negreal (mknegreal ``-(delta/2)`` H13) (mknegreal ``(a-c)/2`` H12)); Simpl; Intro; Generalize (Rle_sym2 ``0`` ``(Rmax ( -(delta/2)) ((a-c)/2))`` r); Intro; Elim (Rlt_antirefl ``0`` (Rle_lt_trans ``0`` ``(Rmax ( -(delta/2)) ((a-c)/2))`` ``0`` H15 H14)).
-Rewrite <- Ropp_O; Rewrite <- (Ropp_Ropp ``(a-c)/2``); Apply Rlt_Ropp; Replace ``-((a-c)/2)`` with ``(c-a)/2``.
-Assumption.
-Unfold Rdiv.
-Rewrite <- Ropp_mul1.
-Rewrite (Ropp_distr2 a c).
-Reflexivity.
-Rewrite <- Ropp_O; Apply Rlt_Ropp; Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos delta) | Assert Hyp : ``0<2``; [Sup0 | Apply (Rlt_Rinv ``2`` Hyp)]].
-Red; Intro; Rewrite H11 in H10; Elim (Rlt_antirefl ``0`` H10).
-Cut ``(a-c)/2<0``.
-Intro; Cut ``-(delta/2)<0``.
-Intro; Apply (Rmax_stable_in_negreal (mknegreal ``-(delta/2)`` H11) (mknegreal ``(a-c)/2`` H10)).
-Rewrite <- Ropp_O; Apply Rlt_Ropp; Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos delta) | Assert Hyp : ``0<2``; [Sup0 | Apply (Rlt_Rinv ``2`` Hyp)]].
-Rewrite <- Ropp_O; Rewrite <- (Ropp_Ropp ``(a-c)/2``); Apply Rlt_Ropp; Replace ``-((a-c)/2)`` with ``(c-a)/2``.
-Assumption.
-Unfold Rdiv.
-Rewrite <- Ropp_mul1.
-Rewrite (Ropp_distr2 a c).
-Reflexivity.
-Unfold Rdiv; Apply Rmult_lt_pos; [Generalize (Rlt_compatibility_r ``-a`` a c H); Rewrite Rplus_Ropp_r; Intro; Assumption | Assert Hyp : ``0<2``; [Sup0 | Apply (Rlt_Rinv ``2`` Hyp)]].
-Replace ``-(l/2)`` with ``(-l)/2``.
-Unfold Rdiv; Apply Rmult_lt_pos.
-Rewrite <- Ropp_O; Apply Rlt_Ropp; Assumption.
-Assert Hyp : ``0<2``; [Sup0 | Apply (Rlt_Rinv ``2`` Hyp)].
-Unfold Rdiv; Apply Ropp_mul1.
-Qed.
-
-Theorem deriv_minimum : (f:R->R;a,b,c:R;pr:(derivable_pt f c)) ``a<c``->``c<b``->((x:R) ``a<x``->``x<b``->``(f c)<=(f x)``)->``(derive_pt f c pr)==0``.
-Intros.
-Rewrite <- (Ropp_Ropp (derive_pt f c pr)).
-Apply eq_RoppO.
-Rewrite <- (derive_pt_opp f c pr).
-Cut (x:R)(``a<x``->``x<b``->``((opp_fct f) x)<=((opp_fct f) c)``).
-Intro.
-Apply (deriv_maximum (opp_fct f) a b c (derivable_pt_opp ? ? pr) H H0 H2).
-Intros; Unfold opp_fct; Apply Rge_Ropp; Apply Rle_sym1.
-Apply (H1 x H2 H3).
+Theorem deriv_maximum :
+ forall f (a b c:R) (pr:derivable_pt f c),
+ a < c ->
+ c < b ->
+ (forall x:R, a < x -> x < b -> f x <= f c) -> derive_pt f c pr = 0.
+intros; case (Rtotal_order 0 (derive_pt f c pr)); intro.
+assert (H3 := derivable_derive f c pr).
+elim H3; intros l H4; rewrite H4 in H2.
+assert (H5 := derive_pt_eq_1 f c l pr H4).
+cut (0 < l / 2);
+ [ intro
+ | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ].
+elim (H5 (l / 2) H6); intros delta H7.
+cut (0 < (b - c) / 2).
+intro; cut (Rmin (delta / 2) ((b - c) / 2) <> 0).
+intro; cut (Rabs (Rmin (delta / 2) ((b - c) / 2)) < delta).
+intro.
+assert (H11 := H7 (Rmin (delta / 2) ((b - c) / 2)) H9 H10).
+cut (0 < Rmin (delta / 2) ((b - c) / 2)).
+intro; cut (a < c + Rmin (delta / 2) ((b - c) / 2)).
+intro; cut (c + Rmin (delta / 2) ((b - c) / 2) < b).
+intro; assert (H15 := H1 (c + Rmin (delta / 2) ((b - c) / 2)) H13 H14).
+cut
+ ((f (c + Rmin (delta / 2) ((b - c) / 2)) - f c) /
+ Rmin (delta / 2) ((b - c) / 2) <= 0).
+intro; cut (- l < 0).
+intro; unfold Rminus in H11.
+cut
+ ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) /
+ Rmin (delta / 2) ((b + - c) / 2) + - l < 0).
+intro;
+ cut
+ (Rabs
+ ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) /
+ Rmin (delta / 2) ((b + - c) / 2) + - l) < l / 2).
+unfold Rabs in |- *;
+ case
+ (Rcase_abs
+ ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) /
+ Rmin (delta / 2) ((b + - c) / 2) + - l)); intro.
+replace
+ (-
+ ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) /
+ Rmin (delta / 2) ((b + - c) / 2) + - l)) with
+ (l +
+ -
+ ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) /
+ Rmin (delta / 2) ((b + - c) / 2))).
+intro;
+ generalize
+ (Rplus_lt_compat_l (- l)
+ (l +
+ -
+ ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) /
+ Rmin (delta / 2) ((b + - c) / 2))) (l / 2) H19);
+ repeat rewrite <- Rplus_assoc; rewrite Rplus_opp_l;
+ rewrite Rplus_0_l; replace (- l + l / 2) with (- (l / 2)).
+intro;
+ generalize
+ (Ropp_lt_gt_contravar
+ (-
+ ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) /
+ Rmin (delta / 2) ((b + - c) / 2))) (- (l / 2)) H20);
+ repeat rewrite Ropp_involutive; intro;
+ generalize
+ (Rlt_trans 0 (l / 2)
+ ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) /
+ Rmin (delta / 2) ((b + - c) / 2)) H6 H21); intro;
+ elim
+ (Rlt_irrefl 0
+ (Rlt_le_trans 0
+ ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) /
+ Rmin (delta / 2) ((b + - c) / 2)) 0 H22 H16)).
+pattern l at 2 in |- *; rewrite double_var.
+ring.
+ring.
+intro.
+assert
+ (H20 :=
+ Rge_le
+ ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) /
+ Rmin (delta / 2) ((b + - c) / 2) + - l) 0 r).
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H20 H18)).
+assumption.
+rewrite <- Ropp_0;
+ replace
+ ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) /
+ Rmin (delta / 2) ((b + - c) / 2) + - l) with
+ (-
+ (l +
+ -
+ ((f (c + Rmin (delta / 2) ((b + - c) / 2)) - f c) /
+ Rmin (delta / 2) ((b + - c) / 2)))).
+apply Ropp_gt_lt_contravar;
+ change
+ (0 <
+ l +
+ -
+ ((f (c + Rmin (delta / 2) ((b + - c) / 2)) - f c) /
+ Rmin (delta / 2) ((b + - c) / 2))) in |- *; apply Rplus_lt_le_0_compat;
+ [ assumption
+ | rewrite <- Ropp_0; apply Ropp_ge_le_contravar; apply Rle_ge; assumption ].
+ring.
+rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; assumption.
+replace
+ ((f (c + Rmin (delta / 2) ((b - c) / 2)) - f c) /
+ Rmin (delta / 2) ((b - c) / 2)) with
+ (-
+ ((f c - f (c + Rmin (delta / 2) ((b - c) / 2))) /
+ Rmin (delta / 2) ((b - c) / 2))).
+rewrite <- Ropp_0; apply Ropp_ge_le_contravar; apply Rle_ge;
+ unfold Rdiv in |- *; apply Rmult_le_pos;
+ [ generalize
+ (Rplus_le_compat_r (- f (c + Rmin (delta * / 2) ((b - c) * / 2)))
+ (f (c + Rmin (delta * / 2) ((b - c) * / 2))) (
+ f c) H15); rewrite Rplus_opp_r; intro; assumption
+ | left; apply Rinv_0_lt_compat; assumption ].
+unfold Rdiv in |- *.
+rewrite <- Ropp_mult_distr_l_reverse.
+repeat rewrite <- (Rmult_comm (/ Rmin (delta * / 2) ((b - c) * / 2))).
+apply Rmult_eq_reg_l with (Rmin (delta * / 2) ((b - c) * / 2)).
+repeat rewrite <- Rmult_assoc.
+rewrite <- Rinv_r_sym.
+repeat rewrite Rmult_1_l.
+ring.
+red in |- *; intro.
+unfold Rdiv in H12; rewrite H16 in H12; elim (Rlt_irrefl 0 H12).
+red in |- *; intro.
+unfold Rdiv in H12; rewrite H16 in H12; elim (Rlt_irrefl 0 H12).
+assert (H14 := Rmin_r (delta / 2) ((b - c) / 2)).
+assert
+ (H15 :=
+ Rplus_le_compat_l c (Rmin (delta / 2) ((b - c) / 2)) ((b - c) / 2) H14).
+apply Rle_lt_trans with (c + (b - c) / 2).
+assumption.
+apply Rmult_lt_reg_l with 2.
+prove_sup0.
+replace (2 * (c + (b - c) / 2)) with (c + b).
+replace (2 * b) with (b + b).
+apply Rplus_lt_compat_r; assumption.
+ring.
+unfold Rdiv in |- *; rewrite Rmult_plus_distr_l.
+repeat rewrite (Rmult_comm 2).
+rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r.
+ring.
+discrR.
+apply Rlt_trans with c.
+assumption.
+pattern c at 1 in |- *; rewrite <- (Rplus_0_r c); apply Rplus_lt_compat_l;
+ assumption.
+cut (0 < delta / 2).
+intro;
+ apply
+ (Rmin_stable_in_posreal (mkposreal (delta / 2) H12)
+ (mkposreal ((b - c) / 2) H8)).
+unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ].
+unfold Rabs in |- *; case (Rcase_abs (Rmin (delta / 2) ((b - c) / 2))).
+intro.
+cut (0 < delta / 2).
+intro.
+generalize
+ (Rmin_stable_in_posreal (mkposreal (delta / 2) H10)
+ (mkposreal ((b - c) / 2) H8)); simpl in |- *; intro;
+ elim (Rlt_irrefl 0 (Rlt_trans 0 (Rmin (delta / 2) ((b - c) / 2)) 0 H11 r)).
+unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ].
+intro; apply Rle_lt_trans with (delta / 2).
+apply Rmin_l.
+unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2.
+prove_sup0.
+rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym.
+rewrite Rmult_1_l.
+replace (2 * delta) with (delta + delta).
+pattern delta at 2 in |- *; rewrite <- (Rplus_0_r delta);
+ apply Rplus_lt_compat_l.
+rewrite Rplus_0_r; apply (cond_pos delta).
+symmetry in |- *; apply double.
+discrR.
+cut (0 < delta / 2).
+intro;
+ generalize
+ (Rmin_stable_in_posreal (mkposreal (delta / 2) H9)
+ (mkposreal ((b - c) / 2) H8)); simpl in |- *;
+ intro; red in |- *; intro; rewrite H11 in H10; elim (Rlt_irrefl 0 H10).
+unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ].
+unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+generalize (Rplus_lt_compat_r (- c) c b H0); rewrite Rplus_opp_r; intro;
+ assumption.
+apply Rinv_0_lt_compat; prove_sup0.
+elim H2; intro.
+symmetry in |- *; assumption.
+generalize (derivable_derive f c pr); intro; elim H4; intros l H5.
+rewrite H5 in H3; generalize (derive_pt_eq_1 f c l pr H5); intro;
+ cut (0 < - (l / 2)).
+intro; elim (H6 (- (l / 2)) H7); intros delta H9.
+cut (0 < (c - a) / 2).
+intro; cut (Rmax (- (delta / 2)) ((a - c) / 2) < 0).
+intro; cut (Rmax (- (delta / 2)) ((a - c) / 2) <> 0).
+intro; cut (Rabs (Rmax (- (delta / 2)) ((a - c) / 2)) < delta).
+intro; generalize (H9 (Rmax (- (delta / 2)) ((a - c) / 2)) H11 H12); intro;
+ cut (a < c + Rmax (- (delta / 2)) ((a - c) / 2)).
+cut (c + Rmax (- (delta / 2)) ((a - c) / 2) < b).
+intros; generalize (H1 (c + Rmax (- (delta / 2)) ((a - c) / 2)) H15 H14);
+ intro;
+ cut
+ (0 <=
+ (f (c + Rmax (- (delta / 2)) ((a - c) / 2)) - f c) /
+ Rmax (- (delta / 2)) ((a - c) / 2)).
+intro; cut (0 < - l).
+intro; unfold Rminus in H13;
+ cut
+ (0 <
+ (f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) /
+ Rmax (- (delta / 2)) ((a + - c) / 2) + - l).
+intro;
+ cut
+ (Rabs
+ ((f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) /
+ Rmax (- (delta / 2)) ((a + - c) / 2) + - l) <
+ - (l / 2)).
+unfold Rabs in |- *;
+ case
+ (Rcase_abs
+ ((f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) /
+ Rmax (- (delta / 2)) ((a + - c) / 2) + - l)).
+intro;
+ elim
+ (Rlt_irrefl 0
+ (Rlt_trans 0
+ ((f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) /
+ Rmax (- (delta / 2)) ((a + - c) / 2) + - l) 0 H19 r)).
+intros;
+ generalize
+ (Rplus_lt_compat_r l
+ ((f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) /
+ Rmax (- (delta / 2)) ((a + - c) / 2) + - l) (
+ - (l / 2)) H20); repeat rewrite Rplus_assoc; rewrite Rplus_opp_l;
+ rewrite Rplus_0_r; replace (- (l / 2) + l) with (l / 2).
+cut (l / 2 < 0).
+intros;
+ generalize
+ (Rlt_trans
+ ((f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) /
+ Rmax (- (delta / 2)) ((a + - c) / 2)) (l / 2) 0 H22 H21);
+ intro;
+ elim
+ (Rlt_irrefl 0
+ (Rle_lt_trans 0
+ ((f (c + Rmax (- (delta / 2)) ((a - c) / 2)) - f c) /
+ Rmax (- (delta / 2)) ((a - c) / 2)) 0 H17 H23)).
+rewrite <- (Ropp_involutive (l / 2)); rewrite <- Ropp_0;
+ apply Ropp_lt_gt_contravar; assumption.
+pattern l at 3 in |- *; rewrite double_var.
+ring.
+assumption.
+apply Rplus_le_lt_0_compat; assumption.
+rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; assumption.
+unfold Rdiv in |- *;
+ replace
+ ((f (c + Rmax (- (delta * / 2)) ((a - c) * / 2)) - f c) *
+ / Rmax (- (delta * / 2)) ((a - c) * / 2)) with
+ (- (f (c + Rmax (- (delta * / 2)) ((a - c) * / 2)) - f c) *
+ / - Rmax (- (delta * / 2)) ((a - c) * / 2)).
+apply Rmult_le_pos.
+generalize
+ (Rplus_le_compat_l (- f (c + Rmax (- (delta * / 2)) ((a - c) * / 2)))
+ (f (c + Rmax (- (delta * / 2)) ((a - c) * / 2))) (
+ f c) H16); rewrite Rplus_opp_l;
+ replace (- (f (c + Rmax (- (delta * / 2)) ((a - c) * / 2)) - f c)) with
+ (- f (c + Rmax (- (delta * / 2)) ((a - c) * / 2)) + f c).
+intro; assumption.
+ring.
+left; apply Rinv_0_lt_compat; rewrite <- Ropp_0; apply Ropp_lt_gt_contravar;
+ assumption.
+unfold Rdiv in |- *.
+rewrite <- Ropp_inv_permute.
+rewrite Rmult_opp_opp.
+reflexivity.
+unfold Rdiv in H11; assumption.
+generalize (Rplus_lt_compat_l c (Rmax (- (delta / 2)) ((a - c) / 2)) 0 H10);
+ rewrite Rplus_0_r; intro; apply Rlt_trans with c;
+ assumption.
+generalize (RmaxLess2 (- (delta / 2)) ((a - c) / 2)); intro;
+ generalize
+ (Rplus_le_compat_l c ((a - c) / 2) (Rmax (- (delta / 2)) ((a - c) / 2)) H14);
+ intro; apply Rlt_le_trans with (c + (a - c) / 2).
+apply Rmult_lt_reg_l with 2.
+prove_sup0.
+replace (2 * (c + (a - c) / 2)) with (a + c).
+rewrite double.
+apply Rplus_lt_compat_l; assumption.
+ring.
+rewrite <- Rplus_assoc.
+rewrite <- double_var.
+ring.
+assumption.
+unfold Rabs in |- *; case (Rcase_abs (Rmax (- (delta / 2)) ((a - c) / 2))).
+intro; generalize (RmaxLess1 (- (delta / 2)) ((a - c) / 2)); intro;
+ generalize
+ (Ropp_le_ge_contravar (- (delta / 2)) (Rmax (- (delta / 2)) ((a - c) / 2))
+ H12); rewrite Ropp_involutive; intro;
+ generalize (Rge_le (delta / 2) (- Rmax (- (delta / 2)) ((a - c) / 2)) H13);
+ intro; apply Rle_lt_trans with (delta / 2).
+assumption.
+apply Rmult_lt_reg_l with 2.
+prove_sup0.
+unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+ rewrite <- Rinv_r_sym.
+rewrite Rmult_1_l; rewrite double.
+pattern delta at 2 in |- *; rewrite <- (Rplus_0_r delta);
+ apply Rplus_lt_compat_l; rewrite Rplus_0_r; apply (cond_pos delta).
+discrR.
+cut (- (delta / 2) < 0).
+cut ((a - c) / 2 < 0).
+intros;
+ generalize
+ (Rmax_stable_in_negreal (mknegreal (- (delta / 2)) H13)
+ (mknegreal ((a - c) / 2) H12)); simpl in |- *;
+ intro; generalize (Rge_le (Rmax (- (delta / 2)) ((a - c) / 2)) 0 r);
+ intro;
+ elim
+ (Rlt_irrefl 0
+ (Rle_lt_trans 0 (Rmax (- (delta / 2)) ((a - c) / 2)) 0 H15 H14)).
+rewrite <- Ropp_0; rewrite <- (Ropp_involutive ((a - c) / 2));
+ apply Ropp_lt_gt_contravar; replace (- ((a - c) / 2)) with ((c - a) / 2).
+assumption.
+unfold Rdiv in |- *.
+rewrite <- Ropp_mult_distr_l_reverse.
+rewrite (Ropp_minus_distr a c).
+reflexivity.
+rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; unfold Rdiv in |- *;
+ apply Rmult_lt_0_compat;
+ [ apply (cond_pos delta)
+ | assert (Hyp : 0 < 2); [ prove_sup0 | apply (Rinv_0_lt_compat 2 Hyp) ] ].
+red in |- *; intro; rewrite H11 in H10; elim (Rlt_irrefl 0 H10).
+cut ((a - c) / 2 < 0).
+intro; cut (- (delta / 2) < 0).
+intro;
+ apply
+ (Rmax_stable_in_negreal (mknegreal (- (delta / 2)) H11)
+ (mknegreal ((a - c) / 2) H10)).
+rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; unfold Rdiv in |- *;
+ apply Rmult_lt_0_compat;
+ [ apply (cond_pos delta)
+ | assert (Hyp : 0 < 2); [ prove_sup0 | apply (Rinv_0_lt_compat 2 Hyp) ] ].
+rewrite <- Ropp_0; rewrite <- (Ropp_involutive ((a - c) / 2));
+ apply Ropp_lt_gt_contravar; replace (- ((a - c) / 2)) with ((c - a) / 2).
+assumption.
+unfold Rdiv in |- *.
+rewrite <- Ropp_mult_distr_l_reverse.
+rewrite (Ropp_minus_distr a c).
+reflexivity.
+unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ generalize (Rplus_lt_compat_r (- a) a c H); rewrite Rplus_opp_r; intro;
+ assumption
+ | assert (Hyp : 0 < 2); [ prove_sup0 | apply (Rinv_0_lt_compat 2 Hyp) ] ].
+replace (- (l / 2)) with (- l / 2).
+unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; assumption.
+assert (Hyp : 0 < 2); [ prove_sup0 | apply (Rinv_0_lt_compat 2 Hyp) ].
+unfold Rdiv in |- *; apply Ropp_mult_distr_l_reverse.
+Qed.
+
+Theorem deriv_minimum :
+ forall f (a b c:R) (pr:derivable_pt f c),
+ a < c ->
+ c < b ->
+ (forall x:R, a < x -> x < b -> f c <= f x) -> derive_pt f c pr = 0.
+intros.
+rewrite <- (Ropp_involutive (derive_pt f c pr)).
+apply Ropp_eq_0_compat.
+rewrite <- (derive_pt_opp f c pr).
+cut (forall x:R, a < x -> x < b -> (- f)%F x <= (- f)%F c).
+intro.
+apply (deriv_maximum (- f)%F a b c (derivable_pt_opp _ _ pr) H H0 H2).
+intros; unfold opp_fct in |- *; apply Ropp_ge_le_contravar; apply Rle_ge.
+apply (H1 x H2 H3).
Qed.
-Theorem deriv_constant2 : (f:R->R;a,b,c:R;pr:(derivable_pt f c)) ``a<c``->``c<b``->((x:R) ``a<x``->``x<b``->``(f x)==(f c)``)->``(derive_pt f c pr)==0``.
-Intros.
-EApply deriv_maximum with a b; Try Assumption.
-Intros; Right; Apply (H1 x H2 H3).
+Theorem deriv_constant2 :
+ forall f (a b c:R) (pr:derivable_pt f c),
+ a < c ->
+ c < b -> (forall x:R, a < x -> x < b -> f x = f c) -> derive_pt f c pr = 0.
+intros.
+eapply deriv_maximum with a b; try assumption.
+intros; right; apply (H1 x H2 H3).
Qed.
(**********)
-Lemma nonneg_derivative_0 : (f:R->R;pr:(derivable f)) (increasing f) -> ((x:R) ``0<=(derive_pt f x (pr x))``).
-Intros; Unfold increasing in H.
-Assert H0 := (derivable_derive f x (pr x)).
-Elim H0; Intros l H1.
-Rewrite H1; Case (total_order R0 l); Intro.
-Left; Assumption.
-Elim H2; Intro.
-Right; Assumption.
-Assert H4 := (derive_pt_eq_1 f x l (pr x) H1).
-Cut ``0< -(l/2)``.
-Intro; Elim (H4 ``-(l/2)`` H5); Intros delta H6.
-Cut ``delta/2<>0``/\``0<delta/2``/\``(Rabsolu delta/2)<delta``.
-Intro; Decompose [and] H7; Intros; Generalize (H6 ``delta/2`` H8 H11); Cut ``0<=((f (x+delta/2))-(f x))/(delta/2)``.
-Intro; Cut ``0<=((f (x+delta/2))-(f x))/(delta/2)-l``.
-Intro; Unfold Rabsolu; Case (case_Rabsolu ``((f (x+delta/2))-(f x))/(delta/2)-l``).
-Intro; Elim (Rlt_antirefl ``0`` (Rle_lt_trans ``0`` ``((f (x+delta/2))-(f x))/(delta/2)-l`` ``0`` H12 r)).
-Intros; Generalize (Rlt_compatibility_r l ``((f (x+delta/2))-(f x))/(delta/2)-l`` ``-(l/2)`` H13); Unfold Rminus; Replace ``-(l/2)+l`` with ``l/2``.
-Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Intro; Generalize (Rle_lt_trans ``0`` ``((f (x+delta/2))-(f x))/(delta/2)`` ``l/2`` H9 H14); Intro; Cut ``l/2<0``.
-Intro; Elim (Rlt_antirefl ``0`` (Rlt_trans ``0`` ``l/2`` ``0`` H15 H16)).
-Rewrite <- Ropp_O in H5; Generalize (Rlt_Ropp ``-0`` ``-(l/2)`` H5); Repeat Rewrite Ropp_Ropp; Intro; Assumption.
-Pattern 3 l ; Rewrite double_var.
-Ring.
-Unfold Rminus; Apply ge0_plus_ge0_is_ge0.
-Unfold Rdiv; Apply Rmult_le_pos.
-Cut ``x<=(x+(delta*/2))``.
-Intro; Generalize (H x ``x+(delta*/2)`` H12); Intro; Generalize (Rle_compatibility ``-(f x)`` ``(f x)`` ``(f (x+delta*/2))`` H13); Rewrite Rplus_Ropp_l; Rewrite Rplus_sym; Intro; Assumption.
-Pattern 1 x; Rewrite <- (Rplus_Or x); Apply Rle_compatibility; Left; Assumption.
-Left; Apply Rlt_Rinv; Assumption.
-Left; Rewrite <- Ropp_O; Apply Rlt_Ropp; Assumption.
-Unfold Rdiv; Apply Rmult_le_pos.
-Cut ``x<=(x+(delta*/2))``.
-Intro; Generalize (H x ``x+(delta*/2)`` H9); Intro; Generalize (Rle_compatibility ``-(f x)`` ``(f x)`` ``(f (x+delta*/2))`` H12); Rewrite Rplus_Ropp_l; Rewrite Rplus_sym; Intro; Assumption.
-Pattern 1 x; Rewrite <- (Rplus_Or x); Apply Rle_compatibility; Left; Assumption.
-Left; Apply Rlt_Rinv; Assumption.
-Split.
-Unfold Rdiv; Apply prod_neq_R0.
-Generalize (cond_pos delta); Intro; Red; Intro H9; Rewrite H9 in H7; Elim (Rlt_antirefl ``0`` H7).
-Apply Rinv_neq_R0; DiscrR.
-Split.
-Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos delta) | Apply Rlt_Rinv; Sup0].
-Replace ``(Rabsolu delta/2)`` with ``delta/2``.
-Unfold Rdiv; Apply Rlt_monotony_contra with ``2``.
-Sup0.
-Rewrite (Rmult_sym ``2``).
-Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Idtac | DiscrR].
-Rewrite Rmult_1r.
-Rewrite double.
-Pattern 1 (pos delta); Rewrite <- Rplus_Or.
-Apply Rlt_compatibility; Apply (cond_pos delta).
-Symmetry; Apply Rabsolu_right.
-Left; Change ``0<delta/2``; Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos delta) | Apply Rlt_Rinv; Sup0].
-Unfold Rdiv; Rewrite <- Ropp_mul1; Apply Rmult_lt_pos.
-Apply Rlt_anti_compatibility with l.
-Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or; Assumption.
-Apply Rlt_Rinv; Sup0.
-Qed.
+Lemma nonneg_derivative_0 :
+ forall f (pr:derivable f),
+ increasing f -> forall x:R, 0 <= derive_pt f x (pr x).
+intros; unfold increasing in H.
+assert (H0 := derivable_derive f x (pr x)).
+elim H0; intros l H1.
+rewrite H1; case (Rtotal_order 0 l); intro.
+left; assumption.
+elim H2; intro.
+right; assumption.
+assert (H4 := derive_pt_eq_1 f x l (pr x) H1).
+cut (0 < - (l / 2)).
+intro; elim (H4 (- (l / 2)) H5); intros delta H6.
+cut (delta / 2 <> 0 /\ 0 < delta / 2 /\ Rabs (delta / 2) < delta).
+intro; decompose [and] H7; intros; generalize (H6 (delta / 2) H8 H11);
+ cut (0 <= (f (x + delta / 2) - f x) / (delta / 2)).
+intro; cut (0 <= (f (x + delta / 2) - f x) / (delta / 2) - l).
+intro; unfold Rabs in |- *;
+ case (Rcase_abs ((f (x + delta / 2) - f x) / (delta / 2) - l)).
+intro;
+ elim
+ (Rlt_irrefl 0
+ (Rle_lt_trans 0 ((f (x + delta / 2) - f x) / (delta / 2) - l) 0 H12 r)).
+intros;
+ generalize
+ (Rplus_lt_compat_r l ((f (x + delta / 2) - f x) / (delta / 2) - l)
+ (- (l / 2)) H13); unfold Rminus in |- *;
+ replace (- (l / 2) + l) with (l / 2).
+rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; intro;
+ generalize
+ (Rle_lt_trans 0 ((f (x + delta / 2) - f x) / (delta / 2)) (l / 2) H9 H14);
+ intro; cut (l / 2 < 0).
+intro; elim (Rlt_irrefl 0 (Rlt_trans 0 (l / 2) 0 H15 H16)).
+rewrite <- Ropp_0 in H5;
+ generalize (Ropp_lt_gt_contravar (-0) (- (l / 2)) H5);
+ repeat rewrite Ropp_involutive; intro; assumption.
+pattern l at 3 in |- *; rewrite double_var.
+ring.
+unfold Rminus in |- *; apply Rplus_le_le_0_compat.
+unfold Rdiv in |- *; apply Rmult_le_pos.
+cut (x <= x + delta * / 2).
+intro; generalize (H x (x + delta * / 2) H12); intro;
+ generalize (Rplus_le_compat_l (- f x) (f x) (f (x + delta * / 2)) H13);
+ rewrite Rplus_opp_l; rewrite Rplus_comm; intro; assumption.
+pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l;
+ left; assumption.
+left; apply Rinv_0_lt_compat; assumption.
+left; rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; assumption.
+unfold Rdiv in |- *; apply Rmult_le_pos.
+cut (x <= x + delta * / 2).
+intro; generalize (H x (x + delta * / 2) H9); intro;
+ generalize (Rplus_le_compat_l (- f x) (f x) (f (x + delta * / 2)) H12);
+ rewrite Rplus_opp_l; rewrite Rplus_comm; intro; assumption.
+pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l;
+ left; assumption.
+left; apply Rinv_0_lt_compat; assumption.
+split.
+unfold Rdiv in |- *; apply prod_neq_R0.
+generalize (cond_pos delta); intro; red in |- *; intro H9; rewrite H9 in H7;
+ elim (Rlt_irrefl 0 H7).
+apply Rinv_neq_0_compat; discrR.
+split.
+unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ].
+replace (Rabs (delta / 2)) with (delta / 2).
+unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2.
+prove_sup0.
+rewrite (Rmult_comm 2).
+rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ].
+rewrite Rmult_1_r.
+rewrite double.
+pattern (pos delta) at 1 in |- *; rewrite <- Rplus_0_r.
+apply Rplus_lt_compat_l; apply (cond_pos delta).
+symmetry in |- *; apply Rabs_right.
+left; change (0 < delta / 2) in |- *; unfold Rdiv in |- *;
+ apply Rmult_lt_0_compat;
+ [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ].
+unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse;
+ apply Rmult_lt_0_compat.
+apply Rplus_lt_reg_r with l.
+unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rplus_0_r; assumption.
+apply Rinv_0_lt_compat; prove_sup0.
+Qed. \ No newline at end of file
diff --git a/theories/Reals/Ranalysis2.v b/theories/Reals/Ranalysis2.v
index 70f7adb1f..a02c5da6c 100644
--- a/theories/Reals/Ranalysis2.v
+++ b/theories/Reals/Ranalysis2.v
@@ -8,295 +8,443 @@
(*i $Id$ i*)
-Require Rbase.
-Require Rfunctions.
-Require Ranalysis1.
-V7only [Import R_scope.]. Open Local Scope R_scope.
+Require Import Rbase.
+Require Import Rfunctions.
+Require Import Ranalysis1. Open Local Scope R_scope.
(**********)
-Lemma formule : (x,h,l1,l2:R;f1,f2:R->R) ``h<>0`` -> ``(f2 x)<>0`` -> ``(f2 (x+h))<>0`` -> ``((f1 (x+h))/(f2 (x+h))-(f1 x)/(f2 x))/h-(l1*(f2 x)-l2*(f1 x))/(Rsqr (f2 x))`` == ``/(f2 (x+h))*(((f1 (x+h))-(f1 x))/h-l1) + l1/((f2 x)*(f2 (x+h)))*((f2 x)-(f2 (x+h))) - (f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))-(f2 x))/h-l2) + (l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))*((f2 (x+h))-(f2 x))``.
-Intros; Unfold Rdiv Rminus Rsqr.
-Repeat Rewrite Rmult_Rplus_distrl; Repeat Rewrite Rmult_Rplus_distr; Repeat Rewrite Rinv_Rmult; Try Assumption.
-Replace ``l1*(f2 x)*(/(f2 x)*/(f2 x))`` with ``l1*/(f2 x)*((f2 x)*/(f2 x))``; [Idtac | Ring].
-Replace ``l1*(/(f2 x)*/(f2 (x+h)))*(f2 x)`` with ``l1*/(f2 (x+h))*((f2 x)*/(f2 x))``; [Idtac | Ring].
-Replace ``l1*(/(f2 x)*/(f2 (x+h)))* -(f2 (x+h))`` with ``-(l1*/(f2 x)*((f2 (x+h))*/(f2 (x+h))))``; [Idtac | Ring].
-Replace ``(f1 x)*(/(f2 x)*/(f2 (x+h)))*((f2 (x+h))*/h)`` with ``(f1 x)*/(f2 x)*/h*((f2 (x+h))*/(f2 (x+h)))``; [Idtac | Ring].
-Replace ``(f1 x)*(/(f2 x)*/(f2 (x+h)))*( -(f2 x)*/h)`` with ``-((f1 x)*/(f2 (x+h))*/h*((f2 x)*/(f2 x)))``; [Idtac | Ring].
-Replace ``(l2*(f1 x)*(/(f2 x)*/(f2 x)*/(f2 (x+h)))*(f2 (x+h)))`` with ``l2*(f1 x)*/(f2 x)*/(f2 x)*((f2 (x+h))*/(f2 (x+h)))``; [Idtac | Ring].
-Replace ``l2*(f1 x)*(/(f2 x)*/(f2 x)*/(f2 (x+h)))* -(f2 x)`` with ``-(l2*(f1 x)*/(f2 x)*/(f2 (x+h))*((f2 x)*/(f2 x)))``; [Idtac | Ring].
-Repeat Rewrite <- Rinv_r_sym; Try Assumption Orelse Ring.
-Apply prod_neq_R0; Assumption.
+Lemma formule :
+ forall (x h l1 l2:R) (f1 f2:R -> R),
+ h <> 0 ->
+ f2 x <> 0 ->
+ f2 (x + h) <> 0 ->
+ (f1 (x + h) / f2 (x + h) - f1 x / f2 x) / h -
+ (l1 * f2 x - l2 * f1 x) / Rsqr (f2 x) =
+ / f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1) +
+ l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h)) -
+ f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2) +
+ l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x).
+intros; unfold Rdiv, Rminus, Rsqr in |- *.
+repeat rewrite Rmult_plus_distr_r; repeat rewrite Rmult_plus_distr_l;
+ repeat rewrite Rinv_mult_distr; try assumption.
+replace (l1 * f2 x * (/ f2 x * / f2 x)) with (l1 * / f2 x * (f2 x * / f2 x));
+ [ idtac | ring ].
+replace (l1 * (/ f2 x * / f2 (x + h)) * f2 x) with
+ (l1 * / f2 (x + h) * (f2 x * / f2 x)); [ idtac | ring ].
+replace (l1 * (/ f2 x * / f2 (x + h)) * - f2 (x + h)) with
+ (- (l1 * / f2 x * (f2 (x + h) * / f2 (x + h)))); [ idtac | ring ].
+replace (f1 x * (/ f2 x * / f2 (x + h)) * (f2 (x + h) * / h)) with
+ (f1 x * / f2 x * / h * (f2 (x + h) * / f2 (x + h)));
+ [ idtac | ring ].
+replace (f1 x * (/ f2 x * / f2 (x + h)) * (- f2 x * / h)) with
+ (- (f1 x * / f2 (x + h) * / h * (f2 x * / f2 x)));
+ [ idtac | ring ].
+replace (l2 * f1 x * (/ f2 x * / f2 x * / f2 (x + h)) * f2 (x + h)) with
+ (l2 * f1 x * / f2 x * / f2 x * (f2 (x + h) * / f2 (x + h)));
+ [ idtac | ring ].
+replace (l2 * f1 x * (/ f2 x * / f2 x * / f2 (x + h)) * - f2 x) with
+ (- (l2 * f1 x * / f2 x * / f2 (x + h) * (f2 x * / f2 x)));
+ [ idtac | ring ].
+repeat rewrite <- Rinv_r_sym; try assumption || ring.
+apply prod_neq_R0; assumption.
Qed.
-Lemma Rmin_pos : (x,y:R) ``0<x`` -> ``0<y`` -> ``0 < (Rmin x y)``.
-Intros; Unfold Rmin.
-Case (total_order_Rle x y); Intro; Assumption.
+Lemma Rmin_pos : forall x y:R, 0 < x -> 0 < y -> 0 < Rmin x y.
+intros; unfold Rmin in |- *.
+case (Rle_dec x y); intro; assumption.
Qed.
-Lemma maj_term1 : (x,h,eps,l1,alp_f2:R;eps_f2,alp_f1d:posreal;f1,f2:R->R) ``0 < eps`` -> ``(f2 x)<>0`` -> ``(f2 (x+h))<>0`` -> ((h:R)``h <> 0``->``(Rabsolu h) < alp_f1d``->``(Rabsolu (((f1 (x+h))-(f1 x))/h-l1)) < (Rabsolu ((eps*(f2 x))/8))``) -> ((a:R)``(Rabsolu a) < (Rmin eps_f2 alp_f2)``->``/(Rabsolu (f2 (x+a))) < 2/(Rabsolu (f2 x))``) -> ``h<>0`` -> ``(Rabsolu h)<alp_f1d`` -> ``(Rabsolu h) < (Rmin eps_f2 alp_f2)`` -> ``(Rabsolu (/(f2 (x+h))*(((f1 (x+h))-(f1 x))/h-l1))) < eps/4``.
-Intros.
-Assert H7 := (H3 h H6).
-Assert H8 := (H2 h H4 H5).
-Apply Rle_lt_trans with ``2/(Rabsolu (f2 x))*(Rabsolu (((f1 (x+h))-(f1 x))/h-l1))``.
-Rewrite Rabsolu_mult.
-Apply Rle_monotony_r.
-Apply Rabsolu_pos.
-Rewrite Rabsolu_Rinv; [Left; Exact H7 | Assumption].
-Apply Rlt_le_trans with ``2/(Rabsolu (f2 x))*(Rabsolu ((eps*(f2 x))/8))``.
-Apply Rlt_monotony.
-Unfold Rdiv; Apply Rmult_lt_pos; [Sup0 | Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption].
-Exact H8.
-Right; Unfold Rdiv.
-Repeat Rewrite Rabsolu_mult.
-Rewrite Rabsolu_Rinv; DiscrR.
-Replace ``(Rabsolu 8)`` with ``8``.
-Replace ``8`` with ``2*4``; [Idtac | Ring].
-Rewrite Rinv_Rmult; [Idtac | DiscrR | DiscrR].
-Replace ``2*/(Rabsolu (f2 x))*((Rabsolu eps)*(Rabsolu (f2 x))*(/2*/4))`` with ``(Rabsolu eps)*/4*(2*/2)*((Rabsolu (f2 x))*/(Rabsolu (f2 x)))``; [Idtac | Ring].
-Replace (Rabsolu eps) with eps.
-Repeat Rewrite <- Rinv_r_sym; Try DiscrR Orelse (Apply Rabsolu_no_R0; Assumption).
-Ring.
-Symmetry; Apply Rabsolu_right; Left; Assumption.
-Symmetry; Apply Rabsolu_right; Left; Sup.
+Lemma maj_term1 :
+ forall (x h eps l1 alp_f2:R) (eps_f2 alp_f1d:posreal)
+ (f1 f2:R -> R),
+ 0 < eps ->
+ f2 x <> 0 ->
+ f2 (x + h) <> 0 ->
+ (forall h:R,
+ h <> 0 ->
+ Rabs h < alp_f1d ->
+ Rabs ((f1 (x + h) - f1 x) / h - l1) < Rabs (eps * f2 x / 8)) ->
+ (forall a:R,
+ Rabs a < Rmin eps_f2 alp_f2 -> / Rabs (f2 (x + a)) < 2 / Rabs (f2 x)) ->
+ h <> 0 ->
+ Rabs h < alp_f1d ->
+ Rabs h < Rmin eps_f2 alp_f2 ->
+ Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) < eps / 4.
+intros.
+assert (H7 := H3 h H6).
+assert (H8 := H2 h H4 H5).
+apply Rle_lt_trans with
+ (2 / Rabs (f2 x) * Rabs ((f1 (x + h) - f1 x) / h - l1)).
+rewrite Rabs_mult.
+apply Rmult_le_compat_r.
+apply Rabs_pos.
+rewrite Rabs_Rinv; [ left; exact H7 | assumption ].
+apply Rlt_le_trans with (2 / Rabs (f2 x) * Rabs (eps * f2 x / 8)).
+apply Rmult_lt_compat_l.
+unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ prove_sup0 | apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption ].
+exact H8.
+right; unfold Rdiv in |- *.
+repeat rewrite Rabs_mult.
+rewrite Rabs_Rinv; discrR.
+replace (Rabs 8) with 8.
+replace 8 with 8; [ idtac | ring ].
+rewrite Rinv_mult_distr; [ idtac | discrR | discrR ].
+replace (2 * / Rabs (f2 x) * (Rabs eps * Rabs (f2 x) * (/ 2 * / 4))) with
+ (Rabs eps * / 4 * (2 * / 2) * (Rabs (f2 x) * / Rabs (f2 x)));
+ [ idtac | ring ].
+replace (Rabs eps) with eps.
+repeat rewrite <- Rinv_r_sym; try discrR || (apply Rabs_no_R0; assumption).
+ring.
+symmetry in |- *; apply Rabs_right; left; assumption.
+symmetry in |- *; apply Rabs_right; left; prove_sup.
Qed.
-Lemma maj_term2 : (x,h,eps,l1,alp_f2,alp_f2t2:R;eps_f2:posreal;f2:R->R) ``0 < eps`` -> ``(f2 x)<>0`` -> ``(f2 (x+h))<>0`` -> ((a:R)``(Rabsolu a) < alp_f2t2``->``(Rabsolu ((f2 (x+a))-(f2 x))) < (Rabsolu ((eps*(Rsqr (f2 x)))/(8*l1)))``)-> ((a:R)``(Rabsolu a) < (Rmin eps_f2 alp_f2)``->``/(Rabsolu (f2 (x+a))) < 2/(Rabsolu (f2 x))``) -> ``h<>0`` -> ``(Rabsolu h)<alp_f2t2`` -> ``(Rabsolu h) < (Rmin eps_f2 alp_f2)`` -> ``l1<>0`` -> ``(Rabsolu (l1/((f2 x)*(f2 (x+h)))*((f2 x)-(f2 (x+h))))) < eps/4``.
-Intros.
-Assert H8 := (H3 h H6).
-Assert H9 := (H2 h H5).
-Apply Rle_lt_trans with ``(Rabsolu (l1/((f2 x)*(f2 (x+h)))))*(Rabsolu ((eps*(Rsqr (f2 x)))/(8*l1)))``.
-Rewrite Rabsolu_mult; Apply Rle_monotony.
-Apply Rabsolu_pos.
-Rewrite <- (Rabsolu_Ropp ``(f2 x)-(f2 (x+h))``); Rewrite Ropp_distr2.
-Left; Apply H9.
-Apply Rlt_le_trans with ``(Rabsolu (2*l1/((f2 x)*(f2 x))))*(Rabsolu ((eps*(Rsqr (f2 x)))/(8*l1)))``.
-Apply Rlt_monotony_r.
-Apply Rabsolu_pos_lt.
-Unfold Rdiv; Unfold Rsqr; Repeat Apply prod_neq_R0; Try Assumption Orelse DiscrR.
-Red; Intro H10; Rewrite H10 in H; Elim (Rlt_antirefl ? H).
-Apply Rinv_neq_R0; Apply prod_neq_R0; Try Assumption Orelse DiscrR.
-Unfold Rdiv.
-Repeat Rewrite Rinv_Rmult; Try Assumption.
-Repeat Rewrite Rabsolu_mult.
-Replace ``(Rabsolu 2)`` with ``2``.
-Rewrite (Rmult_sym ``2``).
-Replace ``(Rabsolu l1)*((Rabsolu (/(f2 x)))*(Rabsolu (/(f2 x))))*2`` with ``(Rabsolu l1)*((Rabsolu (/(f2 x)))*((Rabsolu (/(f2 x)))*2))``; [Idtac | Ring].
-Repeat Apply Rlt_monotony.
-Apply Rabsolu_pos_lt; Assumption.
-Apply Rabsolu_pos_lt; Apply Rinv_neq_R0; Assumption.
-Repeat Rewrite Rabsolu_Rinv; Try Assumption.
-Rewrite <- (Rmult_sym ``2``).
-Unfold Rdiv in H8; Exact H8.
-Symmetry; Apply Rabsolu_right; Left; Sup0.
-Right.
-Unfold Rsqr Rdiv.
-Do 1 Rewrite Rinv_Rmult; Try Assumption Orelse DiscrR.
-Do 1 Rewrite Rinv_Rmult; Try Assumption Orelse DiscrR.
-Repeat Rewrite Rabsolu_mult.
-Repeat Rewrite Rabsolu_Rinv; Try Assumption Orelse DiscrR.
-Replace (Rabsolu eps) with eps.
-Replace ``(Rabsolu (8))`` with ``8``.
-Replace ``(Rabsolu 2)`` with ``2``.
-Replace ``8`` with ``4*2``; [Idtac | Ring].
-Rewrite Rinv_Rmult; DiscrR.
-Replace ``2*((Rabsolu l1)*(/(Rabsolu (f2 x))*/(Rabsolu (f2 x))))*(eps*((Rabsolu (f2 x))*(Rabsolu (f2 x)))*(/4*/2*/(Rabsolu l1)))`` with ``eps*/4*((Rabsolu l1)*/(Rabsolu l1))*((Rabsolu (f2 x))*/(Rabsolu (f2 x)))*((Rabsolu (f2 x))*/(Rabsolu (f2 x)))*(2*/2)``; [Idtac | Ring].
-Repeat Rewrite <- Rinv_r_sym; Try (Apply Rabsolu_no_R0; Assumption) Orelse DiscrR.
-Ring.
-Symmetry; Apply Rabsolu_right; Left; Sup0.
-Symmetry; Apply Rabsolu_right; Left; Sup.
-Symmetry; Apply Rabsolu_right; Left; Assumption.
+Lemma maj_term2 :
+ forall (x h eps l1 alp_f2 alp_f2t2:R) (eps_f2:posreal)
+ (f2:R -> R),
+ 0 < eps ->
+ f2 x <> 0 ->
+ f2 (x + h) <> 0 ->
+ (forall a:R,
+ Rabs a < alp_f2t2 ->
+ Rabs (f2 (x + a) - f2 x) < Rabs (eps * Rsqr (f2 x) / (8 * l1))) ->
+ (forall a:R,
+ Rabs a < Rmin eps_f2 alp_f2 -> / Rabs (f2 (x + a)) < 2 / Rabs (f2 x)) ->
+ h <> 0 ->
+ Rabs h < alp_f2t2 ->
+ Rabs h < Rmin eps_f2 alp_f2 ->
+ l1 <> 0 -> Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) < eps / 4.
+intros.
+assert (H8 := H3 h H6).
+assert (H9 := H2 h H5).
+apply Rle_lt_trans with
+ (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (eps * Rsqr (f2 x) / (8 * l1))).
+rewrite Rabs_mult; apply Rmult_le_compat_l.
+apply Rabs_pos.
+rewrite <- (Rabs_Ropp (f2 x - f2 (x + h))); rewrite Ropp_minus_distr.
+left; apply H9.
+apply Rlt_le_trans with
+ (Rabs (2 * (l1 / (f2 x * f2 x))) * Rabs (eps * Rsqr (f2 x) / (8 * l1))).
+apply Rmult_lt_compat_r.
+apply Rabs_pos_lt.
+unfold Rdiv in |- *; unfold Rsqr in |- *; repeat apply prod_neq_R0;
+ try assumption || discrR.
+red in |- *; intro H10; rewrite H10 in H; elim (Rlt_irrefl _ H).
+apply Rinv_neq_0_compat; apply prod_neq_R0; try assumption || discrR.
+unfold Rdiv in |- *.
+repeat rewrite Rinv_mult_distr; try assumption.
+repeat rewrite Rabs_mult.
+replace (Rabs 2) with 2.
+rewrite (Rmult_comm 2).
+replace (Rabs l1 * (Rabs (/ f2 x) * Rabs (/ f2 x)) * 2) with
+ (Rabs l1 * (Rabs (/ f2 x) * (Rabs (/ f2 x) * 2)));
+ [ idtac | ring ].
+repeat apply Rmult_lt_compat_l.
+apply Rabs_pos_lt; assumption.
+apply Rabs_pos_lt; apply Rinv_neq_0_compat; assumption.
+repeat rewrite Rabs_Rinv; try assumption.
+rewrite <- (Rmult_comm 2).
+unfold Rdiv in H8; exact H8.
+symmetry in |- *; apply Rabs_right; left; prove_sup0.
+right.
+unfold Rsqr, Rdiv in |- *.
+do 1 rewrite Rinv_mult_distr; try assumption || discrR.
+do 1 rewrite Rinv_mult_distr; try assumption || discrR.
+repeat rewrite Rabs_mult.
+repeat rewrite Rabs_Rinv; try assumption || discrR.
+replace (Rabs eps) with eps.
+replace (Rabs 8) with 8.
+replace (Rabs 2) with 2.
+replace 8 with (4 * 2); [ idtac | ring ].
+rewrite Rinv_mult_distr; discrR.
+replace
+ (2 * (Rabs l1 * (/ Rabs (f2 x) * / Rabs (f2 x))) *
+ (eps * (Rabs (f2 x) * Rabs (f2 x)) * (/ 4 * / 2 * / Rabs l1))) with
+ (eps * / 4 * (Rabs l1 * / Rabs l1) * (Rabs (f2 x) * / Rabs (f2 x)) *
+ (Rabs (f2 x) * / Rabs (f2 x)) * (2 * / 2)); [ idtac | ring ].
+repeat rewrite <- Rinv_r_sym; try (apply Rabs_no_R0; assumption) || discrR.
+ring.
+symmetry in |- *; apply Rabs_right; left; prove_sup0.
+symmetry in |- *; apply Rabs_right; left; prove_sup.
+symmetry in |- *; apply Rabs_right; left; assumption.
Qed.
-Lemma maj_term3 : (x,h,eps,l2,alp_f2:R;eps_f2,alp_f2d:posreal;f1,f2:R->R) ``0 < eps`` -> ``(f2 x)<>0`` -> ``(f2 (x+h))<>0`` -> ((h:R)``h <> 0``->``(Rabsolu h) < alp_f2d``->``(Rabsolu (((f2 (x+h))-(f2 x))/h-l2)) < (Rabsolu (((Rsqr (f2 x))*eps)/(8*(f1 x))))``) -> ((a:R)``(Rabsolu a) < (Rmin eps_f2 alp_f2)``->``/(Rabsolu (f2 (x+a))) < 2/(Rabsolu (f2 x))``) -> ``h<>0`` -> ``(Rabsolu h)<alp_f2d`` -> ``(Rabsolu h) < (Rmin eps_f2 alp_f2)`` -> ``(f1 x)<>0`` -> ``(Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))-(f2 x))/h-l2))) < eps/4``.
-Intros.
-Assert H8 := (H2 h H4 H5).
-Assert H9 := (H3 h H6).
-Apply Rle_lt_trans with ``(Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))))*(Rabsolu (((Rsqr (f2 x))*eps)/(8*(f1 x))))``.
-Rewrite Rabsolu_mult.
-Apply Rle_monotony.
-Apply Rabsolu_pos.
-Left; Apply H8.
-Apply Rlt_le_trans with ``(Rabsolu (2*(f1 x)/((f2 x)*(f2 x))))*(Rabsolu (((Rsqr (f2 x))*eps)/(8*(f1 x))))``.
-Apply Rlt_monotony_r.
-Apply Rabsolu_pos_lt.
-Unfold Rdiv; Unfold Rsqr; Repeat Apply prod_neq_R0; Try Assumption.
-Red; Intro H10; Rewrite H10 in H; Elim (Rlt_antirefl ? H).
-Apply Rinv_neq_R0; Apply prod_neq_R0; DiscrR Orelse Assumption.
-Unfold Rdiv.
-Repeat Rewrite Rinv_Rmult; Try Assumption.
-Repeat Rewrite Rabsolu_mult.
-Replace ``(Rabsolu 2)`` with ``2``.
-Rewrite (Rmult_sym ``2``).
-Replace ``(Rabsolu (f1 x))*((Rabsolu (/(f2 x)))*(Rabsolu (/(f2 x))))*2`` with ``(Rabsolu (f1 x))*((Rabsolu (/(f2 x)))*((Rabsolu (/(f2 x)))*2))``; [Idtac | Ring].
-Repeat Apply Rlt_monotony.
-Apply Rabsolu_pos_lt; Assumption.
-Apply Rabsolu_pos_lt; Apply Rinv_neq_R0; Assumption.
-Repeat Rewrite Rabsolu_Rinv; Assumption Orelse Idtac.
-Rewrite <- (Rmult_sym ``2``).
-Unfold Rdiv in H9; Exact H9.
-Symmetry; Apply Rabsolu_right; Left; Sup0.
-Right.
-Unfold Rsqr Rdiv.
-Rewrite Rinv_Rmult; Try Assumption Orelse DiscrR.
-Rewrite Rinv_Rmult; Try Assumption Orelse DiscrR.
-Repeat Rewrite Rabsolu_mult.
-Repeat Rewrite Rabsolu_Rinv; Try Assumption Orelse DiscrR.
-Replace (Rabsolu eps) with eps.
-Replace ``(Rabsolu (8))`` with ``8``.
-Replace ``(Rabsolu 2)`` with ``2``.
-Replace ``8`` with ``4*2``; [Idtac | Ring].
-Rewrite Rinv_Rmult; DiscrR.
-Replace ``2*((Rabsolu (f1 x))*(/(Rabsolu (f2 x))*/(Rabsolu (f2 x))))*((Rabsolu (f2 x))*(Rabsolu (f2 x))*eps*(/4*/2*/(Rabsolu (f1 x))))`` with ``eps*/4*((Rabsolu (f2 x))*/(Rabsolu (f2 x)))*((Rabsolu (f2 x))*/(Rabsolu (f2 x)))*((Rabsolu (f1 x))*/(Rabsolu (f1 x)))*(2*/2)``; [Idtac | Ring].
-Repeat Rewrite <- Rinv_r_sym; Try DiscrR Orelse (Apply Rabsolu_no_R0; Assumption).
-Ring.
-Symmetry; Apply Rabsolu_right; Left; Sup0.
-Symmetry; Apply Rabsolu_right; Left; Sup.
-Symmetry; Apply Rabsolu_right; Left; Assumption.
+Lemma maj_term3 :
+ forall (x h eps l2 alp_f2:R) (eps_f2 alp_f2d:posreal)
+ (f1 f2:R -> R),
+ 0 < eps ->
+ f2 x <> 0 ->
+ f2 (x + h) <> 0 ->
+ (forall h:R,
+ h <> 0 ->
+ Rabs h < alp_f2d ->
+ Rabs ((f2 (x + h) - f2 x) / h - l2) <
+ Rabs (Rsqr (f2 x) * eps / (8 * f1 x))) ->
+ (forall a:R,
+ Rabs a < Rmin eps_f2 alp_f2 -> / Rabs (f2 (x + a)) < 2 / Rabs (f2 x)) ->
+ h <> 0 ->
+ Rabs h < alp_f2d ->
+ Rabs h < Rmin eps_f2 alp_f2 ->
+ f1 x <> 0 ->
+ Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) <
+ eps / 4.
+intros.
+assert (H8 := H2 h H4 H5).
+assert (H9 := H3 h H6).
+apply Rle_lt_trans with
+ (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs (Rsqr (f2 x) * eps / (8 * f1 x))).
+rewrite Rabs_mult.
+apply Rmult_le_compat_l.
+apply Rabs_pos.
+left; apply H8.
+apply Rlt_le_trans with
+ (Rabs (2 * (f1 x / (f2 x * f2 x))) * Rabs (Rsqr (f2 x) * eps / (8 * f1 x))).
+apply Rmult_lt_compat_r.
+apply Rabs_pos_lt.
+unfold Rdiv in |- *; unfold Rsqr in |- *; repeat apply prod_neq_R0;
+ try assumption.
+red in |- *; intro H10; rewrite H10 in H; elim (Rlt_irrefl _ H).
+apply Rinv_neq_0_compat; apply prod_neq_R0; discrR || assumption.
+unfold Rdiv in |- *.
+repeat rewrite Rinv_mult_distr; try assumption.
+repeat rewrite Rabs_mult.
+replace (Rabs 2) with 2.
+rewrite (Rmult_comm 2).
+replace (Rabs (f1 x) * (Rabs (/ f2 x) * Rabs (/ f2 x)) * 2) with
+ (Rabs (f1 x) * (Rabs (/ f2 x) * (Rabs (/ f2 x) * 2)));
+ [ idtac | ring ].
+repeat apply Rmult_lt_compat_l.
+apply Rabs_pos_lt; assumption.
+apply Rabs_pos_lt; apply Rinv_neq_0_compat; assumption.
+repeat rewrite Rabs_Rinv; assumption || idtac.
+rewrite <- (Rmult_comm 2).
+unfold Rdiv in H9; exact H9.
+symmetry in |- *; apply Rabs_right; left; prove_sup0.
+right.
+unfold Rsqr, Rdiv in |- *.
+rewrite Rinv_mult_distr; try assumption || discrR.
+rewrite Rinv_mult_distr; try assumption || discrR.
+repeat rewrite Rabs_mult.
+repeat rewrite Rabs_Rinv; try assumption || discrR.
+replace (Rabs eps) with eps.
+replace (Rabs 8) with 8.
+replace (Rabs 2) with 2.
+replace 8 with (4 * 2); [ idtac | ring ].
+rewrite Rinv_mult_distr; discrR.
+replace
+ (2 * (Rabs (f1 x) * (/ Rabs (f2 x) * / Rabs (f2 x))) *
+ (Rabs (f2 x) * Rabs (f2 x) * eps * (/ 4 * / 2 * / Rabs (f1 x)))) with
+ (eps * / 4 * (Rabs (f2 x) * / Rabs (f2 x)) * (Rabs (f2 x) * / Rabs (f2 x)) *
+ (Rabs (f1 x) * / Rabs (f1 x)) * (2 * / 2)); [ idtac | ring ].
+repeat rewrite <- Rinv_r_sym; try discrR || (apply Rabs_no_R0; assumption).
+ring.
+symmetry in |- *; apply Rabs_right; left; prove_sup0.
+symmetry in |- *; apply Rabs_right; left; prove_sup.
+symmetry in |- *; apply Rabs_right; left; assumption.
Qed.
-Lemma maj_term4 : (x,h,eps,l2,alp_f2,alp_f2c:R;eps_f2:posreal;f1,f2:R->R) ``0 < eps`` -> ``(f2 x)<>0`` -> ``(f2 (x+h))<>0`` -> ((a:R)``(Rabsolu a) < alp_f2c`` -> ``(Rabsolu ((f2 (x+a))-(f2 x))) < (Rabsolu (((Rsqr (f2 x))*(f2 x)*eps)/(8*(f1 x)*l2)))``) -> ((a:R)``(Rabsolu a) < (Rmin eps_f2 alp_f2)``->``/(Rabsolu (f2 (x+a))) < 2/(Rabsolu (f2 x))``) -> ``h<>0`` -> ``(Rabsolu h)<alp_f2c`` -> ``(Rabsolu h) < (Rmin eps_f2 alp_f2)`` -> ``(f1 x)<>0`` -> ``l2<>0`` -> ``(Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))*((f2 (x+h))-(f2 x)))) < eps/4``.
-Intros.
-Assert H9 := (H2 h H5).
-Assert H10 := (H3 h H6).
-Apply Rle_lt_trans with ``(Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))))*(Rabsolu (((Rsqr (f2 x))*(f2 x)*eps)/(8*(f1 x)*l2)))``.
-Rewrite Rabsolu_mult.
-Apply Rle_monotony.
-Apply Rabsolu_pos.
-Left; Apply H9.
-Apply Rlt_le_trans with ``(Rabsolu (2*l2*(f1 x)/((Rsqr (f2 x))*(f2 x))))*(Rabsolu (((Rsqr (f2 x))*(f2 x)*eps)/(8*(f1 x)*l2)))``.
-Apply Rlt_monotony_r.
-Apply Rabsolu_pos_lt.
-Unfold Rdiv; Unfold Rsqr; Repeat Apply prod_neq_R0; Assumption Orelse Idtac.
-Red; Intro H11; Rewrite H11 in H; Elim (Rlt_antirefl ? H).
-Apply Rinv_neq_R0; Apply prod_neq_R0.
-Apply prod_neq_R0.
-DiscrR.
-Assumption.
-Assumption.
-Unfold Rdiv.
-Repeat Rewrite Rinv_Rmult; Try Assumption Orelse (Unfold Rsqr; Apply prod_neq_R0; Assumption).
-Repeat Rewrite Rabsolu_mult.
-Replace ``(Rabsolu 2)`` with ``2``.
-Replace ``2*(Rabsolu l2)*((Rabsolu (f1 x))*((Rabsolu (/(Rsqr (f2 x))))*(Rabsolu (/(f2 x)))))`` with ``(Rabsolu l2)*((Rabsolu (f1 x))*((Rabsolu (/(Rsqr (f2 x))))*((Rabsolu (/(f2 x)))*2)))``; [Idtac | Ring].
-Replace ``(Rabsolu l2)*(Rabsolu (f1 x))*((Rabsolu (/(Rsqr (f2 x))))*(Rabsolu (/(f2 (x+h)))))`` with ``(Rabsolu l2)*((Rabsolu (f1 x))*(((Rabsolu (/(Rsqr (f2 x))))*(Rabsolu (/(f2 (x+h)))))))``; [Idtac | Ring].
-Repeat Apply Rlt_monotony.
-Apply Rabsolu_pos_lt; Assumption.
-Apply Rabsolu_pos_lt; Assumption.
-Apply Rabsolu_pos_lt; Apply Rinv_neq_R0; Unfold Rsqr; Apply prod_neq_R0; Assumption.
-Repeat Rewrite Rabsolu_Rinv; [Idtac | Assumption | Assumption].
-Rewrite <- (Rmult_sym ``2``).
-Unfold Rdiv in H10; Exact H10.
-Symmetry; Apply Rabsolu_right; Left; Sup0.
-Right; Unfold Rsqr Rdiv.
-Rewrite Rinv_Rmult; Try Assumption Orelse DiscrR.
-Rewrite Rinv_Rmult; Try Assumption Orelse DiscrR.
-Rewrite Rinv_Rmult; Try Assumption Orelse DiscrR.
-Rewrite Rinv_Rmult; Try Assumption Orelse DiscrR.
-Repeat Rewrite Rabsolu_mult.
-Repeat Rewrite Rabsolu_Rinv; Try Assumption Orelse DiscrR.
-Replace (Rabsolu eps) with eps.
-Replace ``(Rabsolu (8))`` with ``8``.
-Replace ``(Rabsolu 2)`` with ``2``.
-Replace ``8`` with ``4*2``; [Idtac | Ring].
-Rewrite Rinv_Rmult; DiscrR.
-Replace ``2*(Rabsolu l2)*((Rabsolu (f1 x))*(/(Rabsolu (f2 x))*/(Rabsolu (f2 x))*/(Rabsolu (f2 x))))*((Rabsolu (f2 x))*(Rabsolu (f2 x))*(Rabsolu (f2 x))*eps*(/4*/2*/(Rabsolu (f1 x))*/(Rabsolu l2)))`` with ``eps*/4*((Rabsolu l2)*/(Rabsolu l2))*((Rabsolu (f1 x))*/(Rabsolu (f1 x)))*((Rabsolu (f2 x))*/(Rabsolu (f2 x)))*((Rabsolu (f2 x))*/(Rabsolu (f2 x)))*((Rabsolu (f2 x))*/(Rabsolu (f2 x)))*(2*/2)``; [Idtac | Ring].
-Repeat Rewrite <- Rinv_r_sym; Try DiscrR Orelse (Apply Rabsolu_no_R0; Assumption).
-Ring.
-Symmetry; Apply Rabsolu_right; Left; Sup0.
-Symmetry; Apply Rabsolu_right; Left; Sup.
-Symmetry; Apply Rabsolu_right; Left; Assumption.
-Apply prod_neq_R0; Assumption Orelse DiscrR.
-Apply prod_neq_R0; Assumption.
+Lemma maj_term4 :
+ forall (x h eps l2 alp_f2 alp_f2c:R) (eps_f2:posreal)
+ (f1 f2:R -> R),
+ 0 < eps ->
+ f2 x <> 0 ->
+ f2 (x + h) <> 0 ->
+ (forall a:R,
+ Rabs a < alp_f2c ->
+ Rabs (f2 (x + a) - f2 x) <
+ Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))) ->
+ (forall a:R,
+ Rabs a < Rmin eps_f2 alp_f2 -> / Rabs (f2 (x + a)) < 2 / Rabs (f2 x)) ->
+ h <> 0 ->
+ Rabs h < alp_f2c ->
+ Rabs h < Rmin eps_f2 alp_f2 ->
+ f1 x <> 0 ->
+ l2 <> 0 ->
+ Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x)) <
+ eps / 4.
+intros.
+assert (H9 := H2 h H5).
+assert (H10 := H3 h H6).
+apply Rle_lt_trans with
+ (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) *
+ Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))).
+rewrite Rabs_mult.
+apply Rmult_le_compat_l.
+apply Rabs_pos.
+left; apply H9.
+apply Rlt_le_trans with
+ (Rabs (2 * l2 * (f1 x / (Rsqr (f2 x) * f2 x))) *
+ Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))).
+apply Rmult_lt_compat_r.
+apply Rabs_pos_lt.
+unfold Rdiv in |- *; unfold Rsqr in |- *; repeat apply prod_neq_R0;
+ assumption || idtac.
+red in |- *; intro H11; rewrite H11 in H; elim (Rlt_irrefl _ H).
+apply Rinv_neq_0_compat; apply prod_neq_R0.
+apply prod_neq_R0.
+discrR.
+assumption.
+assumption.
+unfold Rdiv in |- *.
+repeat rewrite Rinv_mult_distr;
+ try assumption || (unfold Rsqr in |- *; apply prod_neq_R0; assumption).
+repeat rewrite Rabs_mult.
+replace (Rabs 2) with 2.
+replace
+ (2 * Rabs l2 * (Rabs (f1 x) * (Rabs (/ Rsqr (f2 x)) * Rabs (/ f2 x)))) with
+ (Rabs l2 * (Rabs (f1 x) * (Rabs (/ Rsqr (f2 x)) * (Rabs (/ f2 x) * 2))));
+ [ idtac | ring ].
+replace
+ (Rabs l2 * Rabs (f1 x) * (Rabs (/ Rsqr (f2 x)) * Rabs (/ f2 (x + h)))) with
+ (Rabs l2 * (Rabs (f1 x) * (Rabs (/ Rsqr (f2 x)) * Rabs (/ f2 (x + h)))));
+ [ idtac | ring ].
+repeat apply Rmult_lt_compat_l.
+apply Rabs_pos_lt; assumption.
+apply Rabs_pos_lt; assumption.
+apply Rabs_pos_lt; apply Rinv_neq_0_compat; unfold Rsqr in |- *;
+ apply prod_neq_R0; assumption.
+repeat rewrite Rabs_Rinv; [ idtac | assumption | assumption ].
+rewrite <- (Rmult_comm 2).
+unfold Rdiv in H10; exact H10.
+symmetry in |- *; apply Rabs_right; left; prove_sup0.
+right; unfold Rsqr, Rdiv in |- *.
+rewrite Rinv_mult_distr; try assumption || discrR.
+rewrite Rinv_mult_distr; try assumption || discrR.
+rewrite Rinv_mult_distr; try assumption || discrR.
+rewrite Rinv_mult_distr; try assumption || discrR.
+repeat rewrite Rabs_mult.
+repeat rewrite Rabs_Rinv; try assumption || discrR.
+replace (Rabs eps) with eps.
+replace (Rabs 8) with 8.
+replace (Rabs 2) with 2.
+replace 8 with (4 * 2); [ idtac | ring ].
+rewrite Rinv_mult_distr; discrR.
+replace
+ (2 * Rabs l2 *
+ (Rabs (f1 x) * (/ Rabs (f2 x) * / Rabs (f2 x) * / Rabs (f2 x))) *
+ (Rabs (f2 x) * Rabs (f2 x) * Rabs (f2 x) * eps *
+ (/ 4 * / 2 * / Rabs (f1 x) * / Rabs l2))) with
+ (eps * / 4 * (Rabs l2 * / Rabs l2) * (Rabs (f1 x) * / Rabs (f1 x)) *
+ (Rabs (f2 x) * / Rabs (f2 x)) * (Rabs (f2 x) * / Rabs (f2 x)) *
+ (Rabs (f2 x) * / Rabs (f2 x)) * (2 * / 2)); [ idtac | ring ].
+repeat rewrite <- Rinv_r_sym; try discrR || (apply Rabs_no_R0; assumption).
+ring.
+symmetry in |- *; apply Rabs_right; left; prove_sup0.
+symmetry in |- *; apply Rabs_right; left; prove_sup.
+symmetry in |- *; apply Rabs_right; left; assumption.
+apply prod_neq_R0; assumption || discrR.
+apply prod_neq_R0; assumption.
Qed.
-Lemma D_x_no_cond : (x,a:R) ``a<>0`` -> (D_x no_cond x ``x+a``).
-Intros.
-Unfold D_x no_cond.
-Split.
-Trivial.
-Apply Rminus_not_eq.
-Unfold Rminus.
-Rewrite Ropp_distr1.
-Rewrite <- Rplus_assoc.
-Rewrite Rplus_Ropp_r.
-Rewrite Rplus_Ol.
-Apply Ropp_neq; Assumption.
+Lemma D_x_no_cond : forall x a:R, a <> 0 -> D_x no_cond x (x + a).
+intros.
+unfold D_x, no_cond in |- *.
+split.
+trivial.
+apply Rminus_not_eq.
+unfold Rminus in |- *.
+rewrite Ropp_plus_distr.
+rewrite <- Rplus_assoc.
+rewrite Rplus_opp_r.
+rewrite Rplus_0_l.
+apply Ropp_neq_0_compat; assumption.
Qed.
-Lemma Rabsolu_4 : (a,b,c,d:R) ``(Rabsolu (a+b+c+d)) <= (Rabsolu a) + (Rabsolu b) + (Rabsolu c) + (Rabsolu d)``.
-Intros.
-Apply Rle_trans with ``(Rabsolu (a+b)) + (Rabsolu (c+d))``.
-Replace ``a+b+c+d`` with ``(a+b)+(c+d)``; [Apply Rabsolu_triang | Ring].
-Apply Rle_trans with ``(Rabsolu a) + (Rabsolu b) + (Rabsolu (c+d))``.
-Apply Rle_compatibility_r.
-Apply Rabsolu_triang.
-Repeat Rewrite Rplus_assoc; Repeat Apply Rle_compatibility.
-Apply Rabsolu_triang.
+Lemma Rabs_4 :
+ forall a b c d:R, Rabs (a + b + c + d) <= Rabs a + Rabs b + Rabs c + Rabs d.
+intros.
+apply Rle_trans with (Rabs (a + b) + Rabs (c + d)).
+replace (a + b + c + d) with (a + b + (c + d)); [ apply Rabs_triang | ring ].
+apply Rle_trans with (Rabs a + Rabs b + Rabs (c + d)).
+apply Rplus_le_compat_r.
+apply Rabs_triang.
+repeat rewrite Rplus_assoc; repeat apply Rplus_le_compat_l.
+apply Rabs_triang.
Qed.
-Lemma Rlt_4 : (a,b,c,d,e,f,g,h:R) ``a < b`` -> ``c < d`` -> ``e < f `` -> ``g < h`` -> ``a+c+e+g < b+d+f+h``.
-Intros; Apply Rlt_trans with ``b+c+e+g``.
-Repeat Apply Rlt_compatibility_r; Assumption.
-Repeat Rewrite Rplus_assoc; Apply Rlt_compatibility.
-Apply Rlt_trans with ``d+e+g``.
-Rewrite Rplus_assoc; Apply Rlt_compatibility_r; Assumption.
-Rewrite Rplus_assoc; Apply Rlt_compatibility; Apply Rlt_trans with ``f+g``.
-Apply Rlt_compatibility_r; Assumption.
-Apply Rlt_compatibility; Assumption.
+Lemma Rlt_4 :
+ forall a b c d e f g h:R,
+ a < b -> c < d -> e < f -> g < h -> a + c + e + g < b + d + f + h.
+intros; apply Rlt_trans with (b + c + e + g).
+repeat apply Rplus_lt_compat_r; assumption.
+repeat rewrite Rplus_assoc; apply Rplus_lt_compat_l.
+apply Rlt_trans with (d + e + g).
+rewrite Rplus_assoc; apply Rplus_lt_compat_r; assumption.
+rewrite Rplus_assoc; apply Rplus_lt_compat_l; apply Rlt_trans with (f + g).
+apply Rplus_lt_compat_r; assumption.
+apply Rplus_lt_compat_l; assumption.
Qed.
-Lemma Rmin_2 : (a,b,c:R) ``a < b`` -> ``a < c`` -> ``a < (Rmin b c)``.
-Intros; Unfold Rmin; Case (total_order_Rle b c); Intro; Assumption.
+Lemma Rmin_2 : forall a b c:R, a < b -> a < c -> a < Rmin b c.
+intros; unfold Rmin in |- *; case (Rle_dec b c); intro; assumption.
Qed.
-Lemma quadruple : (x:R) ``4*x == x + x + x + x``.
-Intro; Ring.
+Lemma quadruple : forall x:R, 4 * x = x + x + x + x.
+intro; ring.
Qed.
-Lemma quadruple_var : (x:R) `` x == x/4 + x/4 + x/4 + x/4``.
-Intro; Rewrite <- quadruple.
-Unfold Rdiv; Rewrite <- Rmult_assoc; Rewrite Rinv_r_simpl_m; DiscrR.
-Reflexivity.
+Lemma quadruple_var : forall x:R, x = x / 4 + x / 4 + x / 4 + x / 4.
+intro; rewrite <- quadruple.
+unfold Rdiv in |- *; rewrite <- Rmult_assoc; rewrite Rinv_r_simpl_m; discrR.
+reflexivity.
Qed.
(**********)
-Lemma continuous_neq_0 : (f:R->R; x0:R) (continuity_pt f x0) -> ~``(f x0)==0`` -> (EXT eps : posreal | (h:R) ``(Rabsolu h) < eps`` -> ~``(f (x0+h))==0``).
-Intros; Unfold continuity_pt in H; Unfold continue_in in H; Unfold limit1_in in H; Unfold limit_in in H; Elim (H ``(Rabsolu ((f x0)/2))``).
-Intros; Elim H1; Intros.
-Exists (mkposreal x H2).
-Intros; Assert H5 := (H3 ``x0+h``).
-Cut ``(dist R_met (x0+h) x0) < x`` -> ``(dist R_met (f (x0+h)) (f x0)) < (Rabsolu ((f x0)/2))``.
-Unfold dist; Simpl; Unfold R_dist; Replace ``x0+h-x0`` with h.
-Intros; Assert H7 := (H6 H4).
-Red; Intro.
-Rewrite H8 in H7; Unfold Rminus in H7; Rewrite Rplus_Ol in H7; Rewrite Rabsolu_Ropp in H7; Unfold Rdiv in H7; Rewrite Rabsolu_mult in H7; Pattern 1 ``(Rabsolu (f x0)) `` in H7; Rewrite <- Rmult_1r in H7.
-Cut ``0<(Rabsolu (f x0))``.
-Intro; Assert H10 := (Rlt_monotony_contra ? ? ? H9 H7).
-Cut ``(Rabsolu (/2))==/2``.
-Assert Hyp:``0<2``.
-Sup0.
-Intro; Rewrite H11 in H10; Assert H12 := (Rlt_monotony ``2`` ? ? Hyp H10); Rewrite Rmult_1r in H12; Rewrite <- Rinv_r_sym in H12; [Idtac | DiscrR].
-Cut (Rlt (IZR `1`) (IZR `2`)).
-Unfold IZR; Unfold INR convert; Simpl; Intro; Elim (Rlt_antirefl ``1`` (Rlt_trans ? ? ? H13 H12)).
-Apply IZR_lt; Omega.
-Unfold Rabsolu; Case (case_Rabsolu ``/2``); Intro.
-Assert Hyp:``0<2``.
-Sup0.
-Assert H11 := (Rlt_monotony ``2`` ? ? Hyp r); Rewrite Rmult_Or in H11; Rewrite <- Rinv_r_sym in H11; [Idtac | DiscrR].
-Elim (Rlt_antirefl ``0`` (Rlt_trans ? ? ? Rlt_R0_R1 H11)).
-Reflexivity.
-Apply (Rabsolu_pos_lt ? H0).
-Ring.
-Assert H6 := (Req_EM ``x0`` ``x0+h``); Elim H6; Intro.
-Intro; Rewrite <- H7; Unfold dist R_met; Unfold R_dist; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply Rabsolu_pos_lt.
-Unfold Rdiv; Apply prod_neq_R0; [Assumption | Apply Rinv_neq_R0; DiscrR].
-Intro; Apply H5.
-Split.
-Unfold D_x no_cond.
-Split; Trivial Orelse Assumption.
-Assumption.
-Change ``0 < (Rabsolu ((f x0)/2))``.
-Apply Rabsolu_pos_lt; Unfold Rdiv; Apply prod_neq_R0.
-Assumption.
-Apply Rinv_neq_R0; DiscrR.
-Qed.
+Lemma continuous_neq_0 :
+ forall (f:R -> R) (x0:R),
+ continuity_pt f x0 ->
+ f x0 <> 0 ->
+ exists eps : posreal | (forall h:R, Rabs h < eps -> f (x0 + h) <> 0).
+intros; unfold continuity_pt in H; unfold continue_in in H;
+ unfold limit1_in in H; unfold limit_in in H; elim (H (Rabs (f x0 / 2))).
+intros; elim H1; intros.
+exists (mkposreal x H2).
+intros; assert (H5 := H3 (x0 + h)).
+cut
+ (dist R_met (x0 + h) x0 < x ->
+ dist R_met (f (x0 + h)) (f x0) < Rabs (f x0 / 2)).
+unfold dist in |- *; simpl in |- *; unfold R_dist in |- *;
+ replace (x0 + h - x0) with h.
+intros; assert (H7 := H6 H4).
+red in |- *; intro.
+rewrite H8 in H7; unfold Rminus in H7; rewrite Rplus_0_l in H7;
+ rewrite Rabs_Ropp in H7; unfold Rdiv in H7; rewrite Rabs_mult in H7;
+ pattern (Rabs (f x0)) at 1 in H7; rewrite <- Rmult_1_r in H7.
+cut (0 < Rabs (f x0)).
+intro; assert (H10 := Rmult_lt_reg_l _ _ _ H9 H7).
+cut (Rabs (/ 2) = / 2).
+assert (Hyp : 0 < 2).
+prove_sup0.
+intro; rewrite H11 in H10; assert (H12 := Rmult_lt_compat_l 2 _ _ Hyp H10);
+ rewrite Rmult_1_r in H12; rewrite <- Rinv_r_sym in H12;
+ [ idtac | discrR ].
+cut (IZR 1 < IZR 2).
+unfold IZR in |- *; unfold INR, nat_of_P in |- *; simpl in |- *; intro;
+ elim (Rlt_irrefl 1 (Rlt_trans _ _ _ H13 H12)).
+apply IZR_lt; omega.
+unfold Rabs in |- *; case (Rcase_abs (/ 2)); intro.
+assert (Hyp : 0 < 2).
+prove_sup0.
+assert (H11 := Rmult_lt_compat_l 2 _ _ Hyp r); rewrite Rmult_0_r in H11;
+ rewrite <- Rinv_r_sym in H11; [ idtac | discrR ].
+elim (Rlt_irrefl 0 (Rlt_trans _ _ _ Rlt_0_1 H11)).
+reflexivity.
+apply (Rabs_pos_lt _ H0).
+ring.
+assert (H6 := Req_dec x0 (x0 + h)); elim H6; intro.
+intro; rewrite <- H7; unfold dist, R_met in |- *; unfold R_dist in |- *;
+ unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+ apply Rabs_pos_lt.
+unfold Rdiv in |- *; apply prod_neq_R0;
+ [ assumption | apply Rinv_neq_0_compat; discrR ].
+intro; apply H5.
+split.
+unfold D_x, no_cond in |- *.
+split; trivial || assumption.
+assumption.
+change (0 < Rabs (f x0 / 2)) in |- *.
+apply Rabs_pos_lt; unfold Rdiv in |- *; apply prod_neq_R0.
+assumption.
+apply Rinv_neq_0_compat; discrR.
+Qed. \ No newline at end of file
diff --git a/theories/Reals/Ranalysis3.v b/theories/Reals/Ranalysis3.v
index e8af542ac..1e0991e15 100644
--- a/theories/Reals/Ranalysis3.v
+++ b/theories/Reals/Ranalysis3.v
@@ -8,610 +8,786 @@
(*i $Id$ i*)
-Require Rbase.
-Require Rfunctions.
-Require Ranalysis1.
-Require Ranalysis2.
-V7only [Import R_scope.]. Open Local Scope R_scope.
+Require Import Rbase.
+Require Import Rfunctions.
+Require Import Ranalysis1.
+Require Import Ranalysis2. Open Local Scope R_scope.
(* Division *)
-Theorem derivable_pt_lim_div : (f1,f2:R->R;x,l1,l2:R) (derivable_pt_lim f1 x l1) -> (derivable_pt_lim f2 x l2) -> ~``(f2 x)==0``-> (derivable_pt_lim (div_fct f1 f2) x ``(l1*(f2 x)-l2*(f1 x))/(Rsqr (f2 x))``).
-Intros.
-Cut (derivable_pt f2 x); [Intro | Unfold derivable_pt; Apply Specif.existT with l2; Exact H0].
-Assert H2 := ((continuous_neq_0 ? ? (derivable_continuous_pt ? ? X)) H1).
-Elim H2; Clear H2; Intros eps_f2 H2.
-Unfold div_fct.
-Assert H3 := (derivable_continuous_pt ? ? X).
-Unfold continuity_pt in H3; Unfold continue_in in H3; Unfold limit1_in in H3; Unfold limit_in in H3; Unfold dist in H3.
-Simpl in H3; Unfold R_dist in H3.
-Elim (H3 ``(Rabsolu (f2 x))/2``); [Idtac | Unfold Rdiv; Change ``0 < (Rabsolu (f2 x))*/2``; Apply Rmult_lt_pos; [Apply Rabsolu_pos_lt; Assumption | Apply Rlt_Rinv; Sup0]].
-Clear H3; Intros alp_f2 H3.
-Cut (x0:R) ``(Rabsolu (x0-x)) < alp_f2`` ->``(Rabsolu ((f2 x0)-(f2 x))) < (Rabsolu (f2 x))/2``.
-Intro H4.
-Cut (a:R) ``(Rabsolu (a-x)) < alp_f2``->``(Rabsolu (f2 x))/2 < (Rabsolu (f2 a))``.
-Intro H5.
-Cut (a:R) ``(Rabsolu (a)) < (Rmin eps_f2 alp_f2)`` -> ``/(Rabsolu (f2 (x+a))) < 2/(Rabsolu (f2 x))``.
-Intro Maj.
-Unfold derivable_pt_lim; Intros.
-Elim (H ``(Rabsolu ((eps*(f2 x))/8))``); [Idtac | Unfold Rdiv; Change ``0 < (Rabsolu (eps*(f2 x)*/8))``; Apply Rabsolu_pos_lt; Repeat Apply prod_neq_R0; [Red; Intro H7; Rewrite H7 in H6; Elim (Rlt_antirefl ? H6) | Assumption | Apply Rinv_neq_R0; DiscrR]].
-Intros alp_f1d H7.
-Case (Req_EM (f1 x) R0); Intro.
-Case (Req_EM l1 R0); Intro.
+Theorem derivable_pt_lim_div :
+ forall (f1 f2:R -> R) (x l1 l2:R),
+ derivable_pt_lim f1 x l1 ->
+ derivable_pt_lim f2 x l2 ->
+ f2 x <> 0 ->
+ derivable_pt_lim (f1 / f2) x ((l1 * f2 x - l2 * f1 x) / Rsqr (f2 x)).
+intros.
+cut (derivable_pt f2 x);
+ [ intro | unfold derivable_pt in |- *; apply existT with l2; exact H0 ].
+assert (H2 := continuous_neq_0 _ _ (derivable_continuous_pt _ _ X) H1).
+elim H2; clear H2; intros eps_f2 H2.
+unfold div_fct in |- *.
+assert (H3 := derivable_continuous_pt _ _ X).
+unfold continuity_pt in H3; unfold continue_in in H3; unfold limit1_in in H3;
+ unfold limit_in in H3; unfold dist in H3.
+simpl in H3; unfold R_dist in H3.
+elim (H3 (Rabs (f2 x) / 2));
+ [ idtac
+ | unfold Rdiv in |- *; change (0 < Rabs (f2 x) * / 2) in |- *;
+ apply Rmult_lt_0_compat;
+ [ apply Rabs_pos_lt; assumption | apply Rinv_0_lt_compat; prove_sup0 ] ].
+clear H3; intros alp_f2 H3.
+cut
+ (forall x0:R,
+ Rabs (x0 - x) < alp_f2 -> Rabs (f2 x0 - f2 x) < Rabs (f2 x) / 2).
+intro H4.
+cut (forall a:R, Rabs (a - x) < alp_f2 -> Rabs (f2 x) / 2 < Rabs (f2 a)).
+intro H5.
+cut
+ (forall a:R,
+ Rabs a < Rmin eps_f2 alp_f2 -> / Rabs (f2 (x + a)) < 2 / Rabs (f2 x)).
+intro Maj.
+unfold derivable_pt_lim in |- *; intros.
+elim (H (Rabs (eps * f2 x / 8)));
+ [ idtac
+ | unfold Rdiv in |- *; change (0 < Rabs (eps * f2 x * / 8)) in |- *;
+ apply Rabs_pos_lt; repeat apply prod_neq_R0;
+ [ red in |- *; intro H7; rewrite H7 in H6; elim (Rlt_irrefl _ H6)
+ | assumption
+ | apply Rinv_neq_0_compat; discrR ] ].
+intros alp_f1d H7.
+case (Req_dec (f1 x) 0); intro.
+case (Req_dec l1 0); intro.
(***********************************)
(* Cas n° 1 *)
(* (f1 x)=0 l1 =0 *)
(***********************************)
-Cut ``0 < (Rmin eps_f2 (Rmin alp_f2 alp_f1d))``; [Intro | Repeat Apply Rmin_pos; [Apply (cond_pos eps_f2) | Elim H3; Intros; Assumption | Apply (cond_pos alp_f1d)]].
-Exists (mkposreal (Rmin eps_f2 (Rmin alp_f2 alp_f1d)) H10).
-Simpl; Intros.
-Assert H13 := (Rlt_le_trans ? ? ? H12 (Rmin_r ? ?)).
-Assert H14 := (Rlt_le_trans ? ? ? H12 (Rmin_l ? ?)).
-Assert H15 := (Rlt_le_trans ? ? ? H13 (Rmin_r ? ?)).
-Assert H16 := (Rlt_le_trans ? ? ? H13 (Rmin_l ? ?)).
-Assert H17 := (H7 ? H11 H15).
-Rewrite formule; [Idtac | Assumption | Assumption | Apply H2; Apply H14].
-Apply Rle_lt_trans with ``(Rabsolu (/(f2 (x+h))*(((f1 (x+h))-(f1 x))/h-l1))) + (Rabsolu (l1/((f2 x)*(f2 (x+h)))*((f2 x)-(f2 (x+h))))) + (Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))-(f2 x))/h-l2))) + (Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))*((f2 (x+h))-(f2 x))))``.
-Unfold Rminus.
-Rewrite <- (Rabsolu_Ropp ``(f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))+ -(f2 x))/h+ -l2)``).
-Apply Rabsolu_4.
-Repeat Rewrite Rabsolu_mult.
-Apply Rlt_le_trans with ``eps/4+eps/4+eps/4+eps/4``.
-Cut ``(Rabsolu (/(f2 (x+h))))*(Rabsolu (((f1 (x+h))-(f1 x))/h-l1)) < eps/4``.
-Cut ``(Rabsolu (l1/((f2 x)*(f2 (x+h)))))*(Rabsolu ((f2 x)-(f2 (x+h)))) < eps/4``.
-Cut ``(Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))))*(Rabsolu (((f2 (x+h))-(f2 x))/h-l2)) < eps/4``.
-Cut ``(Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))))*(Rabsolu ((f2 (x+h))-(f2 x))) < eps/4``.
-Intros.
-Apply Rlt_4; Assumption.
-Rewrite H8.
-Unfold Rdiv; Repeat Rewrite Rmult_Or Orelse Rewrite Rmult_Ol.
-Rewrite Rabsolu_R0; Rewrite Rmult_Ol.
-Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup].
-Rewrite H8.
-Unfold Rdiv; Repeat Rewrite Rmult_Or Orelse Rewrite Rmult_Ol.
-Rewrite Rabsolu_R0; Rewrite Rmult_Ol.
-Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup].
-Rewrite H9.
-Unfold Rdiv; Repeat Rewrite Rmult_Or Orelse Rewrite Rmult_Ol.
-Rewrite Rabsolu_R0; Rewrite Rmult_Ol.
-Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup].
-Rewrite <- Rabsolu_mult.
-Apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); Try Assumption Orelse Apply H2.
-Apply H14.
-Apply Rmin_2; Assumption.
-Right; Symmetry; Apply quadruple_var.
+cut (0 < Rmin eps_f2 (Rmin alp_f2 alp_f1d));
+ [ intro
+ | repeat apply Rmin_pos;
+ [ apply (cond_pos eps_f2)
+ | elim H3; intros; assumption
+ | apply (cond_pos alp_f1d) ] ].
+exists (mkposreal (Rmin eps_f2 (Rmin alp_f2 alp_f1d)) H10).
+simpl in |- *; intros.
+assert (H13 := Rlt_le_trans _ _ _ H12 (Rmin_r _ _)).
+assert (H14 := Rlt_le_trans _ _ _ H12 (Rmin_l _ _)).
+assert (H15 := Rlt_le_trans _ _ _ H13 (Rmin_r _ _)).
+assert (H16 := Rlt_le_trans _ _ _ H13 (Rmin_l _ _)).
+assert (H17 := H7 _ H11 H15).
+rewrite formule; [ idtac | assumption | assumption | apply H2; apply H14 ].
+apply Rle_lt_trans with
+ (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) +
+ Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) +
+ Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) +
+ Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))).
+unfold Rminus in |- *.
+rewrite <-
+ (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2)))
+ .
+apply Rabs_4.
+repeat rewrite Rabs_mult.
+apply Rlt_le_trans with (eps / 4 + eps / 4 + eps / 4 + eps / 4).
+cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4).
+cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4).
+cut
+ (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) <
+ eps / 4).
+cut
+ (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) <
+ eps / 4).
+intros.
+apply Rlt_4; assumption.
+rewrite H8.
+unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
+rewrite Rabs_R0; rewrite Rmult_0_l.
+apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ].
+rewrite H8.
+unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
+rewrite Rabs_R0; rewrite Rmult_0_l.
+apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ].
+rewrite H9.
+unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
+rewrite Rabs_R0; rewrite Rmult_0_l.
+apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ].
+rewrite <- Rabs_mult.
+apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2);
+ try assumption || apply H2.
+apply H14.
+apply Rmin_2; assumption.
+right; symmetry in |- *; apply quadruple_var.
(***********************************)
(* Cas n° 2 *)
(* (f1 x)=0 l1<>0 *)
(***********************************)
-Assert H10 := (derivable_continuous_pt ? ? X).
-Unfold continuity_pt in H10.
-Unfold continue_in in H10.
-Unfold limit1_in in H10.
-Unfold limit_in in H10.
-Unfold dist in H10.
-Simpl in H10.
-Unfold R_dist in H10.
-Elim (H10 ``(Rabsolu (eps*(Rsqr (f2 x)))/(8*l1))``).
-Clear H10; Intros alp_f2t2 H10.
-Cut (a:R) ``(Rabsolu a) < alp_f2t2`` -> ``(Rabsolu ((f2 (x+a)) - (f2 x))) < (Rabsolu ((eps*(Rsqr (f2 x)))/(8*l1)))``.
-Intro H11.
-Cut ``0 < (Rmin (Rmin eps_f2 alp_f1d) (Rmin alp_f2 alp_f2t2))``.
-Intro.
-Exists (mkposreal (Rmin (Rmin eps_f2 alp_f1d) (Rmin alp_f2 alp_f2t2)) H12).
-Simpl.
-Intros.
-Assert H15 := (Rlt_le_trans ? ? ? H14 (Rmin_r ? ?)).
-Assert H16 := (Rlt_le_trans ? ? ? H14 (Rmin_l ? ?)).
-Assert H17 := (Rlt_le_trans ? ? ? H15 (Rmin_l ? ?)).
-Assert H18 := (Rlt_le_trans ? ? ? H15 (Rmin_r ? ?)).
-Assert H19 := (Rlt_le_trans ? ? ? H16 (Rmin_l ? ?)).
-Assert H20 := (Rlt_le_trans ? ? ? H16 (Rmin_r ? ?)).
-Clear H14 H15 H16.
-Rewrite formule; Try Assumption.
-Apply Rle_lt_trans with ``(Rabsolu (/(f2 (x+h))*(((f1 (x+h))-(f1 x))/h-l1))) + (Rabsolu (l1/((f2 x)*(f2 (x+h)))*((f2 x)-(f2 (x+h))))) + (Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))-(f2 x))/h-l2))) + (Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))*((f2 (x+h))-(f2 x))))``.
-Unfold Rminus.
-Rewrite <- (Rabsolu_Ropp ``(f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))+ -(f2 x))/h+ -l2)``).
-Apply Rabsolu_4.
-Repeat Rewrite Rabsolu_mult.
-Apply Rlt_le_trans with ``eps/4+eps/4+eps/4+eps/4``.
-Cut ``(Rabsolu (/(f2 (x+h))))*(Rabsolu (((f1 (x+h))-(f1 x))/h-l1)) < eps/4``.
-Cut ``(Rabsolu (l1/((f2 x)*(f2 (x+h)))))*(Rabsolu ((f2 x)-(f2 (x+h)))) < eps/4``.
-Cut ``(Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))))*(Rabsolu (((f2 (x+h))-(f2 x))/h-l2)) < eps/4``.
-Cut ``(Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))))*(Rabsolu ((f2 (x+h))-(f2 x))) < eps/4``.
-Intros.
-Apply Rlt_4; Assumption.
-Rewrite H8.
-Unfold Rdiv; Repeat Rewrite Rmult_Or Orelse Rewrite Rmult_Ol.
-Rewrite Rabsolu_R0; Rewrite Rmult_Ol.
-Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup].
-Rewrite H8.
-Unfold Rdiv; Repeat Rewrite Rmult_Or Orelse Rewrite Rmult_Ol.
-Rewrite Rabsolu_R0; Rewrite Rmult_Ol.
-Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup].
-Rewrite <- Rabsolu_mult.
-Apply (maj_term2 x h eps l1 alp_f2 alp_f2t2 eps_f2 f2); Try Assumption.
-Apply H2; Assumption.
-Apply Rmin_2; Assumption.
-Rewrite <- Rabsolu_mult.
-Apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); Try Assumption.
-Apply H2; Assumption.
-Apply Rmin_2; Assumption.
-Right; Symmetry; Apply quadruple_var.
-Apply H2; Assumption.
-Repeat Apply Rmin_pos.
-Apply (cond_pos eps_f2).
-Apply (cond_pos alp_f1d).
-Elim H3; Intros; Assumption.
-Elim H10; Intros; Assumption.
-Intros.
-Elim H10; Intros.
-Case (Req_EM a R0); Intro.
-Rewrite H14; Rewrite Rplus_Or.
-Unfold Rminus; Rewrite Rplus_Ropp_r.
-Rewrite Rabsolu_R0.
-Apply Rabsolu_pos_lt.
-Unfold Rdiv Rsqr; Repeat Rewrite Rmult_assoc.
-Repeat Apply prod_neq_R0; Try Assumption.
-Red; Intro; Rewrite H15 in H6; Elim (Rlt_antirefl ? H6).
-Apply Rinv_neq_R0; Repeat Apply prod_neq_R0; DiscrR Orelse Assumption.
-Apply H13.
-Split.
-Apply D_x_no_cond; Assumption.
-Replace ``x+a-x`` with a; [Assumption | Ring].
-Change ``0<(Rabsolu ((eps*(Rsqr (f2 x)))/(8*l1)))``.
-Apply Rabsolu_pos_lt; Unfold Rdiv Rsqr; Repeat Rewrite Rmult_assoc; Repeat Apply prod_neq_R0.
-Red; Intro; Rewrite H11 in H6; Elim (Rlt_antirefl ? H6).
-Assumption.
-Assumption.
-Apply Rinv_neq_R0; Repeat Apply prod_neq_R0; [DiscrR | DiscrR | DiscrR | Assumption].
+assert (H10 := derivable_continuous_pt _ _ X).
+unfold continuity_pt in H10.
+unfold continue_in in H10.
+unfold limit1_in in H10.
+unfold limit_in in H10.
+unfold dist in H10.
+simpl in H10.
+unfold R_dist in H10.
+elim (H10 (Rabs (eps * Rsqr (f2 x) / (8 * l1)))).
+clear H10; intros alp_f2t2 H10.
+cut
+ (forall a:R,
+ Rabs a < alp_f2t2 ->
+ Rabs (f2 (x + a) - f2 x) < Rabs (eps * Rsqr (f2 x) / (8 * l1))).
+intro H11.
+cut (0 < Rmin (Rmin eps_f2 alp_f1d) (Rmin alp_f2 alp_f2t2)).
+intro.
+exists (mkposreal (Rmin (Rmin eps_f2 alp_f1d) (Rmin alp_f2 alp_f2t2)) H12).
+simpl in |- *.
+intros.
+assert (H15 := Rlt_le_trans _ _ _ H14 (Rmin_r _ _)).
+assert (H16 := Rlt_le_trans _ _ _ H14 (Rmin_l _ _)).
+assert (H17 := Rlt_le_trans _ _ _ H15 (Rmin_l _ _)).
+assert (H18 := Rlt_le_trans _ _ _ H15 (Rmin_r _ _)).
+assert (H19 := Rlt_le_trans _ _ _ H16 (Rmin_l _ _)).
+assert (H20 := Rlt_le_trans _ _ _ H16 (Rmin_r _ _)).
+clear H14 H15 H16.
+rewrite formule; try assumption.
+apply Rle_lt_trans with
+ (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) +
+ Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) +
+ Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) +
+ Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))).
+unfold Rminus in |- *.
+rewrite <-
+ (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2)))
+ .
+apply Rabs_4.
+repeat rewrite Rabs_mult.
+apply Rlt_le_trans with (eps / 4 + eps / 4 + eps / 4 + eps / 4).
+cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4).
+cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4).
+cut
+ (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) <
+ eps / 4).
+cut
+ (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) <
+ eps / 4).
+intros.
+apply Rlt_4; assumption.
+rewrite H8.
+unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
+rewrite Rabs_R0; rewrite Rmult_0_l.
+apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ].
+rewrite H8.
+unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
+rewrite Rabs_R0; rewrite Rmult_0_l.
+apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ].
+rewrite <- Rabs_mult.
+apply (maj_term2 x h eps l1 alp_f2 alp_f2t2 eps_f2 f2); try assumption.
+apply H2; assumption.
+apply Rmin_2; assumption.
+rewrite <- Rabs_mult.
+apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); try assumption.
+apply H2; assumption.
+apply Rmin_2; assumption.
+right; symmetry in |- *; apply quadruple_var.
+apply H2; assumption.
+repeat apply Rmin_pos.
+apply (cond_pos eps_f2).
+apply (cond_pos alp_f1d).
+elim H3; intros; assumption.
+elim H10; intros; assumption.
+intros.
+elim H10; intros.
+case (Req_dec a 0); intro.
+rewrite H14; rewrite Rplus_0_r.
+unfold Rminus in |- *; rewrite Rplus_opp_r.
+rewrite Rabs_R0.
+apply Rabs_pos_lt.
+unfold Rdiv, Rsqr in |- *; repeat rewrite Rmult_assoc.
+repeat apply prod_neq_R0; try assumption.
+red in |- *; intro; rewrite H15 in H6; elim (Rlt_irrefl _ H6).
+apply Rinv_neq_0_compat; repeat apply prod_neq_R0; discrR || assumption.
+apply H13.
+split.
+apply D_x_no_cond; assumption.
+replace (x + a - x) with a; [ assumption | ring ].
+change (0 < Rabs (eps * Rsqr (f2 x) / (8 * l1))) in |- *.
+apply Rabs_pos_lt; unfold Rdiv, Rsqr in |- *; repeat rewrite Rmult_assoc;
+ repeat apply prod_neq_R0.
+red in |- *; intro; rewrite H11 in H6; elim (Rlt_irrefl _ H6).
+assumption.
+assumption.
+apply Rinv_neq_0_compat; repeat apply prod_neq_R0;
+ [ discrR | discrR | discrR | assumption ].
(***********************************)
(* Cas n° 3 *)
(* (f1 x)<>0 l1=0 l2=0 *)
(***********************************)
-Case (Req_EM l1 R0); Intro.
-Case (Req_EM l2 R0); Intro.
-Elim (H0 ``(Rabsolu ((Rsqr (f2 x))*eps)/(8*(f1 x)))``); [Idtac | Apply Rabsolu_pos_lt; Unfold Rdiv Rsqr; Repeat Rewrite Rmult_assoc; Repeat Apply prod_neq_R0; [Assumption | Assumption | Red; Intro; Rewrite H11 in H6; Elim (Rlt_antirefl ? H6) | Apply Rinv_neq_R0; Repeat Apply prod_neq_R0; DiscrR Orelse Assumption]].
-Intros alp_f2d H12.
-Cut ``0 < (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d))``.
-Intro.
-Exists (mkposreal (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d)) H11).
-Simpl.
-Intros.
-Assert H15 := (Rlt_le_trans ? ? ? H14 (Rmin_l ? ?)).
-Assert H16 := (Rlt_le_trans ? ? ? H14 (Rmin_r ? ?)).
-Assert H17 := (Rlt_le_trans ? ? ? H15 (Rmin_l ? ?)).
-Assert H18 := (Rlt_le_trans ? ? ? H15 (Rmin_r ? ?)).
-Assert H19 := (Rlt_le_trans ? ? ? H16 (Rmin_l ? ?)).
-Assert H20 := (Rlt_le_trans ? ? ? H16 (Rmin_r ? ?)).
-Clear H15 H16.
-Rewrite formule; Try Assumption.
-Apply Rle_lt_trans with ``(Rabsolu (/(f2 (x+h))*(((f1 (x+h))-(f1 x))/h-l1))) + (Rabsolu (l1/((f2 x)*(f2 (x+h)))*((f2 x)-(f2 (x+h))))) + (Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))-(f2 x))/h-l2))) + (Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))*((f2 (x+h))-(f2 x))))``.
-Unfold Rminus.
-Rewrite <- (Rabsolu_Ropp ``(f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))+ -(f2 x))/h+ -l2)``).
-Apply Rabsolu_4.
-Repeat Rewrite Rabsolu_mult.
-Apply Rlt_le_trans with ``eps/4+eps/4+eps/4+eps/4``.
-Cut ``(Rabsolu (/(f2 (x+h))))*(Rabsolu (((f1 (x+h))-(f1 x))/h-l1)) < eps/4``.
-Cut ``(Rabsolu (l1/((f2 x)*(f2 (x+h)))))*(Rabsolu ((f2 x)-(f2 (x+h)))) < eps/4``.
-Cut ``(Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))))*(Rabsolu (((f2 (x+h))-(f2 x))/h-l2)) < eps/4``.
-Cut ``(Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))))*(Rabsolu ((f2 (x+h))-(f2 x))) < eps/4``.
-Intros.
-Apply Rlt_4; Assumption.
-Rewrite H10.
-Unfold Rdiv; Repeat Rewrite Rmult_Or Orelse Rewrite Rmult_Ol.
-Rewrite Rabsolu_R0; Rewrite Rmult_Ol.
-Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup].
-Rewrite <- Rabsolu_mult.
-Apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); Try Assumption.
-Apply H2; Assumption.
-Apply Rmin_2; Assumption.
-Rewrite H9.
-Unfold Rdiv; Repeat Rewrite Rmult_Or Orelse Rewrite Rmult_Ol.
-Rewrite Rabsolu_R0; Rewrite Rmult_Ol.
-Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup].
-Rewrite <- Rabsolu_mult.
-Apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); Assumption Orelse Idtac.
-Apply H2; Assumption.
-Apply Rmin_2; Assumption.
-Right; Symmetry; Apply quadruple_var.
-Apply H2; Assumption.
-Repeat Apply Rmin_pos.
-Apply (cond_pos eps_f2).
-Elim H3; Intros; Assumption.
-Apply (cond_pos alp_f1d).
-Apply (cond_pos alp_f2d).
+case (Req_dec l1 0); intro.
+case (Req_dec l2 0); intro.
+elim (H0 (Rabs (Rsqr (f2 x) * eps / (8 * f1 x))));
+ [ idtac
+ | apply Rabs_pos_lt; unfold Rdiv, Rsqr in |- *; repeat rewrite Rmult_assoc;
+ repeat apply prod_neq_R0;
+ [ assumption
+ | assumption
+ | red in |- *; intro; rewrite H11 in H6; elim (Rlt_irrefl _ H6)
+ | apply Rinv_neq_0_compat; repeat apply prod_neq_R0; discrR || assumption ] ].
+intros alp_f2d H12.
+cut (0 < Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d)).
+intro.
+exists (mkposreal (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d)) H11).
+simpl in |- *.
+intros.
+assert (H15 := Rlt_le_trans _ _ _ H14 (Rmin_l _ _)).
+assert (H16 := Rlt_le_trans _ _ _ H14 (Rmin_r _ _)).
+assert (H17 := Rlt_le_trans _ _ _ H15 (Rmin_l _ _)).
+assert (H18 := Rlt_le_trans _ _ _ H15 (Rmin_r _ _)).
+assert (H19 := Rlt_le_trans _ _ _ H16 (Rmin_l _ _)).
+assert (H20 := Rlt_le_trans _ _ _ H16 (Rmin_r _ _)).
+clear H15 H16.
+rewrite formule; try assumption.
+apply Rle_lt_trans with
+ (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) +
+ Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) +
+ Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) +
+ Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))).
+unfold Rminus in |- *.
+rewrite <-
+ (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2)))
+ .
+apply Rabs_4.
+repeat rewrite Rabs_mult.
+apply Rlt_le_trans with (eps / 4 + eps / 4 + eps / 4 + eps / 4).
+cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4).
+cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4).
+cut
+ (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) <
+ eps / 4).
+cut
+ (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) <
+ eps / 4).
+intros.
+apply Rlt_4; assumption.
+rewrite H10.
+unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
+rewrite Rabs_R0; rewrite Rmult_0_l.
+apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ].
+rewrite <- Rabs_mult.
+apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); try assumption.
+apply H2; assumption.
+apply Rmin_2; assumption.
+rewrite H9.
+unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
+rewrite Rabs_R0; rewrite Rmult_0_l.
+apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ].
+rewrite <- Rabs_mult.
+apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); assumption || idtac.
+apply H2; assumption.
+apply Rmin_2; assumption.
+right; symmetry in |- *; apply quadruple_var.
+apply H2; assumption.
+repeat apply Rmin_pos.
+apply (cond_pos eps_f2).
+elim H3; intros; assumption.
+apply (cond_pos alp_f1d).
+apply (cond_pos alp_f2d).
(***********************************)
(* Cas n° 4 *)
(* (f1 x)<>0 l1=0 l2<>0 *)
(***********************************)
-Elim (H0 ``(Rabsolu ((Rsqr (f2 x))*eps)/(8*(f1 x)))``); [Idtac | Apply Rabsolu_pos_lt; Unfold Rsqr Rdiv; Repeat Rewrite Rinv_Rmult; Repeat Apply prod_neq_R0; Try Assumption Orelse DiscrR].
-Intros alp_f2d H11.
-Assert H12 := (derivable_continuous_pt ? ? X).
-Unfold continuity_pt in H12.
-Unfold continue_in in H12.
-Unfold limit1_in in H12.
-Unfold limit_in in H12.
-Unfold dist in H12.
-Simpl in H12.
-Unfold R_dist in H12.
-Elim (H12 ``(Rabsolu (((Rsqr (f2 x))*(f2 x)*eps)/(8*(f1 x)*l2)))``).
-Intros alp_f2c H13.
-Cut ``0 < (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2c)))``.
-Intro.
-Exists (mkposreal (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2c))) H14).
-Simpl; Intros.
-Assert H17 := (Rlt_le_trans ? ? ? H16 (Rmin_l ? ?)).
-Assert H18 := (Rlt_le_trans ? ? ? H16 (Rmin_r ? ?)).
-Assert H19 := (Rlt_le_trans ? ? ? H18 (Rmin_r ? ?)).
-Assert H20 := (Rlt_le_trans ? ? ? H19 (Rmin_l ? ?)).
-Assert H21 := (Rlt_le_trans ? ? ? H19 (Rmin_r ? ?)).
-Assert H22 := (Rlt_le_trans ? ? ? H18 (Rmin_l ? ?)).
-Assert H23 := (Rlt_le_trans ? ? ? H17 (Rmin_l ? ?)).
-Assert H24 := (Rlt_le_trans ? ? ? H17 (Rmin_r ? ?)).
-Clear H16 H17 H18 H19.
-Cut (a:R) ``(Rabsolu a) < alp_f2c`` -> ``(Rabsolu ((f2 (x+a))-(f2 x))) < (Rabsolu (((Rsqr (f2 x))*(f2 x)*eps)/(8*(f1 x)*l2)))``.
-Intro.
-Rewrite formule; Try Assumption.
-Apply Rle_lt_trans with ``(Rabsolu (/(f2 (x+h))*(((f1 (x+h))-(f1 x))/h-l1))) + (Rabsolu (l1/((f2 x)*(f2 (x+h)))*((f2 x)-(f2 (x+h))))) + (Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))-(f2 x))/h-l2))) + (Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))*((f2 (x+h))-(f2 x))))``.
-Unfold Rminus.
-Rewrite <- (Rabsolu_Ropp ``(f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))+ -(f2 x))/h+ -l2)``).
-Apply Rabsolu_4.
-Repeat Rewrite Rabsolu_mult.
-Apply Rlt_le_trans with ``eps/4+eps/4+eps/4+eps/4``.
-Cut ``(Rabsolu (/(f2 (x+h))))*(Rabsolu (((f1 (x+h))-(f1 x))/h-l1)) < eps/4``.
-Cut ``(Rabsolu (l1/((f2 x)*(f2 (x+h)))))*(Rabsolu ((f2 x)-(f2 (x+h)))) < eps/4``.
-Cut ``(Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))))*(Rabsolu (((f2 (x+h))-(f2 x))/h-l2)) < eps/4``.
-Cut ``(Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))))*(Rabsolu ((f2 (x+h))-(f2 x))) < eps/4``.
-Intros.
-Apply Rlt_4; Assumption.
-Rewrite <- Rabsolu_mult.
-Apply (maj_term4 x h eps l2 alp_f2 alp_f2c eps_f2 f1 f2); Try Assumption.
-Apply H2; Assumption.
-Apply Rmin_2; Assumption.
-Rewrite <- Rabsolu_mult.
-Apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); Try Assumption.
-Apply H2; Assumption.
-Apply Rmin_2; Assumption.
-Rewrite H9.
-Unfold Rdiv; Repeat Rewrite Rmult_Or Orelse Rewrite Rmult_Ol.
-Rewrite Rabsolu_R0; Rewrite Rmult_Ol.
-Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup].
-Rewrite <- Rabsolu_mult.
-Apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); Try Assumption.
-Apply H2; Assumption.
-Apply Rmin_2; Assumption.
-Right; Symmetry; Apply quadruple_var.
-Apply H2; Assumption.
-Intros.
-Case (Req_EM a R0); Intro.
-Rewrite H17; Rewrite Rplus_Or.
-Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0.
-Apply Rabsolu_pos_lt.
-Unfold Rdiv Rsqr.
-Repeat Rewrite Rinv_Rmult; Try Assumption.
-Repeat Apply prod_neq_R0; Try Assumption.
-Red; Intro H18; Rewrite H18 in H6; Elim (Rlt_antirefl ? H6).
-Apply Rinv_neq_R0; DiscrR.
-Apply Rinv_neq_R0; DiscrR.
-Apply Rinv_neq_R0; DiscrR.
-Apply Rinv_neq_R0; Assumption.
-Apply Rinv_neq_R0; Assumption.
-DiscrR.
-DiscrR.
-DiscrR.
-DiscrR.
-DiscrR.
-Apply prod_neq_R0; [DiscrR | Assumption].
-Elim H13; Intros.
-Apply H19.
-Split.
-Apply D_x_no_cond; Assumption.
-Replace ``x+a-x`` with a; [Assumption | Ring].
-Repeat Apply Rmin_pos.
-Apply (cond_pos eps_f2).
-Elim H3; Intros; Assumption.
-Apply (cond_pos alp_f1d).
-Apply (cond_pos alp_f2d).
-Elim H13; Intros; Assumption.
-Change ``0 < (Rabsolu (((Rsqr (f2 x))*(f2 x)*eps)/(8*(f1 x)*l2)))``.
-Apply Rabsolu_pos_lt.
-Unfold Rsqr Rdiv.
-Repeat Rewrite Rinv_Rmult; Try Assumption Orelse DiscrR.
-Repeat Apply prod_neq_R0; Try Assumption.
-Red; Intro H13; Rewrite H13 in H6; Elim (Rlt_antirefl ? H6).
-Apply Rinv_neq_R0; DiscrR.
-Apply Rinv_neq_R0; DiscrR.
-Apply Rinv_neq_R0; DiscrR.
-Apply Rinv_neq_R0; Assumption.
-Apply Rinv_neq_R0; Assumption.
-Apply prod_neq_R0; [DiscrR | Assumption].
-Red; Intro H11; Rewrite H11 in H6; Elim (Rlt_antirefl ? H6).
-Apply Rinv_neq_R0; DiscrR.
-Apply Rinv_neq_R0; DiscrR.
-Apply Rinv_neq_R0; DiscrR.
-Apply Rinv_neq_R0; Assumption.
+elim (H0 (Rabs (Rsqr (f2 x) * eps / (8 * f1 x))));
+ [ idtac
+ | apply Rabs_pos_lt; unfold Rsqr, Rdiv in |- *;
+ repeat rewrite Rinv_mult_distr; repeat apply prod_neq_R0;
+ try assumption || discrR ].
+intros alp_f2d H11.
+assert (H12 := derivable_continuous_pt _ _ X).
+unfold continuity_pt in H12.
+unfold continue_in in H12.
+unfold limit1_in in H12.
+unfold limit_in in H12.
+unfold dist in H12.
+simpl in H12.
+unfold R_dist in H12.
+elim (H12 (Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2)))).
+intros alp_f2c H13.
+cut (0 < Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2c))).
+intro.
+exists
+ (mkposreal (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2c)))
+ H14).
+simpl in |- *; intros.
+assert (H17 := Rlt_le_trans _ _ _ H16 (Rmin_l _ _)).
+assert (H18 := Rlt_le_trans _ _ _ H16 (Rmin_r _ _)).
+assert (H19 := Rlt_le_trans _ _ _ H18 (Rmin_r _ _)).
+assert (H20 := Rlt_le_trans _ _ _ H19 (Rmin_l _ _)).
+assert (H21 := Rlt_le_trans _ _ _ H19 (Rmin_r _ _)).
+assert (H22 := Rlt_le_trans _ _ _ H18 (Rmin_l _ _)).
+assert (H23 := Rlt_le_trans _ _ _ H17 (Rmin_l _ _)).
+assert (H24 := Rlt_le_trans _ _ _ H17 (Rmin_r _ _)).
+clear H16 H17 H18 H19.
+cut
+ (forall a:R,
+ Rabs a < alp_f2c ->
+ Rabs (f2 (x + a) - f2 x) <
+ Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))).
+intro.
+rewrite formule; try assumption.
+apply Rle_lt_trans with
+ (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) +
+ Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) +
+ Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) +
+ Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))).
+unfold Rminus in |- *.
+rewrite <-
+ (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2)))
+ .
+apply Rabs_4.
+repeat rewrite Rabs_mult.
+apply Rlt_le_trans with (eps / 4 + eps / 4 + eps / 4 + eps / 4).
+cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4).
+cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4).
+cut
+ (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) <
+ eps / 4).
+cut
+ (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) <
+ eps / 4).
+intros.
+apply Rlt_4; assumption.
+rewrite <- Rabs_mult.
+apply (maj_term4 x h eps l2 alp_f2 alp_f2c eps_f2 f1 f2); try assumption.
+apply H2; assumption.
+apply Rmin_2; assumption.
+rewrite <- Rabs_mult.
+apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); try assumption.
+apply H2; assumption.
+apply Rmin_2; assumption.
+rewrite H9.
+unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
+rewrite Rabs_R0; rewrite Rmult_0_l.
+apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ].
+rewrite <- Rabs_mult.
+apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); try assumption.
+apply H2; assumption.
+apply Rmin_2; assumption.
+right; symmetry in |- *; apply quadruple_var.
+apply H2; assumption.
+intros.
+case (Req_dec a 0); intro.
+rewrite H17; rewrite Rplus_0_r.
+unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0.
+apply Rabs_pos_lt.
+unfold Rdiv, Rsqr in |- *.
+repeat rewrite Rinv_mult_distr; try assumption.
+repeat apply prod_neq_R0; try assumption.
+red in |- *; intro H18; rewrite H18 in H6; elim (Rlt_irrefl _ H6).
+apply Rinv_neq_0_compat; discrR.
+apply Rinv_neq_0_compat; discrR.
+apply Rinv_neq_0_compat; discrR.
+apply Rinv_neq_0_compat; assumption.
+apply Rinv_neq_0_compat; assumption.
+discrR.
+discrR.
+discrR.
+discrR.
+discrR.
+apply prod_neq_R0; [ discrR | assumption ].
+elim H13; intros.
+apply H19.
+split.
+apply D_x_no_cond; assumption.
+replace (x + a - x) with a; [ assumption | ring ].
+repeat apply Rmin_pos.
+apply (cond_pos eps_f2).
+elim H3; intros; assumption.
+apply (cond_pos alp_f1d).
+apply (cond_pos alp_f2d).
+elim H13; intros; assumption.
+change (0 < Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))) in |- *.
+apply Rabs_pos_lt.
+unfold Rsqr, Rdiv in |- *.
+repeat rewrite Rinv_mult_distr; try assumption || discrR.
+repeat apply prod_neq_R0; try assumption.
+red in |- *; intro H13; rewrite H13 in H6; elim (Rlt_irrefl _ H6).
+apply Rinv_neq_0_compat; discrR.
+apply Rinv_neq_0_compat; discrR.
+apply Rinv_neq_0_compat; discrR.
+apply Rinv_neq_0_compat; assumption.
+apply Rinv_neq_0_compat; assumption.
+apply prod_neq_R0; [ discrR | assumption ].
+red in |- *; intro H11; rewrite H11 in H6; elim (Rlt_irrefl _ H6).
+apply Rinv_neq_0_compat; discrR.
+apply Rinv_neq_0_compat; discrR.
+apply Rinv_neq_0_compat; discrR.
+apply Rinv_neq_0_compat; assumption.
(***********************************)
(* Cas n° 5 *)
(* (f1 x)<>0 l1<>0 l2=0 *)
(***********************************)
-Case (Req_EM l2 R0); Intro.
-Assert H11 := (derivable_continuous_pt ? ? X).
-Unfold continuity_pt in H11.
-Unfold continue_in in H11.
-Unfold limit1_in in H11.
-Unfold limit_in in H11.
-Unfold dist in H11.
-Simpl in H11.
-Unfold R_dist in H11.
-Elim (H11 ``(Rabsolu (eps*(Rsqr (f2 x)))/(8*l1))``).
-Clear H11; Intros alp_f2t2 H11.
-Elim (H0 ``(Rabsolu ((Rsqr (f2 x))*eps)/(8*(f1 x)))``).
-Intros alp_f2d H12.
-Cut ``0 < (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2t2)))``.
-Intro.
-Exists (mkposreal (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2t2))) H13).
-Simpl.
-Intros.
-Cut (a:R) ``(Rabsolu a)<alp_f2t2`` -> ``(Rabsolu ((f2 (x+a))-(f2 x)))<(Rabsolu ((eps*(Rsqr (f2 x)))/(8*l1)))``.
-Intro.
-Assert H17 := (Rlt_le_trans ? ? ? H15 (Rmin_l ? ?)).
-Assert H18 := (Rlt_le_trans ? ? ? H15 (Rmin_r ? ?)).
-Assert H19 := (Rlt_le_trans ? ? ? H17 (Rmin_r ? ?)).
-Assert H20 := (Rlt_le_trans ? ? ? H17 (Rmin_l ? ?)).
-Assert H21 := (Rlt_le_trans ? ? ? H18 (Rmin_r ? ?)).
-Assert H22 := (Rlt_le_trans ? ? ? H18 (Rmin_l ? ?)).
-Assert H23 := (Rlt_le_trans ? ? ? H21 (Rmin_l ? ?)).
-Assert H24 := (Rlt_le_trans ? ? ? H21 (Rmin_r ? ?)).
-Clear H15 H17 H18 H21.
-Rewrite formule; Try Assumption.
-Apply Rle_lt_trans with ``(Rabsolu (/(f2 (x+h))*(((f1 (x+h))-(f1 x))/h-l1))) + (Rabsolu (l1/((f2 x)*(f2 (x+h)))*((f2 x)-(f2 (x+h))))) + (Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))-(f2 x))/h-l2))) + (Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))*((f2 (x+h))-(f2 x))))``.
-Unfold Rminus.
-Rewrite <- (Rabsolu_Ropp ``(f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))+ -(f2 x))/h+ -l2)``).
-Apply Rabsolu_4.
-Repeat Rewrite Rabsolu_mult.
-Apply Rlt_le_trans with ``eps/4+eps/4+eps/4+eps/4``.
-Cut ``(Rabsolu (/(f2 (x+h))))*(Rabsolu (((f1 (x+h))-(f1 x))/h-l1)) < eps/4``.
-Cut ``(Rabsolu (l1/((f2 x)*(f2 (x+h)))))*(Rabsolu ((f2 x)-(f2 (x+h)))) < eps/4``.
-Cut ``(Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))))*(Rabsolu (((f2 (x+h))-(f2 x))/h-l2)) < eps/4``.
-Cut ``(Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))))*(Rabsolu ((f2 (x+h))-(f2 x))) < eps/4``.
-Intros.
-Apply Rlt_4; Assumption.
-Rewrite H10.
-Unfold Rdiv; Repeat Rewrite Rmult_Or Orelse Rewrite Rmult_Ol.
-Rewrite Rabsolu_R0; Rewrite Rmult_Ol.
-Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup].
-Rewrite <- Rabsolu_mult.
-Apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); Try Assumption.
-Apply H2; Assumption.
-Apply Rmin_2; Assumption.
-Rewrite <- Rabsolu_mult.
-Apply (maj_term2 x h eps l1 alp_f2 alp_f2t2 eps_f2 f2); Try Assumption.
-Apply H2; Assumption.
-Apply Rmin_2; Assumption.
-Rewrite <- Rabsolu_mult.
-Apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); Try Assumption.
-Apply H2; Assumption.
-Apply Rmin_2; Assumption.
-Right; Symmetry; Apply quadruple_var.
-Apply H2; Assumption.
-Intros.
-Case (Req_EM a R0); Intro.
-Rewrite H17; Rewrite Rplus_Or; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0.
-Apply Rabsolu_pos_lt.
-Unfold Rdiv; Rewrite Rinv_Rmult; Try DiscrR Orelse Assumption.
-Unfold Rsqr.
-Repeat Apply prod_neq_R0; Assumption Orelse (Apply Rinv_neq_R0; Assumption) Orelse (Apply Rinv_neq_R0; DiscrR) Orelse (Red; Intro H18; Rewrite H18 in H6; Elim (Rlt_antirefl ? H6)).
-Elim H11; Intros.
-Apply H19.
-Split.
-Apply D_x_no_cond; Assumption.
-Replace ``x+a-x`` with a; [Assumption | Ring].
-Repeat Apply Rmin_pos.
-Apply (cond_pos eps_f2).
-Elim H3; Intros; Assumption.
-Apply (cond_pos alp_f1d).
-Apply (cond_pos alp_f2d).
-Elim H11; Intros; Assumption.
-Apply Rabsolu_pos_lt.
-Unfold Rdiv Rsqr; Rewrite Rinv_Rmult; Try DiscrR Orelse Assumption.
-Repeat Apply prod_neq_R0; Assumption Orelse (Apply Rinv_neq_R0; Assumption) Orelse (Apply Rinv_neq_R0; DiscrR) Orelse (Red; Intro H12; Rewrite H12 in H6; Elim (Rlt_antirefl ? H6)).
-Change ``0 < (Rabsolu ((eps*(Rsqr (f2 x)))/(8*l1)))``.
-Apply Rabsolu_pos_lt.
-Unfold Rdiv Rsqr; Rewrite Rinv_Rmult; Try DiscrR Orelse Assumption.
-Repeat Apply prod_neq_R0; Assumption Orelse (Apply Rinv_neq_R0; Assumption) Orelse (Apply Rinv_neq_R0; DiscrR) Orelse (Red; Intro H12; Rewrite H12 in H6; Elim (Rlt_antirefl ? H6)).
+case (Req_dec l2 0); intro.
+assert (H11 := derivable_continuous_pt _ _ X).
+unfold continuity_pt in H11.
+unfold continue_in in H11.
+unfold limit1_in in H11.
+unfold limit_in in H11.
+unfold dist in H11.
+simpl in H11.
+unfold R_dist in H11.
+elim (H11 (Rabs (eps * Rsqr (f2 x) / (8 * l1)))).
+clear H11; intros alp_f2t2 H11.
+elim (H0 (Rabs (Rsqr (f2 x) * eps / (8 * f1 x)))).
+intros alp_f2d H12.
+cut (0 < Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2t2))).
+intro.
+exists
+ (mkposreal
+ (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2t2))) H13).
+simpl in |- *.
+intros.
+cut
+ (forall a:R,
+ Rabs a < alp_f2t2 ->
+ Rabs (f2 (x + a) - f2 x) < Rabs (eps * Rsqr (f2 x) / (8 * l1))).
+intro.
+assert (H17 := Rlt_le_trans _ _ _ H15 (Rmin_l _ _)).
+assert (H18 := Rlt_le_trans _ _ _ H15 (Rmin_r _ _)).
+assert (H19 := Rlt_le_trans _ _ _ H17 (Rmin_r _ _)).
+assert (H20 := Rlt_le_trans _ _ _ H17 (Rmin_l _ _)).
+assert (H21 := Rlt_le_trans _ _ _ H18 (Rmin_r _ _)).
+assert (H22 := Rlt_le_trans _ _ _ H18 (Rmin_l _ _)).
+assert (H23 := Rlt_le_trans _ _ _ H21 (Rmin_l _ _)).
+assert (H24 := Rlt_le_trans _ _ _ H21 (Rmin_r _ _)).
+clear H15 H17 H18 H21.
+rewrite formule; try assumption.
+apply Rle_lt_trans with
+ (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) +
+ Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) +
+ Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) +
+ Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))).
+unfold Rminus in |- *.
+rewrite <-
+ (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2)))
+ .
+apply Rabs_4.
+repeat rewrite Rabs_mult.
+apply Rlt_le_trans with (eps / 4 + eps / 4 + eps / 4 + eps / 4).
+cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4).
+cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4).
+cut
+ (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) <
+ eps / 4).
+cut
+ (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) <
+ eps / 4).
+intros.
+apply Rlt_4; assumption.
+rewrite H10.
+unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
+rewrite Rabs_R0; rewrite Rmult_0_l.
+apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ].
+rewrite <- Rabs_mult.
+apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); try assumption.
+apply H2; assumption.
+apply Rmin_2; assumption.
+rewrite <- Rabs_mult.
+apply (maj_term2 x h eps l1 alp_f2 alp_f2t2 eps_f2 f2); try assumption.
+apply H2; assumption.
+apply Rmin_2; assumption.
+rewrite <- Rabs_mult.
+apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); try assumption.
+apply H2; assumption.
+apply Rmin_2; assumption.
+right; symmetry in |- *; apply quadruple_var.
+apply H2; assumption.
+intros.
+case (Req_dec a 0); intro.
+rewrite H17; rewrite Rplus_0_r; unfold Rminus in |- *; rewrite Rplus_opp_r;
+ rewrite Rabs_R0.
+apply Rabs_pos_lt.
+unfold Rdiv in |- *; rewrite Rinv_mult_distr; try discrR || assumption.
+unfold Rsqr in |- *.
+repeat apply prod_neq_R0;
+ assumption ||
+ (apply Rinv_neq_0_compat; assumption) ||
+ (apply Rinv_neq_0_compat; discrR) ||
+ (red in |- *; intro H18; rewrite H18 in H6; elim (Rlt_irrefl _ H6)).
+elim H11; intros.
+apply H19.
+split.
+apply D_x_no_cond; assumption.
+replace (x + a - x) with a; [ assumption | ring ].
+repeat apply Rmin_pos.
+apply (cond_pos eps_f2).
+elim H3; intros; assumption.
+apply (cond_pos alp_f1d).
+apply (cond_pos alp_f2d).
+elim H11; intros; assumption.
+apply Rabs_pos_lt.
+unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr; try discrR || assumption.
+repeat apply prod_neq_R0;
+ assumption ||
+ (apply Rinv_neq_0_compat; assumption) ||
+ (apply Rinv_neq_0_compat; discrR) ||
+ (red in |- *; intro H12; rewrite H12 in H6; elim (Rlt_irrefl _ H6)).
+change (0 < Rabs (eps * Rsqr (f2 x) / (8 * l1))) in |- *.
+apply Rabs_pos_lt.
+unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr; try discrR || assumption.
+repeat apply prod_neq_R0;
+ assumption ||
+ (apply Rinv_neq_0_compat; assumption) ||
+ (apply Rinv_neq_0_compat; discrR) ||
+ (red in |- *; intro H12; rewrite H12 in H6; elim (Rlt_irrefl _ H6)).
(***********************************)
(* Cas n° 6 *)
(* (f1 x)<>0 l1<>0 l2<>0 *)
(***********************************)
-Elim (H0 ``(Rabsolu ((Rsqr (f2 x))*eps)/(8*(f1 x)))``).
-Intros alp_f2d H11.
-Assert H12 := (derivable_continuous_pt ? ? X).
-Unfold continuity_pt in H12.
-Unfold continue_in in H12.
-Unfold limit1_in in H12.
-Unfold limit_in in H12.
-Unfold dist in H12.
-Simpl in H12.
-Unfold R_dist in H12.
-Elim (H12 ``(Rabsolu (((Rsqr (f2 x))*(f2 x)*eps)/(8*(f1 x)*l2)))``).
-Intros alp_f2c H13.
-Elim (H12 ``(Rabsolu (eps*(Rsqr (f2 x)))/(8*l1))``).
-Intros alp_f2t2 H14.
-Cut ``0 < (Rmin (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d)) (Rmin alp_f2c alp_f2t2))``.
-Intro.
-Exists (mkposreal (Rmin (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d)) (Rmin alp_f2c alp_f2t2)) H15).
-Simpl.
-Intros.
-Assert H18 := (Rlt_le_trans ? ? ? H17 (Rmin_l ? ?)).
-Assert H19 := (Rlt_le_trans ? ? ? H17 (Rmin_r ? ?)).
-Assert H20 := (Rlt_le_trans ? ? ? H18 (Rmin_l ? ?)).
-Assert H21 := (Rlt_le_trans ? ? ? H18 (Rmin_r ? ?)).
-Assert H22 := (Rlt_le_trans ? ? ? H19 (Rmin_l ? ?)).
-Assert H23 := (Rlt_le_trans ? ? ? H19 (Rmin_r ? ?)).
-Assert H24 := (Rlt_le_trans ? ? ? H20 (Rmin_l ? ?)).
-Assert H25 := (Rlt_le_trans ? ? ? H20 (Rmin_r ? ?)).
-Assert H26 := (Rlt_le_trans ? ? ? H21 (Rmin_l ? ?)).
-Assert H27 := (Rlt_le_trans ? ? ? H21 (Rmin_r ? ?)).
-Clear H17 H18 H19 H20 H21.
-Cut (a:R) ``(Rabsolu a) < alp_f2t2`` -> ``(Rabsolu ((f2 (x+a))-(f2 x))) < (Rabsolu ((eps*(Rsqr (f2 x)))/(8*l1)))``.
-Cut (a:R) ``(Rabsolu a) < alp_f2c`` -> ``(Rabsolu ((f2 (x+a))-(f2 x))) < (Rabsolu (((Rsqr (f2 x))*(f2 x)*eps)/(8*(f1 x)*l2)))``.
-Intros.
-Rewrite formule; Try Assumption.
-Apply Rle_lt_trans with ``(Rabsolu (/(f2 (x+h))*(((f1 (x+h))-(f1 x))/h-l1))) + (Rabsolu (l1/((f2 x)*(f2 (x+h)))*((f2 x)-(f2 (x+h))))) + (Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))-(f2 x))/h-l2))) + (Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))*((f2 (x+h))-(f2 x))))``.
-Unfold Rminus.
-Rewrite <- (Rabsolu_Ropp ``(f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))+ -(f2 x))/h+ -l2)``).
-Apply Rabsolu_4.
-Repeat Rewrite Rabsolu_mult.
-Apply Rlt_le_trans with ``eps/4+eps/4+eps/4+eps/4``.
-Cut ``(Rabsolu (/(f2 (x+h))))*(Rabsolu (((f1 (x+h))-(f1 x))/h-l1)) < eps/4``.
-Cut ``(Rabsolu (l1/((f2 x)*(f2 (x+h)))))*(Rabsolu ((f2 x)-(f2 (x+h)))) < eps/4``.
-Cut ``(Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))))*(Rabsolu (((f2 (x+h))-(f2 x))/h-l2)) < eps/4``.
-Cut ``(Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))))*(Rabsolu ((f2 (x+h))-(f2 x))) < eps/4``.
-Intros.
-Apply Rlt_4; Assumption.
-Rewrite <- Rabsolu_mult.
-Apply (maj_term4 x h eps l2 alp_f2 alp_f2c eps_f2 f1 f2); Try Assumption.
-Apply H2; Assumption.
-Apply Rmin_2; Assumption.
-Rewrite <- Rabsolu_mult.
-Apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); Try Assumption.
-Apply H2; Assumption.
-Apply Rmin_2; Assumption.
-Rewrite <- Rabsolu_mult.
-Apply (maj_term2 x h eps l1 alp_f2 alp_f2t2 eps_f2 f2); Try Assumption.
-Apply H2; Assumption.
-Apply Rmin_2; Assumption.
-Rewrite <- Rabsolu_mult.
-Apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); Try Assumption.
-Apply H2; Assumption.
-Apply Rmin_2; Assumption.
-Right; Symmetry; Apply quadruple_var.
-Apply H2; Assumption.
-Intros.
-Case (Req_EM a R0); Intro.
-Rewrite H18; Rewrite Rplus_Or; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply Rabsolu_pos_lt.
-Unfold Rdiv Rsqr; Rewrite Rinv_Rmult.
-Repeat Apply prod_neq_R0; Assumption Orelse (Apply Rinv_neq_R0; Assumption) Orelse (Apply Rinv_neq_R0; DiscrR) Orelse (Red; Intro H28; Rewrite H28 in H6; Elim (Rlt_antirefl ? H6)).
-Apply prod_neq_R0; [DiscrR | Assumption].
-Apply prod_neq_R0; [DiscrR | Assumption].
-Assumption.
-Elim H13; Intros.
-Apply H20.
-Split.
-Apply D_x_no_cond; Assumption.
-Replace ``x+a-x`` with a; [Assumption | Ring].
-Intros.
-Case (Req_EM a R0); Intro.
-Rewrite H18; Rewrite Rplus_Or; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply Rabsolu_pos_lt.
-Unfold Rdiv Rsqr; Rewrite Rinv_Rmult.
-Repeat Apply prod_neq_R0; Assumption Orelse (Apply Rinv_neq_R0; Assumption) Orelse (Apply Rinv_neq_R0; DiscrR) Orelse (Red; Intro H28; Rewrite H28 in H6; Elim (Rlt_antirefl ? H6)).
-DiscrR.
-Assumption.
-Elim H14; Intros.
-Apply H20.
-Split.
-Unfold D_x no_cond; Split.
-Trivial.
-Apply Rminus_not_eq_right.
-Replace ``x+a-x`` with a; [Assumption | Ring].
-Replace ``x+a-x`` with a; [Assumption | Ring].
-Repeat Apply Rmin_pos.
-Apply (cond_pos eps_f2).
-Elim H3; Intros; Assumption.
-Apply (cond_pos alp_f1d).
-Apply (cond_pos alp_f2d).
-Elim H13; Intros; Assumption.
-Elim H14; Intros; Assumption.
-Change ``0 < (Rabsolu ((eps*(Rsqr (f2 x)))/(8*l1)))``; Apply Rabsolu_pos_lt.
-Unfold Rdiv Rsqr; Rewrite Rinv_Rmult; Try DiscrR Orelse Assumption.
-Repeat Apply prod_neq_R0; Assumption Orelse (Apply Rinv_neq_R0; Assumption) Orelse (Apply Rinv_neq_R0; DiscrR) Orelse (Red; Intro H14; Rewrite H14 in H6; Elim (Rlt_antirefl ? H6)).
-Change ``0 < (Rabsolu (((Rsqr (f2 x))*(f2 x)*eps)/(8*(f1 x)*l2)))``; Apply Rabsolu_pos_lt.
-Unfold Rdiv Rsqr; Rewrite Rinv_Rmult.
-Repeat Apply prod_neq_R0; Assumption Orelse (Apply Rinv_neq_R0; Assumption) Orelse (Apply Rinv_neq_R0; DiscrR) Orelse (Red; Intro H13; Rewrite H13 in H6; Elim (Rlt_antirefl ? H6)).
-Apply prod_neq_R0; [DiscrR | Assumption].
-Apply prod_neq_R0; [DiscrR | Assumption].
-Assumption.
-Apply Rabsolu_pos_lt.
-Unfold Rdiv Rsqr; Rewrite Rinv_Rmult; [Idtac | DiscrR | Assumption].
-Repeat Apply prod_neq_R0; Assumption Orelse (Apply Rinv_neq_R0; Assumption) Orelse (Apply Rinv_neq_R0; DiscrR) Orelse (Red; Intro H11; Rewrite H11 in H6; Elim (Rlt_antirefl ? H6)).
-Intros.
-Unfold Rdiv.
-Apply Rlt_monotony_contra with ``(Rabsolu (f2 (x+a)))``.
-Apply Rabsolu_pos_lt; Apply H2.
-Apply Rlt_le_trans with (Rmin eps_f2 alp_f2).
-Assumption.
-Apply Rmin_l.
-Rewrite <- Rinv_r_sym.
-Apply Rlt_monotony_contra with (Rabsolu (f2 x)).
-Apply Rabsolu_pos_lt; Assumption.
-Rewrite Rmult_1r.
-Rewrite (Rmult_sym (Rabsolu (f2 x))).
-Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Apply Rlt_monotony_contra with ``/2``.
-Apply Rlt_Rinv; Sup0.
-Repeat Rewrite (Rmult_sym ``/2``).
-Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r.
-Unfold Rdiv in H5; Apply H5.
-Replace ``x+a-x`` with a.
-Assert H7 := (Rlt_le_trans ? ? ? H6 (Rmin_r ? ?)); Assumption.
-Ring.
-DiscrR.
-Apply Rabsolu_no_R0; Assumption.
-Apply Rabsolu_no_R0; Apply H2.
-Assert H7 := (Rlt_le_trans ? ? ? H6 (Rmin_l ? ?)); Assumption.
-Intros.
-Assert H6 := (H4 a H5).
-Rewrite <- (Rabsolu_Ropp ``(f2 a)-(f2 x)``) in H6.
-Rewrite Ropp_distr2 in H6.
-Assert H7 := (Rle_lt_trans ? ? ? (Rabsolu_triang_inv ? ?) H6).
-Apply Rlt_anti_compatibility with ``-(Rabsolu (f2 a)) + (Rabsolu (f2 x))/2``.
-Rewrite Rplus_assoc.
-Rewrite <- double_var.
-Do 2 Rewrite (Rplus_sym ``-(Rabsolu (f2 a))``).
-Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or.
-Unfold Rminus in H7; Assumption.
-Intros.
-Case (Req_EM x x0); Intro.
-Rewrite <- H5; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Unfold Rdiv; Apply Rmult_lt_pos; [Apply Rabsolu_pos_lt; Assumption | Apply Rlt_Rinv; Sup0].
-Elim H3; Intros.
-Apply H7.
-Split.
-Unfold D_x no_cond; Split.
-Trivial.
-Assumption.
-Assumption.
+elim (H0 (Rabs (Rsqr (f2 x) * eps / (8 * f1 x)))).
+intros alp_f2d H11.
+assert (H12 := derivable_continuous_pt _ _ X).
+unfold continuity_pt in H12.
+unfold continue_in in H12.
+unfold limit1_in in H12.
+unfold limit_in in H12.
+unfold dist in H12.
+simpl in H12.
+unfold R_dist in H12.
+elim (H12 (Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2)))).
+intros alp_f2c H13.
+elim (H12 (Rabs (eps * Rsqr (f2 x) / (8 * l1)))).
+intros alp_f2t2 H14.
+cut
+ (0 <
+ Rmin (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d))
+ (Rmin alp_f2c alp_f2t2)).
+intro.
+exists
+ (mkposreal
+ (Rmin (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d))
+ (Rmin alp_f2c alp_f2t2)) H15).
+simpl in |- *.
+intros.
+assert (H18 := Rlt_le_trans _ _ _ H17 (Rmin_l _ _)).
+assert (H19 := Rlt_le_trans _ _ _ H17 (Rmin_r _ _)).
+assert (H20 := Rlt_le_trans _ _ _ H18 (Rmin_l _ _)).
+assert (H21 := Rlt_le_trans _ _ _ H18 (Rmin_r _ _)).
+assert (H22 := Rlt_le_trans _ _ _ H19 (Rmin_l _ _)).
+assert (H23 := Rlt_le_trans _ _ _ H19 (Rmin_r _ _)).
+assert (H24 := Rlt_le_trans _ _ _ H20 (Rmin_l _ _)).
+assert (H25 := Rlt_le_trans _ _ _ H20 (Rmin_r _ _)).
+assert (H26 := Rlt_le_trans _ _ _ H21 (Rmin_l _ _)).
+assert (H27 := Rlt_le_trans _ _ _ H21 (Rmin_r _ _)).
+clear H17 H18 H19 H20 H21.
+cut
+ (forall a:R,
+ Rabs a < alp_f2t2 ->
+ Rabs (f2 (x + a) - f2 x) < Rabs (eps * Rsqr (f2 x) / (8 * l1))).
+cut
+ (forall a:R,
+ Rabs a < alp_f2c ->
+ Rabs (f2 (x + a) - f2 x) <
+ Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))).
+intros.
+rewrite formule; try assumption.
+apply Rle_lt_trans with
+ (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) +
+ Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) +
+ Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) +
+ Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))).
+unfold Rminus in |- *.
+rewrite <-
+ (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2)))
+ .
+apply Rabs_4.
+repeat rewrite Rabs_mult.
+apply Rlt_le_trans with (eps / 4 + eps / 4 + eps / 4 + eps / 4).
+cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4).
+cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4).
+cut
+ (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) <
+ eps / 4).
+cut
+ (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) <
+ eps / 4).
+intros.
+apply Rlt_4; assumption.
+rewrite <- Rabs_mult.
+apply (maj_term4 x h eps l2 alp_f2 alp_f2c eps_f2 f1 f2); try assumption.
+apply H2; assumption.
+apply Rmin_2; assumption.
+rewrite <- Rabs_mult.
+apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); try assumption.
+apply H2; assumption.
+apply Rmin_2; assumption.
+rewrite <- Rabs_mult.
+apply (maj_term2 x h eps l1 alp_f2 alp_f2t2 eps_f2 f2); try assumption.
+apply H2; assumption.
+apply Rmin_2; assumption.
+rewrite <- Rabs_mult.
+apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); try assumption.
+apply H2; assumption.
+apply Rmin_2; assumption.
+right; symmetry in |- *; apply quadruple_var.
+apply H2; assumption.
+intros.
+case (Req_dec a 0); intro.
+rewrite H18; rewrite Rplus_0_r; unfold Rminus in |- *; rewrite Rplus_opp_r;
+ rewrite Rabs_R0; apply Rabs_pos_lt.
+unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr.
+repeat apply prod_neq_R0;
+ assumption ||
+ (apply Rinv_neq_0_compat; assumption) ||
+ (apply Rinv_neq_0_compat; discrR) ||
+ (red in |- *; intro H28; rewrite H28 in H6; elim (Rlt_irrefl _ H6)).
+apply prod_neq_R0; [ discrR | assumption ].
+apply prod_neq_R0; [ discrR | assumption ].
+assumption.
+elim H13; intros.
+apply H20.
+split.
+apply D_x_no_cond; assumption.
+replace (x + a - x) with a; [ assumption | ring ].
+intros.
+case (Req_dec a 0); intro.
+rewrite H18; rewrite Rplus_0_r; unfold Rminus in |- *; rewrite Rplus_opp_r;
+ rewrite Rabs_R0; apply Rabs_pos_lt.
+unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr.
+repeat apply prod_neq_R0;
+ assumption ||
+ (apply Rinv_neq_0_compat; assumption) ||
+ (apply Rinv_neq_0_compat; discrR) ||
+ (red in |- *; intro H28; rewrite H28 in H6; elim (Rlt_irrefl _ H6)).
+discrR.
+assumption.
+elim H14; intros.
+apply H20.
+split.
+unfold D_x, no_cond in |- *; split.
+trivial.
+apply Rminus_not_eq_right.
+replace (x + a - x) with a; [ assumption | ring ].
+replace (x + a - x) with a; [ assumption | ring ].
+repeat apply Rmin_pos.
+apply (cond_pos eps_f2).
+elim H3; intros; assumption.
+apply (cond_pos alp_f1d).
+apply (cond_pos alp_f2d).
+elim H13; intros; assumption.
+elim H14; intros; assumption.
+change (0 < Rabs (eps * Rsqr (f2 x) / (8 * l1))) in |- *; apply Rabs_pos_lt.
+unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr; try discrR || assumption.
+repeat apply prod_neq_R0;
+ assumption ||
+ (apply Rinv_neq_0_compat; assumption) ||
+ (apply Rinv_neq_0_compat; discrR) ||
+ (red in |- *; intro H14; rewrite H14 in H6; elim (Rlt_irrefl _ H6)).
+change (0 < Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))) in |- *;
+ apply Rabs_pos_lt.
+unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr.
+repeat apply prod_neq_R0;
+ assumption ||
+ (apply Rinv_neq_0_compat; assumption) ||
+ (apply Rinv_neq_0_compat; discrR) ||
+ (red in |- *; intro H13; rewrite H13 in H6; elim (Rlt_irrefl _ H6)).
+apply prod_neq_R0; [ discrR | assumption ].
+apply prod_neq_R0; [ discrR | assumption ].
+assumption.
+apply Rabs_pos_lt.
+unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr;
+ [ idtac | discrR | assumption ].
+repeat apply prod_neq_R0;
+ assumption ||
+ (apply Rinv_neq_0_compat; assumption) ||
+ (apply Rinv_neq_0_compat; discrR) ||
+ (red in |- *; intro H11; rewrite H11 in H6; elim (Rlt_irrefl _ H6)).
+intros.
+unfold Rdiv in |- *.
+apply Rmult_lt_reg_l with (Rabs (f2 (x + a))).
+apply Rabs_pos_lt; apply H2.
+apply Rlt_le_trans with (Rmin eps_f2 alp_f2).
+assumption.
+apply Rmin_l.
+rewrite <- Rinv_r_sym.
+apply Rmult_lt_reg_l with (Rabs (f2 x)).
+apply Rabs_pos_lt; assumption.
+rewrite Rmult_1_r.
+rewrite (Rmult_comm (Rabs (f2 x))).
+repeat rewrite Rmult_assoc.
+rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r.
+apply Rmult_lt_reg_l with (/ 2).
+apply Rinv_0_lt_compat; prove_sup0.
+repeat rewrite (Rmult_comm (/ 2)).
+repeat rewrite Rmult_assoc.
+rewrite <- Rinv_r_sym.
+rewrite Rmult_1_r.
+unfold Rdiv in H5; apply H5.
+replace (x + a - x) with a.
+assert (H7 := Rlt_le_trans _ _ _ H6 (Rmin_r _ _)); assumption.
+ring.
+discrR.
+apply Rabs_no_R0; assumption.
+apply Rabs_no_R0; apply H2.
+assert (H7 := Rlt_le_trans _ _ _ H6 (Rmin_l _ _)); assumption.
+intros.
+assert (H6 := H4 a H5).
+rewrite <- (Rabs_Ropp (f2 a - f2 x)) in H6.
+rewrite Ropp_minus_distr in H6.
+assert (H7 := Rle_lt_trans _ _ _ (Rabs_triang_inv _ _) H6).
+apply Rplus_lt_reg_r with (- Rabs (f2 a) + Rabs (f2 x) / 2).
+rewrite Rplus_assoc.
+rewrite <- double_var.
+do 2 rewrite (Rplus_comm (- Rabs (f2 a))).
+rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r.
+unfold Rminus in H7; assumption.
+intros.
+case (Req_dec x x0); intro.
+rewrite <- H5; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+ unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ apply Rabs_pos_lt; assumption | apply Rinv_0_lt_compat; prove_sup0 ].
+elim H3; intros.
+apply H7.
+split.
+unfold D_x, no_cond in |- *; split.
+trivial.
+assumption.
+assumption.
Qed.
-Lemma derivable_pt_div : (f1,f2:R->R;x:R) (derivable_pt f1 x) -> (derivable_pt f2 x) -> ``(f2 x)<>0`` -> (derivable_pt (div_fct f1 f2) x).
-Unfold derivable_pt.
-Intros.
-Elim X; Intros.
-Elim X0; Intros.
-Apply Specif.existT with ``(x0*(f2 x)-x1*(f1 x))/(Rsqr (f2 x))``.
-Apply derivable_pt_lim_div; Assumption.
+Lemma derivable_pt_div :
+ forall (f1 f2:R -> R) (x:R),
+ derivable_pt f1 x ->
+ derivable_pt f2 x -> f2 x <> 0 -> derivable_pt (f1 / f2) x.
+unfold derivable_pt in |- *.
+intros.
+elim X; intros.
+elim X0; intros.
+apply existT with ((x0 * f2 x - x1 * f1 x) / Rsqr (f2 x)).
+apply derivable_pt_lim_div; assumption.
Qed.
-Lemma derivable_div : (f1,f2:R->R) (derivable f1) -> (derivable f2) -> ((x:R)``(f2 x)<>0``) -> (derivable (div_fct f1 f2)).
-Unfold derivable; Intros.
-Apply (derivable_pt_div ? ? ? (X x) (X0 x) (H x)).
+Lemma derivable_div :
+ forall f1 f2:R -> R,
+ derivable f1 ->
+ derivable f2 -> (forall x:R, f2 x <> 0) -> derivable (f1 / f2).
+unfold derivable in |- *; intros.
+apply (derivable_pt_div _ _ _ (X x) (X0 x) (H x)).
Qed.
-Lemma derive_pt_div : (f1,f2:R->R;x:R;pr1:(derivable_pt f1 x);pr2:(derivable_pt f2 x);na:``(f2 x)<>0``) ``(derive_pt (div_fct f1 f2) x (derivable_pt_div ? ? ? pr1 pr2 na)) == ((derive_pt f1 x pr1)*(f2 x)-(derive_pt f2 x pr2)*(f1 x))/(Rsqr (f2 x))``.
-Intros.
-Assert H := (derivable_derive f1 x pr1).
-Assert H0 := (derivable_derive f2 x pr2).
-Assert H1 := (derivable_derive (div_fct f1 f2) x (derivable_pt_div ? ? ? pr1 pr2 na)).
-Elim H; Clear H; Intros l1 H.
-Elim H0; Clear H0; Intros l2 H0.
-Elim H1; Clear H1; Intros l H1.
-Rewrite H; Rewrite H0; Apply derive_pt_eq_0.
-Assert H3 := (projT2 ? ? pr1).
-Unfold derive_pt in H; Rewrite H in H3.
-Assert H4 := (projT2 ? ? pr2).
-Unfold derive_pt in H0; Rewrite H0 in H4.
-Apply derivable_pt_lim_div; Assumption.
-Qed.
+Lemma derive_pt_div :
+ forall (f1 f2:R -> R) (x:R) (pr1:derivable_pt f1 x)
+ (pr2:derivable_pt f2 x) (na:f2 x <> 0),
+ derive_pt (f1 / f2) x (derivable_pt_div _ _ _ pr1 pr2 na) =
+ (derive_pt f1 x pr1 * f2 x - derive_pt f2 x pr2 * f1 x) / Rsqr (f2 x).
+intros.
+assert (H := derivable_derive f1 x pr1).
+assert (H0 := derivable_derive f2 x pr2).
+assert
+ (H1 := derivable_derive (f1 / f2)%F x (derivable_pt_div _ _ _ pr1 pr2 na)).
+elim H; clear H; intros l1 H.
+elim H0; clear H0; intros l2 H0.
+elim H1; clear H1; intros l H1.
+rewrite H; rewrite H0; apply derive_pt_eq_0.
+assert (H3 := projT2 pr1).
+unfold derive_pt in H; rewrite H in H3.
+assert (H4 := projT2 pr2).
+unfold derive_pt in H0; rewrite H0 in H4.
+apply derivable_pt_lim_div; assumption.
+Qed. \ No newline at end of file
diff --git a/theories/Reals/Ranalysis4.v b/theories/Reals/Ranalysis4.v
index 6db2609a9..16d478fe4 100644
--- a/theories/Reals/Ranalysis4.v
+++ b/theories/Reals/Ranalysis4.v
@@ -8,306 +8,377 @@
(*i $Id$ i*)
-Require Rbase.
-Require Rfunctions.
-Require SeqSeries.
-Require Rtrigo.
-Require Ranalysis1.
-Require Ranalysis3.
-Require Exp_prop.
-V7only [Import R_scope.]. Open Local Scope R_scope.
+Require Import Rbase.
+Require Import Rfunctions.
+Require Import SeqSeries.
+Require Import Rtrigo.
+Require Import Ranalysis1.
+Require Import Ranalysis3.
+Require Import Exp_prop. Open Local Scope R_scope.
(**********)
-Lemma derivable_pt_inv : (f:R->R;x:R) ``(f x)<>0`` -> (derivable_pt f x) -> (derivable_pt (inv_fct f) x).
-Intros; Cut (derivable_pt (div_fct (fct_cte R1) f) x) -> (derivable_pt (inv_fct f) x).
-Intro; Apply X0.
-Apply derivable_pt_div.
-Apply derivable_pt_const.
-Assumption.
-Assumption.
-Unfold div_fct inv_fct fct_cte; Intro; Elim X0; Intros; Unfold derivable_pt; Apply Specif.existT with x0; Unfold derivable_pt_abs; Unfold derivable_pt_lim; Unfold derivable_pt_abs in p; Unfold derivable_pt_lim in p; Intros; Elim (p eps H0); Intros; Exists x1; Intros; Unfold Rdiv in H1; Unfold Rdiv; Rewrite <- (Rmult_1l ``/(f x)``); Rewrite <- (Rmult_1l ``/(f (x+h))``).
-Apply H1; Assumption.
+Lemma derivable_pt_inv :
+ forall (f:R -> R) (x:R),
+ f x <> 0 -> derivable_pt f x -> derivable_pt (/ f) x.
+intros; cut (derivable_pt (fct_cte 1 / f) x -> derivable_pt (/ f) x).
+intro; apply X0.
+apply derivable_pt_div.
+apply derivable_pt_const.
+assumption.
+assumption.
+unfold div_fct, inv_fct, fct_cte in |- *; intro; elim X0; intros;
+ unfold derivable_pt in |- *; apply existT with x0;
+ unfold derivable_pt_abs in |- *; unfold derivable_pt_lim in |- *;
+ unfold derivable_pt_abs in p; unfold derivable_pt_lim in p;
+ intros; elim (p eps H0); intros; exists x1; intros;
+ unfold Rdiv in H1; unfold Rdiv in |- *; rewrite <- (Rmult_1_l (/ f x));
+ rewrite <- (Rmult_1_l (/ f (x + h))).
+apply H1; assumption.
Qed.
(**********)
-Lemma pr_nu_var : (f,g:R->R;x:R;pr1:(derivable_pt f x);pr2:(derivable_pt g x)) f==g -> (derive_pt f x pr1) == (derive_pt g x pr2).
-Unfold derivable_pt derive_pt; Intros.
-Elim pr1; Intros.
-Elim pr2; Intros.
-Simpl.
-Rewrite H in p.
-Apply unicite_limite with g x; Assumption.
+Lemma pr_nu_var :
+ forall (f g:R -> R) (x:R) (pr1:derivable_pt f x) (pr2:derivable_pt g x),
+ f = g -> derive_pt f x pr1 = derive_pt g x pr2.
+unfold derivable_pt, derive_pt in |- *; intros.
+elim pr1; intros.
+elim pr2; intros.
+simpl in |- *.
+rewrite H in p.
+apply uniqueness_limite with g x; assumption.
Qed.
(**********)
-Lemma pr_nu_var2 : (f,g:R->R;x:R;pr1:(derivable_pt f x);pr2:(derivable_pt g x)) ((h:R)(f h)==(g h)) -> (derive_pt f x pr1) == (derive_pt g x pr2).
-Unfold derivable_pt derive_pt; Intros.
-Elim pr1; Intros.
-Elim pr2; Intros.
-Simpl.
-Assert H0 := (unicite_step2 ? ? ? p).
-Assert H1 := (unicite_step2 ? ? ? p0).
-Cut (limit1_in [h:R]``((f (x+h))-(f x))/h`` [h:R]``h <> 0`` x1 ``0``).
-Intro; Assert H3 := (unicite_step1 ? ? ? ? H0 H2).
-Assumption.
-Unfold limit1_in; Unfold limit_in; Unfold dist; Simpl; Unfold R_dist; Unfold limit1_in in H1; Unfold limit_in in H1; Unfold dist in H1; Simpl in H1; Unfold R_dist in H1.
-Intros; Elim (H1 eps H2); Intros.
-Elim H3; Intros.
-Exists x2.
-Split.
-Assumption.
-Intros; Do 2 Rewrite H; Apply H5; Assumption.
+Lemma pr_nu_var2 :
+ forall (f g:R -> R) (x:R) (pr1:derivable_pt f x) (pr2:derivable_pt g x),
+ (forall h:R, f h = g h) -> derive_pt f x pr1 = derive_pt g x pr2.
+unfold derivable_pt, derive_pt in |- *; intros.
+elim pr1; intros.
+elim pr2; intros.
+simpl in |- *.
+assert (H0 := uniqueness_step2 _ _ _ p).
+assert (H1 := uniqueness_step2 _ _ _ p0).
+cut (limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) x1 0).
+intro; assert (H3 := uniqueness_step1 _ _ _ _ H0 H2).
+assumption.
+unfold limit1_in in |- *; unfold limit_in in |- *; unfold dist in |- *;
+ simpl in |- *; unfold R_dist in |- *; unfold limit1_in in H1;
+ unfold limit_in in H1; unfold dist in H1; simpl in H1;
+ unfold R_dist in H1.
+intros; elim (H1 eps H2); intros.
+elim H3; intros.
+exists x2.
+split.
+assumption.
+intros; do 2 rewrite H; apply H5; assumption.
Qed.
(**********)
-Lemma derivable_inv : (f:R->R) ((x:R)``(f x)<>0``)->(derivable f)->(derivable (inv_fct f)).
-Intros.
-Unfold derivable; Intro.
-Apply derivable_pt_inv.
-Apply (H x).
-Apply (X x).
+Lemma derivable_inv :
+ forall f:R -> R, (forall x:R, f x <> 0) -> derivable f -> derivable (/ f).
+intros.
+unfold derivable in |- *; intro.
+apply derivable_pt_inv.
+apply (H x).
+apply (X x).
Qed.
-Lemma derive_pt_inv : (f:R->R;x:R;pr:(derivable_pt f x);na:``(f x)<>0``) (derive_pt (inv_fct f) x (derivable_pt_inv f x na pr)) == ``-(derive_pt f x pr)/(Rsqr (f x))``.
-Intros; Replace (derive_pt (inv_fct f) x (derivable_pt_inv f x na pr)) with (derive_pt (div_fct (fct_cte R1) f) x (derivable_pt_div (fct_cte R1) f x (derivable_pt_const R1 x) pr na)).
-Rewrite derive_pt_div; Rewrite derive_pt_const; Unfold fct_cte; Rewrite Rmult_Ol; Rewrite Rmult_1r; Unfold Rminus; Rewrite Rplus_Ol; Reflexivity.
-Apply pr_nu_var2.
-Intro; Unfold div_fct fct_cte inv_fct.
-Unfold Rdiv; Ring.
+Lemma derive_pt_inv :
+ forall (f:R -> R) (x:R) (pr:derivable_pt f x) (na:f x <> 0),
+ derive_pt (/ f) x (derivable_pt_inv f x na pr) =
+ - derive_pt f x pr / Rsqr (f x).
+intros;
+ replace (derive_pt (/ f) x (derivable_pt_inv f x na pr)) with
+ (derive_pt (fct_cte 1 / f) x
+ (derivable_pt_div (fct_cte 1) f x (derivable_pt_const 1 x) pr na)).
+rewrite derive_pt_div; rewrite derive_pt_const; unfold fct_cte in |- *;
+ rewrite Rmult_0_l; rewrite Rmult_1_r; unfold Rminus in |- *;
+ rewrite Rplus_0_l; reflexivity.
+apply pr_nu_var2.
+intro; unfold div_fct, fct_cte, inv_fct in |- *.
+unfold Rdiv in |- *; ring.
Qed.
(* Rabsolu *)
-Lemma Rabsolu_derive_1 : (x:R) ``0<x`` -> (derivable_pt_lim Rabsolu x ``1``).
-Intros.
-Unfold derivable_pt_lim; Intros.
-Exists (mkposreal x H); Intros.
-Rewrite (Rabsolu_right x).
-Rewrite (Rabsolu_right ``x+h``).
-Rewrite Rplus_sym.
-Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_r.
-Rewrite Rplus_Or; Unfold Rdiv; Rewrite <- Rinv_r_sym.
-Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply H0.
-Apply H1.
-Apply Rle_sym1.
-Case (case_Rabsolu h); Intro.
-Rewrite (Rabsolu_left h r) in H2.
-Left; Rewrite Rplus_sym; Apply Rlt_anti_compatibility with ``-h``; Rewrite Rplus_Or; Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Apply H2.
-Apply ge0_plus_ge0_is_ge0.
-Left; Apply H.
-Apply Rle_sym2; Apply r.
-Left; Apply H.
+Lemma Rabs_derive_1 : forall x:R, 0 < x -> derivable_pt_lim Rabs x 1.
+intros.
+unfold derivable_pt_lim in |- *; intros.
+exists (mkposreal x H); intros.
+rewrite (Rabs_right x).
+rewrite (Rabs_right (x + h)).
+rewrite Rplus_comm.
+unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_r.
+rewrite Rplus_0_r; unfold Rdiv in |- *; rewrite <- Rinv_r_sym.
+rewrite Rplus_opp_r; rewrite Rabs_R0; apply H0.
+apply H1.
+apply Rle_ge.
+case (Rcase_abs h); intro.
+rewrite (Rabs_left h r) in H2.
+left; rewrite Rplus_comm; apply Rplus_lt_reg_r with (- h); rewrite Rplus_0_r;
+ rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l;
+ apply H2.
+apply Rplus_le_le_0_compat.
+left; apply H.
+apply Rge_le; apply r.
+left; apply H.
Qed.
-Lemma Rabsolu_derive_2 : (x:R) ``x<0`` -> (derivable_pt_lim Rabsolu x ``-1``).
-Intros.
-Unfold derivable_pt_lim; Intros.
-Cut ``0< -x``.
-Intro; Exists (mkposreal ``-x`` H1); Intros.
-Rewrite (Rabsolu_left x).
-Rewrite (Rabsolu_left ``x+h``).
-Rewrite Rplus_sym.
-Rewrite Ropp_distr1.
-Unfold Rminus; Rewrite Ropp_Ropp; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l.
-Rewrite Rplus_Or; Unfold Rdiv.
-Rewrite Ropp_mul1.
-Rewrite <- Rinv_r_sym.
-Rewrite Ropp_Ropp; Rewrite Rplus_Ropp_l; Rewrite Rabsolu_R0; Apply H0.
-Apply H2.
-Case (case_Rabsolu h); Intro.
-Apply Ropp_Rlt.
-Rewrite Ropp_O; Rewrite Ropp_distr1; Apply gt0_plus_gt0_is_gt0.
-Apply H1.
-Apply Rgt_RO_Ropp; Apply r.
-Rewrite (Rabsolu_right h r) in H3.
-Apply Rlt_anti_compatibility with ``-x``; Rewrite Rplus_Or; Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Apply H3.
-Apply H.
-Apply Rgt_RO_Ropp; Apply H.
+Lemma Rabs_derive_2 : forall x:R, x < 0 -> derivable_pt_lim Rabs x (-1).
+intros.
+unfold derivable_pt_lim in |- *; intros.
+cut (0 < - x).
+intro; exists (mkposreal (- x) H1); intros.
+rewrite (Rabs_left x).
+rewrite (Rabs_left (x + h)).
+rewrite Rplus_comm.
+rewrite Ropp_plus_distr.
+unfold Rminus in |- *; rewrite Ropp_involutive; rewrite Rplus_assoc;
+ rewrite Rplus_opp_l.
+rewrite Rplus_0_r; unfold Rdiv in |- *.
+rewrite Ropp_mult_distr_l_reverse.
+rewrite <- Rinv_r_sym.
+rewrite Ropp_involutive; rewrite Rplus_opp_l; rewrite Rabs_R0; apply H0.
+apply H2.
+case (Rcase_abs h); intro.
+apply Ropp_lt_cancel.
+rewrite Ropp_0; rewrite Ropp_plus_distr; apply Rplus_lt_0_compat.
+apply H1.
+apply Ropp_0_gt_lt_contravar; apply r.
+rewrite (Rabs_right h r) in H3.
+apply Rplus_lt_reg_r with (- x); rewrite Rplus_0_r; rewrite <- Rplus_assoc;
+ rewrite Rplus_opp_l; rewrite Rplus_0_l; apply H3.
+apply H.
+apply Ropp_0_gt_lt_contravar; apply H.
Qed.
(* Rabsolu is derivable for all x <> 0 *)
-Lemma derivable_pt_Rabsolu : (x:R) ``x<>0`` -> (derivable_pt Rabsolu x).
-Intros.
-Case (total_order_T x R0); Intro.
-Elim s; Intro.
-Unfold derivable_pt; Apply Specif.existT with ``-1``.
-Apply (Rabsolu_derive_2 x a).
-Elim H; Exact b.
-Unfold derivable_pt; Apply Specif.existT with ``1``.
-Apply (Rabsolu_derive_1 x r).
+Lemma Rderivable_pt_abs : forall x:R, x <> 0 -> derivable_pt Rabs x.
+intros.
+case (total_order_T x 0); intro.
+elim s; intro.
+unfold derivable_pt in |- *; apply existT with (-1).
+apply (Rabs_derive_2 x a).
+elim H; exact b.
+unfold derivable_pt in |- *; apply existT with 1.
+apply (Rabs_derive_1 x r).
Qed.
(* Rabsolu is continuous for all x *)
-Lemma continuity_Rabsolu : (continuity Rabsolu).
-Unfold continuity; Intro.
-Case (Req_EM x R0); Intro.
-Unfold continuity_pt; Unfold continue_in; Unfold limit1_in; Unfold limit_in; Simpl; Unfold R_dist; Intros; Exists eps; Split.
-Apply H0.
-Intros; Rewrite H; Rewrite Rabsolu_R0; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_Rabsolu; Elim H1; Intros; Rewrite H in H3; Unfold Rminus in H3; Rewrite Ropp_O in H3; Rewrite Rplus_Or in H3; Apply H3.
-Apply derivable_continuous_pt; Apply (derivable_pt_Rabsolu x H).
+Lemma Rcontinuity_abs : continuity Rabs.
+unfold continuity in |- *; intro.
+case (Req_dec x 0); intro.
+unfold continuity_pt in |- *; unfold continue_in in |- *;
+ unfold limit1_in in |- *; unfold limit_in in |- *;
+ simpl in |- *; unfold R_dist in |- *; intros; exists eps;
+ split.
+apply H0.
+intros; rewrite H; rewrite Rabs_R0; unfold Rminus in |- *; rewrite Ropp_0;
+ rewrite Rplus_0_r; rewrite Rabs_Rabsolu; elim H1;
+ intros; rewrite H in H3; unfold Rminus in H3; rewrite Ropp_0 in H3;
+ rewrite Rplus_0_r in H3; apply H3.
+apply derivable_continuous_pt; apply (Rderivable_pt_abs x H).
Qed.
(* Finite sums : Sum a_k x^k *)
-Lemma continuity_finite_sum : (An:nat->R;N:nat) (continuity [y:R](sum_f_R0 [k:nat]``(An k)*(pow y k)`` N)).
-Intros; Unfold continuity; Intro.
-Induction N.
-Simpl.
-Apply continuity_pt_const.
-Unfold constant; Intros; Reflexivity.
-Replace [y:R](sum_f_R0 [k:nat]``(An k)*(pow y k)`` (S N)) with (plus_fct [y:R](sum_f_R0 [k:nat]``(An k)*(pow y k)`` N) [y:R]``(An (S N))*(pow y (S N))``).
-Apply continuity_pt_plus.
-Apply HrecN.
-Replace [y:R]``(An (S N))*(pow y (S N))`` with (mult_real_fct (An (S N)) [y:R](pow y (S N))).
-Apply continuity_pt_scal.
-Apply derivable_continuous_pt.
-Apply derivable_pt_pow.
-Reflexivity.
-Reflexivity.
+Lemma continuity_finite_sum :
+ forall (An:nat -> R) (N:nat),
+ continuity (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N).
+intros; unfold continuity in |- *; intro.
+induction N as [| N HrecN].
+simpl in |- *.
+apply continuity_pt_const.
+unfold constant in |- *; intros; reflexivity.
+replace (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) (S N)) with
+ ((fun y:R => sum_f_R0 (fun k:nat => (An k * y ^ k)%R) N) +
+ (fun y:R => (An (S N) * y ^ S N)%R))%F.
+apply continuity_pt_plus.
+apply HrecN.
+replace (fun y:R => An (S N) * y ^ S N) with
+ (mult_real_fct (An (S N)) (fun y:R => y ^ S N)).
+apply continuity_pt_scal.
+apply derivable_continuous_pt.
+apply derivable_pt_pow.
+reflexivity.
+reflexivity.
Qed.
-Lemma derivable_pt_lim_fs : (An:nat->R;x:R;N:nat) (lt O N) -> (derivable_pt_lim [y:R](sum_f_R0 [k:nat]``(An k)*(pow y k)`` N) x (sum_f_R0 [k:nat]``(INR (S k))*(An (S k))*(pow x k)`` (pred N))).
-Intros; Induction N.
-Elim (lt_n_n ? H).
-Cut N=O\/(lt O N).
-Intro; Elim H0; Intro.
-Rewrite H1.
-Simpl.
-Replace [y:R]``(An O)*1+(An (S O))*(y*1)`` with (plus_fct (fct_cte ``(An O)*1``) (mult_real_fct ``(An (S O))`` (mult_fct id (fct_cte R1)))).
-Replace ``1*(An (S O))*1`` with ``0+(An (S O))*(1*(fct_cte R1 x)+(id x)*0)``.
-Apply derivable_pt_lim_plus.
-Apply derivable_pt_lim_const.
-Apply derivable_pt_lim_scal.
-Apply derivable_pt_lim_mult.
-Apply derivable_pt_lim_id.
-Apply derivable_pt_lim_const.
-Unfold fct_cte id; Ring.
-Reflexivity.
-Replace [y:R](sum_f_R0 [k:nat]``(An k)*(pow y k)`` (S N)) with (plus_fct [y:R](sum_f_R0 [k:nat]``(An k)*(pow y k)`` N) [y:R]``(An (S N))*(pow y (S N))``).
-Replace (sum_f_R0 [k:nat]``(INR (S k))*(An (S k))*(pow x k)`` (pred (S N))) with (Rplus (sum_f_R0 [k:nat]``(INR (S k))*(An (S k))*(pow x k)`` (pred N)) ``(An (S N))*((INR (S (pred (S N))))*(pow x (pred (S N))))``).
-Apply derivable_pt_lim_plus.
-Apply HrecN.
-Assumption.
-Replace [y:R]``(An (S N))*(pow y (S N))`` with (mult_real_fct (An (S N)) [y:R](pow y (S N))).
-Apply derivable_pt_lim_scal.
-Replace (pred (S N)) with N; [Idtac | Reflexivity].
-Pattern 3 N; Replace N with (pred (S N)).
-Apply derivable_pt_lim_pow.
-Reflexivity.
-Reflexivity.
-Cut (pred (S N)) = (S (pred N)).
-Intro; Rewrite H2.
-Rewrite tech5.
-Apply Rplus_plus_r.
-Rewrite <- H2.
-Replace (pred (S N)) with N; [Idtac | Reflexivity].
-Ring.
-Simpl.
-Apply S_pred with O; Assumption.
-Unfold plus_fct.
-Simpl; Reflexivity.
-Inversion H.
-Left; Reflexivity.
-Right; Apply lt_le_trans with (1); [Apply lt_O_Sn | Assumption].
+Lemma derivable_pt_lim_fs :
+ forall (An:nat -> R) (x:R) (N:nat),
+ (0 < N)%nat ->
+ derivable_pt_lim (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N) x
+ (sum_f_R0 (fun k:nat => INR (S k) * An (S k) * x ^ k) (pred N)).
+intros; induction N as [| N HrecN].
+elim (lt_irrefl _ H).
+cut (N = 0%nat \/ (0 < N)%nat).
+intro; elim H0; intro.
+rewrite H1.
+simpl in |- *.
+replace (fun y:R => An 0%nat * 1 + An 1%nat * (y * 1)) with
+ (fct_cte (An 0%nat * 1) + mult_real_fct (An 1%nat) (id * fct_cte 1))%F.
+replace (1 * An 1%nat * 1) with (0 + An 1%nat * (1 * fct_cte 1 x + id x * 0)).
+apply derivable_pt_lim_plus.
+apply derivable_pt_lim_const.
+apply derivable_pt_lim_scal.
+apply derivable_pt_lim_mult.
+apply derivable_pt_lim_id.
+apply derivable_pt_lim_const.
+unfold fct_cte, id in |- *; ring.
+reflexivity.
+replace (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) (S N)) with
+ ((fun y:R => sum_f_R0 (fun k:nat => (An k * y ^ k)%R) N) +
+ (fun y:R => (An (S N) * y ^ S N)%R))%F.
+replace (sum_f_R0 (fun k:nat => INR (S k) * An (S k) * x ^ k) (pred (S N)))
+ with
+ (sum_f_R0 (fun k:nat => INR (S k) * An (S k) * x ^ k) (pred N) +
+ An (S N) * (INR (S (pred (S N))) * x ^ pred (S N))).
+apply derivable_pt_lim_plus.
+apply HrecN.
+assumption.
+replace (fun y:R => An (S N) * y ^ S N) with
+ (mult_real_fct (An (S N)) (fun y:R => y ^ S N)).
+apply derivable_pt_lim_scal.
+replace (pred (S N)) with N; [ idtac | reflexivity ].
+pattern N at 3 in |- *; replace N with (pred (S N)).
+apply derivable_pt_lim_pow.
+reflexivity.
+reflexivity.
+cut (pred (S N) = S (pred N)).
+intro; rewrite H2.
+rewrite tech5.
+apply Rplus_eq_compat_l.
+rewrite <- H2.
+replace (pred (S N)) with N; [ idtac | reflexivity ].
+ring.
+simpl in |- *.
+apply S_pred with 0%nat; assumption.
+unfold plus_fct in |- *.
+simpl in |- *; reflexivity.
+inversion H.
+left; reflexivity.
+right; apply lt_le_trans with 1%nat; [ apply lt_O_Sn | assumption ].
Qed.
-Lemma derivable_pt_lim_finite_sum : (An:(nat->R); x:R; N:nat) (derivable_pt_lim [y:R](sum_f_R0 [k:nat]``(An k)*(pow y k)`` N) x (Cases N of O => R0 | _ => (sum_f_R0 [k:nat]``(INR (S k))*(An (S k))*(pow x k)`` (pred N)) end)).
-Intros.
-Induction N.
-Simpl.
-Rewrite Rmult_1r.
-Replace [_:R]``(An O)`` with (fct_cte (An O)); [Apply derivable_pt_lim_const | Reflexivity].
-Apply derivable_pt_lim_fs; Apply lt_O_Sn.
+Lemma derivable_pt_lim_finite_sum :
+ forall (An:nat -> R) (x:R) (N:nat),
+ derivable_pt_lim (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N) x
+ match N with
+ | O => 0
+ | _ => sum_f_R0 (fun k:nat => INR (S k) * An (S k) * x ^ k) (pred N)
+ end.
+intros.
+induction N as [| N HrecN].
+simpl in |- *.
+rewrite Rmult_1_r.
+replace (fun _:R => An 0%nat) with (fct_cte (An 0%nat));
+ [ apply derivable_pt_lim_const | reflexivity ].
+apply derivable_pt_lim_fs; apply lt_O_Sn.
Qed.
-Lemma derivable_pt_finite_sum : (An:nat->R;N:nat;x:R) (derivable_pt [y:R](sum_f_R0 [k:nat]``(An k)*(pow y k)`` N) x).
-Intros.
-Unfold derivable_pt.
-Assert H := (derivable_pt_lim_finite_sum An x N).
-Induction N.
-Apply Specif.existT with R0; Apply H.
-Apply Specif.existT with (sum_f_R0 [k:nat]``(INR (S k))*(An (S k))*(pow x k)`` (pred (S N))); Apply H.
+Lemma derivable_pt_finite_sum :
+ forall (An:nat -> R) (N:nat) (x:R),
+ derivable_pt (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N) x.
+intros.
+unfold derivable_pt in |- *.
+assert (H := derivable_pt_lim_finite_sum An x N).
+induction N as [| N HrecN].
+apply existT with 0; apply H.
+apply existT with
+ (sum_f_R0 (fun k:nat => INR (S k) * An (S k) * x ^ k) (pred (S N)));
+ apply H.
Qed.
-Lemma derivable_finite_sum : (An:nat->R;N:nat) (derivable [y:R](sum_f_R0 [k:nat]``(An k)*(pow y k)`` N)).
-Intros; Unfold derivable; Intro; Apply derivable_pt_finite_sum.
+Lemma derivable_finite_sum :
+ forall (An:nat -> R) (N:nat),
+ derivable (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N).
+intros; unfold derivable in |- *; intro; apply derivable_pt_finite_sum.
Qed.
(* Regularity of hyperbolic functions *)
-Lemma derivable_pt_lim_cosh : (x:R) (derivable_pt_lim cosh x ``(sinh x)``).
-Intro.
-Unfold cosh sinh; Unfold Rdiv.
-Replace [x0:R]``((exp x0)+(exp ( -x0)))*/2`` with (mult_fct (plus_fct exp (comp exp (opp_fct id))) (fct_cte ``/2``)); [Idtac | Reflexivity].
-Replace ``((exp x)-(exp ( -x)))*/2`` with ``((exp x)+((exp (-x))*-1))*((fct_cte (Rinv 2)) x)+((plus_fct exp (comp exp (opp_fct id))) x)*0``.
-Apply derivable_pt_lim_mult.
-Apply derivable_pt_lim_plus.
-Apply derivable_pt_lim_exp.
-Apply derivable_pt_lim_comp.
-Apply derivable_pt_lim_opp.
-Apply derivable_pt_lim_id.
-Apply derivable_pt_lim_exp.
-Apply derivable_pt_lim_const.
-Unfold plus_fct mult_real_fct comp opp_fct id fct_cte; Ring.
+Lemma derivable_pt_lim_cosh : forall x:R, derivable_pt_lim cosh x (sinh x).
+intro.
+unfold cosh, sinh in |- *; unfold Rdiv in |- *.
+replace (fun x0:R => (exp x0 + exp (- x0)) * / 2) with
+ ((exp + comp exp (- id)) * fct_cte (/ 2))%F; [ idtac | reflexivity ].
+replace ((exp x - exp (- x)) * / 2) with
+ ((exp x + exp (- x) * -1) * fct_cte (/ 2) x +
+ (exp + comp exp (- id))%F x * 0).
+apply derivable_pt_lim_mult.
+apply derivable_pt_lim_plus.
+apply derivable_pt_lim_exp.
+apply derivable_pt_lim_comp.
+apply derivable_pt_lim_opp.
+apply derivable_pt_lim_id.
+apply derivable_pt_lim_exp.
+apply derivable_pt_lim_const.
+unfold plus_fct, mult_real_fct, comp, opp_fct, id, fct_cte in |- *; ring.
Qed.
-Lemma derivable_pt_lim_sinh : (x:R) (derivable_pt_lim sinh x ``(cosh x)``).
-Intro.
-Unfold cosh sinh; Unfold Rdiv.
-Replace [x0:R]``((exp x0)-(exp ( -x0)))*/2`` with (mult_fct (minus_fct exp (comp exp (opp_fct id))) (fct_cte ``/2``)); [Idtac | Reflexivity].
-Replace ``((exp x)+(exp ( -x)))*/2`` with ``((exp x)-((exp (-x))*-1))*((fct_cte (Rinv 2)) x)+((minus_fct exp (comp exp (opp_fct id))) x)*0``.
-Apply derivable_pt_lim_mult.
-Apply derivable_pt_lim_minus.
-Apply derivable_pt_lim_exp.
-Apply derivable_pt_lim_comp.
-Apply derivable_pt_lim_opp.
-Apply derivable_pt_lim_id.
-Apply derivable_pt_lim_exp.
-Apply derivable_pt_lim_const.
-Unfold plus_fct mult_real_fct comp opp_fct id fct_cte; Ring.
+Lemma derivable_pt_lim_sinh : forall x:R, derivable_pt_lim sinh x (cosh x).
+intro.
+unfold cosh, sinh in |- *; unfold Rdiv in |- *.
+replace (fun x0:R => (exp x0 - exp (- x0)) * / 2) with
+ ((exp - comp exp (- id)) * fct_cte (/ 2))%F; [ idtac | reflexivity ].
+replace ((exp x + exp (- x)) * / 2) with
+ ((exp x - exp (- x) * -1) * fct_cte (/ 2) x +
+ (exp - comp exp (- id))%F x * 0).
+apply derivable_pt_lim_mult.
+apply derivable_pt_lim_minus.
+apply derivable_pt_lim_exp.
+apply derivable_pt_lim_comp.
+apply derivable_pt_lim_opp.
+apply derivable_pt_lim_id.
+apply derivable_pt_lim_exp.
+apply derivable_pt_lim_const.
+unfold plus_fct, mult_real_fct, comp, opp_fct, id, fct_cte in |- *; ring.
Qed.
-Lemma derivable_pt_exp : (x:R) (derivable_pt exp x).
-Intro.
-Unfold derivable_pt.
-Apply Specif.existT with (exp x).
-Apply derivable_pt_lim_exp.
+Lemma derivable_pt_exp : forall x:R, derivable_pt exp x.
+intro.
+unfold derivable_pt in |- *.
+apply existT with (exp x).
+apply derivable_pt_lim_exp.
Qed.
-Lemma derivable_pt_cosh : (x:R) (derivable_pt cosh x).
-Intro.
-Unfold derivable_pt.
-Apply Specif.existT with (sinh x).
-Apply derivable_pt_lim_cosh.
+Lemma derivable_pt_cosh : forall x:R, derivable_pt cosh x.
+intro.
+unfold derivable_pt in |- *.
+apply existT with (sinh x).
+apply derivable_pt_lim_cosh.
Qed.
-Lemma derivable_pt_sinh : (x:R) (derivable_pt sinh x).
-Intro.
-Unfold derivable_pt.
-Apply Specif.existT with (cosh x).
-Apply derivable_pt_lim_sinh.
+Lemma derivable_pt_sinh : forall x:R, derivable_pt sinh x.
+intro.
+unfold derivable_pt in |- *.
+apply existT with (cosh x).
+apply derivable_pt_lim_sinh.
Qed.
-Lemma derivable_exp : (derivable exp).
-Unfold derivable; Apply derivable_pt_exp.
+Lemma derivable_exp : derivable exp.
+unfold derivable in |- *; apply derivable_pt_exp.
Qed.
-Lemma derivable_cosh : (derivable cosh).
-Unfold derivable; Apply derivable_pt_cosh.
+Lemma derivable_cosh : derivable cosh.
+unfold derivable in |- *; apply derivable_pt_cosh.
Qed.
-Lemma derivable_sinh : (derivable sinh).
-Unfold derivable; Apply derivable_pt_sinh.
+Lemma derivable_sinh : derivable sinh.
+unfold derivable in |- *; apply derivable_pt_sinh.
Qed.
-Lemma derive_pt_exp : (x:R) (derive_pt exp x (derivable_pt_exp x))==(exp x).
-Intro; Apply derive_pt_eq_0.
-Apply derivable_pt_lim_exp.
+Lemma derive_pt_exp :
+ forall x:R, derive_pt exp x (derivable_pt_exp x) = exp x.
+intro; apply derive_pt_eq_0.
+apply derivable_pt_lim_exp.
Qed.
-Lemma derive_pt_cosh : (x:R) (derive_pt cosh x (derivable_pt_cosh x))==(sinh x).
-Intro; Apply derive_pt_eq_0.
-Apply derivable_pt_lim_cosh.
+Lemma derive_pt_cosh :
+ forall x:R, derive_pt cosh x (derivable_pt_cosh x) = sinh x.
+intro; apply derive_pt_eq_0.
+apply derivable_pt_lim_cosh.
Qed.
-Lemma derive_pt_sinh : (x:R) (derive_pt sinh x (derivable_pt_sinh x))==(cosh x).
-Intro; Apply derive_pt_eq_0.
-Apply derivable_pt_lim_sinh.
-Qed.
+Lemma derive_pt_sinh :
+ forall x:R, derive_pt sinh x (derivable_pt_sinh x) = cosh x.
+intro; apply derive_pt_eq_0.
+apply derivable_pt_lim_sinh.
+Qed. \ No newline at end of file
diff --git a/theories/Reals/Raxioms.v b/theories/Reals/Raxioms.v
index 4516a206f..a047c78c0 100644
--- a/theories/Reals/Raxioms.v
+++ b/theories/Reals/Raxioms.v
@@ -13,23 +13,8 @@
(*********************************************************)
Require Export ZArith_base.
-Require Export Rsyntax.
-V7only [Import R_scope.]. Open Local Scope R_scope.
+Require Export Rsyntax. Open Local Scope R_scope.
-V7only [
-(*********************************************************)
-(* Compatibility *)
-(*********************************************************)
-Notation sumboolT := Specif.sumbool.
-Notation leftT := Specif.left.
-Notation rightT := Specif.right.
-Notation sumorT := Specif.sumor.
-Notation inleftT := Specif.inleft.
-Notation inrightT := Specif.inright.
-Notation sigTT := Specif.sigT.
-Notation existTT := Specif.existT.
-Notation SigT := Specif.sigT.
-].
(*********************************************************)
(* Field axioms *)
@@ -40,52 +25,53 @@ Notation SigT := Specif.sigT.
(*********************************************************)
(**********)
-Axiom Rplus_sym:(r1,r2:R)``r1+r2==r2+r1``.
-Hints Resolve Rplus_sym : real.
+Axiom Rplus_comm : forall r1 r2:R, r1 + r2 = r2 + r1.
+Hint Resolve Rplus_comm: real.
(**********)
-Axiom Rplus_assoc:(r1,r2,r3:R)``(r1+r2)+r3==r1+(r2+r3)``.
-Hints Resolve Rplus_assoc : real.
+Axiom Rplus_assoc : forall r1 r2 r3:R, r1 + r2 + r3 = r1 + (r2 + r3).
+Hint Resolve Rplus_assoc: real.
(**********)
-Axiom Rplus_Ropp_r:(r:R)``r+(-r)==0``.
-Hints Resolve Rplus_Ropp_r : real v62.
+Axiom Rplus_opp_r : forall r:R, r + - r = 0.
+Hint Resolve Rplus_opp_r: real v62.
(**********)
-Axiom Rplus_Ol:(r:R)``0+r==r``.
-Hints Resolve Rplus_Ol : real.
+Axiom Rplus_0_l : forall r:R, 0 + r = r.
+Hint Resolve Rplus_0_l: real.
(***********************************************************)
(** Multiplication *)
(***********************************************************)
(**********)
-Axiom Rmult_sym:(r1,r2:R)``r1*r2==r2*r1``.
-Hints Resolve Rmult_sym : real v62.
+Axiom Rmult_comm : forall r1 r2:R, r1 * r2 = r2 * r1.
+Hint Resolve Rmult_comm: real v62.
(**********)
-Axiom Rmult_assoc:(r1,r2,r3:R)``(r1*r2)*r3==r1*(r2*r3)``.
-Hints Resolve Rmult_assoc : real v62.
+Axiom Rmult_assoc : forall r1 r2 r3:R, r1 * r2 * r3 = r1 * (r2 * r3).
+Hint Resolve Rmult_assoc: real v62.
(**********)
-Axiom Rinv_l:(r:R)``r<>0``->``(/r)*r==1``.
-Hints Resolve Rinv_l : real.
+Axiom Rinv_l : forall r:R, r <> 0 -> / r * r = 1.
+Hint Resolve Rinv_l: real.
(**********)
-Axiom Rmult_1l:(r:R)``1*r==r``.
-Hints Resolve Rmult_1l : real.
+Axiom Rmult_1_l : forall r:R, 1 * r = r.
+Hint Resolve Rmult_1_l: real.
(**********)
-Axiom R1_neq_R0:``1<>0``.
-Hints Resolve R1_neq_R0 : real.
+Axiom R1_neq_R0 : 1 <> 0.
+Hint Resolve R1_neq_R0: real.
(*********************************************************)
(** Distributivity *)
(*********************************************************)
(**********)
-Axiom Rmult_Rplus_distr:(r1,r2,r3:R)``r1*(r2+r3)==(r1*r2)+(r1*r3)``.
-Hints Resolve Rmult_Rplus_distr : real v62.
+Axiom
+ Rmult_plus_distr_l : forall r1 r2 r3:R, r1 * (r2 + r3) = r1 * r2 + r1 * r3.
+Hint Resolve Rmult_plus_distr_l: real v62.
(*********************************************************)
(** Order axioms *)
@@ -95,37 +81,38 @@ Hints Resolve Rmult_Rplus_distr : real v62.
(*********************************************************)
(**********)
-Axiom total_order_T:(r1,r2:R)(sumorT (sumboolT ``r1<r2`` r1==r2) ``r1>r2``).
+Axiom total_order_T : forall r1 r2:R, {r1 < r2} + {r1 = r2} + {r1 > r2}.
(*********************************************************)
(** Lower *)
(*********************************************************)
(**********)
-Axiom Rlt_antisym:(r1,r2:R)``r1<r2`` -> ~ ``r2<r1``.
+Axiom Rlt_asym : forall r1 r2:R, r1 < r2 -> ~ r2 < r1.
(**********)
-Axiom Rlt_trans:(r1,r2,r3:R)
- ``r1<r2``->``r2<r3``->``r1<r3``.
+Axiom Rlt_trans : forall r1 r2 r3:R, r1 < r2 -> r2 < r3 -> r1 < r3.
(**********)
-Axiom Rlt_compatibility:(r,r1,r2:R)``r1<r2``->``r+r1<r+r2``.
+Axiom Rplus_lt_compat_l : forall r r1 r2:R, r1 < r2 -> r + r1 < r + r2.
(**********)
-Axiom Rlt_monotony:(r,r1,r2:R)``0<r``->``r1<r2``->``r*r1<r*r2``.
+Axiom
+ Rmult_lt_compat_l : forall r r1 r2:R, 0 < r -> r1 < r2 -> r * r1 < r * r2.
-Hints Resolve Rlt_antisym Rlt_compatibility Rlt_monotony : real.
+Hint Resolve Rlt_asym Rplus_lt_compat_l Rmult_lt_compat_l: real.
(**********************************************************)
(** Injection from N to R *)
(**********************************************************)
(**********)
-Fixpoint INR [n:nat]:R:=(Cases n of
- O => ``0``
- |(S O) => ``1``
- |(S n) => ``(INR n)+1``
- end).
+Fixpoint INR (n:nat) : R :=
+ match n with
+ | O => 0
+ | S O => 1
+ | S n => INR n + 1
+ end.
Arguments Scope INR [nat_scope].
@@ -134,11 +121,12 @@ Arguments Scope INR [nat_scope].
(**********************************************************)
(**********)
-Definition IZR:Z->R:=[z:Z](Cases z of
- ZERO => ``0``
- |(POS n) => (INR (convert n))
- |(NEG n) => ``-(INR (convert n))``
- end).
+Definition IZR (z:Z) : R :=
+ match z with
+ | Z0 => 0
+ | Zpos n => INR (nat_of_P n)
+ | Zneg n => - INR (nat_of_P n)
+ end.
Arguments Scope IZR [Z_scope].
(**********************************************************)
@@ -146,24 +134,24 @@ Arguments Scope IZR [Z_scope].
(**********************************************************)
(**********)
-Axiom archimed:(r:R)``(IZR (up r)) > r``/\``(IZR (up r))-r <= 1``.
+Axiom archimed : forall r:R, IZR (up r) > r /\ IZR (up r) - r <= 1.
(**********************************************************)
(** [R] Complete *)
(**********************************************************)
(**********)
-Definition is_upper_bound:=[E:R->Prop][m:R](x:R)(E x)->``x <= m``.
+Definition is_upper_bound (E:R -> Prop) (m:R) := forall x:R, E x -> x <= m.
(**********)
-Definition bound:=[E:R->Prop](ExT [m:R](is_upper_bound E m)).
+Definition bound (E:R -> Prop) := exists m : R | is_upper_bound E m.
(**********)
-Definition is_lub:=[E:R->Prop][m:R]
- (is_upper_bound E m)/\(b:R)(is_upper_bound E b)->``m <= b``.
+Definition is_lub (E:R -> Prop) (m:R) :=
+ is_upper_bound E m /\ (forall b:R, is_upper_bound E b -> m <= b).
(**********)
-Axiom complet:(E:R->Prop)(bound E)->
- (ExT [x:R] (E x))->
- (sigTT R [m:R](is_lub E m)).
-
+Axiom
+ completeness :
+ forall E:R -> Prop,
+ bound E -> ( exists x : R | E x) -> sigT (fun m:R => is_lub E m).
diff --git a/theories/Reals/Rbase.v b/theories/Reals/Rbase.v
index 1df44bbf5..f1e17e305 100644
--- a/theories/Reals/Rbase.v
+++ b/theories/Reals/Rbase.v
@@ -11,4 +11,4 @@
Require Export Rdefinitions.
Require Export Raxioms.
Require Export RIneq.
-Require Export DiscrR.
+Require Export DiscrR. \ No newline at end of file
diff --git a/theories/Reals/Rbasic_fun.v b/theories/Reals/Rbasic_fun.v
index c586acdca..d5b090677 100644
--- a/theories/Reals/Rbasic_fun.v
+++ b/theories/Reals/Rbasic_fun.v
@@ -13,69 +13,68 @@
(* *)
(*********************************************************)
-Require Rbase.
-Require R_Ifp.
-Require Fourier.
-V7only [Import R_scope.]. Open Local Scope R_scope.
+Require Import Rbase.
+Require Import R_Ifp.
+Require Import Fourier. Open Local Scope R_scope.
-Implicit Variable Type r:R.
+Implicit Type r : R.
(*******************************)
(** Rmin *)
(*******************************)
(*********)
-Definition Rmin :R->R->R:=[x,y:R]
- Cases (total_order_Rle x y) of
- (leftT _) => x
- | (rightT _) => y
+Definition Rmin (x y:R) : R :=
+ match Rle_dec x y with
+ | left _ => x
+ | right _ => y
end.
(*********)
-Lemma Rmin_Rgt_l:(r1,r2,r:R)(Rgt (Rmin r1 r2) r) ->
- ((Rgt r1 r)/\(Rgt r2 r)).
-Intros r1 r2 r;Unfold Rmin;Case (total_order_Rle r1 r2);Intros.
-Split.
-Assumption.
-Unfold Rgt;Unfold Rgt in H;Exact (Rlt_le_trans r r1 r2 H r0).
-Split.
-Generalize (not_Rle r1 r2 n);Intro;Exact (Rgt_trans r1 r2 r H0 H).
-Assumption.
+Lemma Rmin_Rgt_l : forall r1 r2 r, Rmin r1 r2 > r -> r1 > r /\ r2 > r.
+intros r1 r2 r; unfold Rmin in |- *; case (Rle_dec r1 r2); intros.
+split.
+assumption.
+unfold Rgt in |- *; unfold Rgt in H; exact (Rlt_le_trans r r1 r2 H r0).
+split.
+generalize (Rnot_le_lt r1 r2 n); intro; exact (Rgt_trans r1 r2 r H0 H).
+assumption.
Qed.
(*********)
-Lemma Rmin_Rgt_r:(r1,r2,r:R)(((Rgt r1 r)/\(Rgt r2 r)) ->
- (Rgt (Rmin r1 r2) r)).
-Intros;Unfold Rmin;Case (total_order_Rle r1 r2);Elim H;Clear H;Intros;
- Assumption.
+Lemma Rmin_Rgt_r : forall r1 r2 r, r1 > r /\ r2 > r -> Rmin r1 r2 > r.
+intros; unfold Rmin in |- *; case (Rle_dec r1 r2); elim H; clear H; intros;
+ assumption.
Qed.
(*********)
-Lemma Rmin_Rgt:(r1,r2,r:R)(Rgt (Rmin r1 r2) r)<->
- ((Rgt r1 r)/\(Rgt r2 r)).
-Intros; Split.
-Exact (Rmin_Rgt_l r1 r2 r).
-Exact (Rmin_Rgt_r r1 r2 r).
+Lemma Rmin_Rgt : forall r1 r2 r, Rmin r1 r2 > r <-> r1 > r /\ r2 > r.
+intros; split.
+exact (Rmin_Rgt_l r1 r2 r).
+exact (Rmin_Rgt_r r1 r2 r).
Qed.
(*********)
-Lemma Rmin_l : (x,y:R) ``(Rmin x y)<=x``.
-Intros; Unfold Rmin; Case (total_order_Rle x y); Intro H1; [Right; Reflexivity | Auto with real].
+Lemma Rmin_l : forall x y:R, Rmin x y <= x.
+intros; unfold Rmin in |- *; case (Rle_dec x y); intro H1;
+ [ right; reflexivity | auto with real ].
Qed.
(*********)
-Lemma Rmin_r : (x,y:R) ``(Rmin x y)<=y``.
-Intros; Unfold Rmin; Case (total_order_Rle x y); Intro H1; [Assumption | Auto with real].
+Lemma Rmin_r : forall x y:R, Rmin x y <= y.
+intros; unfold Rmin in |- *; case (Rle_dec x y); intro H1;
+ [ assumption | auto with real ].
Qed.
(*********)
-Lemma Rmin_sym : (a,b:R) (Rmin a b)==(Rmin b a).
-Intros; Unfold Rmin; Case (total_order_Rle a b); Case (total_order_Rle b a); Intros; Try Reflexivity Orelse (Apply Rle_antisym; Assumption Orelse Auto with real).
+Lemma Rmin_comm : forall a b:R, Rmin a b = Rmin b a.
+intros; unfold Rmin in |- *; case (Rle_dec a b); case (Rle_dec b a); intros;
+ try reflexivity || (apply Rle_antisym; assumption || auto with real).
Qed.
(*********)
-Lemma Rmin_stable_in_posreal : (x,y:posreal) ``0<(Rmin x y)``.
-Intros; Apply Rmin_Rgt_r; Split; [Apply (cond_pos x) | Apply (cond_pos y)].
+Lemma Rmin_stable_in_posreal : forall x y:posreal, 0 < Rmin x y.
+intros; apply Rmin_Rgt_r; split; [ apply (cond_pos x) | apply (cond_pos y) ].
Qed.
(*******************************)
@@ -83,54 +82,52 @@ Qed.
(*******************************)
(*********)
-Definition Rmax :R->R->R:=[x,y:R]
- Cases (total_order_Rle x y) of
- (leftT _) => y
- | (rightT _) => x
+Definition Rmax (x y:R) : R :=
+ match Rle_dec x y with
+ | left _ => y
+ | right _ => x
end.
(*********)
-Lemma Rmax_Rle:(r1,r2,r:R)(Rle r (Rmax r1 r2))<->
- ((Rle r r1)\/(Rle r r2)).
-Intros;Split.
-Unfold Rmax;Case (total_order_Rle r1 r2);Intros;Auto.
-Intro;Unfold Rmax;Case (total_order_Rle r1 r2);Elim H;Clear H;Intros;Auto.
-Apply (Rle_trans r r1 r2);Auto.
-Generalize (not_Rle r1 r2 n);Clear n;Intro;Unfold Rgt in H0;
- Apply (Rlt_le r r1 (Rle_lt_trans r r2 r1 H H0)).
+Lemma Rmax_Rle : forall r1 r2 r, r <= Rmax r1 r2 <-> r <= r1 \/ r <= r2.
+intros; split.
+unfold Rmax in |- *; case (Rle_dec r1 r2); intros; auto.
+intro; unfold Rmax in |- *; case (Rle_dec r1 r2); elim H; clear H; intros;
+ auto.
+apply (Rle_trans r r1 r2); auto.
+generalize (Rnot_le_lt r1 r2 n); clear n; intro; unfold Rgt in H0;
+ apply (Rlt_le r r1 (Rle_lt_trans r r2 r1 H H0)).
Qed.
-Lemma RmaxLess1: (r1, r2 : R) (Rle r1 (Rmax r1 r2)).
-Intros r1 r2; Unfold Rmax; Case (total_order_Rle r1 r2); Auto with real.
+Lemma RmaxLess1 : forall r1 r2, r1 <= Rmax r1 r2.
+intros r1 r2; unfold Rmax in |- *; case (Rle_dec r1 r2); auto with real.
Qed.
-Lemma RmaxLess2: (r1, r2 : R) (Rle r2 (Rmax r1 r2)).
-Intros r1 r2; Unfold Rmax; Case (total_order_Rle r1 r2); Auto with real.
+Lemma RmaxLess2 : forall r1 r2, r2 <= Rmax r1 r2.
+intros r1 r2; unfold Rmax in |- *; case (Rle_dec r1 r2); auto with real.
Qed.
-Lemma RmaxSym: (p, q : R) (Rmax p q) == (Rmax q p).
-Intros p q; Unfold Rmax;
- Case (total_order_Rle p q); Case (total_order_Rle q p); Auto; Intros H1 H2;
- Apply Rle_antisym; Auto with real.
+Lemma RmaxSym : forall p q:R, Rmax p q = Rmax q p.
+intros p q; unfold Rmax in |- *; case (Rle_dec p q); case (Rle_dec q p); auto;
+ intros H1 H2; apply Rle_antisym; auto with real.
Qed.
-Lemma RmaxRmult:
- (p, q, r : R)
- (Rle R0 r) -> (Rmax (Rmult r p) (Rmult r q)) == (Rmult r (Rmax p q)).
-Intros p q r H; Unfold Rmax.
-Case (total_order_Rle p q); Case (total_order_Rle (Rmult r p) (Rmult r q));
- Auto; Intros H1 H2; Auto.
-Case H; Intros E1.
-Case H1; Auto with real.
-Rewrite <- E1; Repeat Rewrite Rmult_Ol; Auto.
-Case H; Intros E1.
-Case H2; Auto with real.
-Apply Rle_monotony_contra with z := r; Auto.
-Rewrite <- E1; Repeat Rewrite Rmult_Ol; Auto.
+Lemma RmaxRmult :
+ forall (p q:R) r, 0 <= r -> Rmax (r * p) (r * q) = r * Rmax p q.
+intros p q r H; unfold Rmax in |- *.
+case (Rle_dec p q); case (Rle_dec (r * p) (r * q)); auto; intros H1 H2; auto.
+case H; intros E1.
+case H1; auto with real.
+rewrite <- E1; repeat rewrite Rmult_0_l; auto.
+case H; intros E1.
+case H2; auto with real.
+apply Rmult_le_reg_l with (r := r); auto.
+rewrite <- E1; repeat rewrite Rmult_0_l; auto.
Qed.
-Lemma Rmax_stable_in_negreal : (x,y:negreal) ``(Rmax x y)<0``.
-Intros; Unfold Rmax; Case (total_order_Rle x y); Intro; [Apply (cond_neg y) | Apply (cond_neg x)].
+Lemma Rmax_stable_in_negreal : forall x y:negreal, Rmax x y < 0.
+intros; unfold Rmax in |- *; case (Rle_dec x y); intro;
+ [ apply (cond_neg y) | apply (cond_neg x) ].
Qed.
(*******************************)
@@ -138,339 +135,336 @@ Qed.
(*******************************)
(*********)
-Lemma case_Rabsolu:(r:R)(sumboolT (Rlt r R0) (Rge r R0)).
-Intro;Generalize (total_order_Rle R0 r);Intro X;Elim X;Intro;Clear X.
-Right;Apply (Rle_sym1 R0 r a).
-Left;Fold (Rgt R0 r);Apply (not_Rle R0 r b).
+Lemma Rcase_abs : forall r, {r < 0} + {r >= 0}.
+intro; generalize (Rle_dec 0 r); intro X; elim X; intro; clear X.
+right; apply (Rle_ge 0 r a).
+left; fold (0 > r) in |- *; apply (Rnot_le_lt 0 r b).
Qed.
(*********)
-Definition Rabsolu:R->R:=
- [r:R](Cases (case_Rabsolu r) of
- (leftT _) => (Ropp r)
- |(rightT _) => r
- end).
+Definition Rabs r : R :=
+ match Rcase_abs r with
+ | left _ => - r
+ | right _ => r
+ end.
(*********)
-Lemma Rabsolu_R0:(Rabsolu R0)==R0.
-Unfold Rabsolu;Case (case_Rabsolu R0);Auto;Intro.
-Generalize (Rlt_antirefl R0);Intro;ElimType False;Auto.
+Lemma Rabs_R0 : Rabs 0 = 0.
+unfold Rabs in |- *; case (Rcase_abs 0); auto; intro.
+generalize (Rlt_irrefl 0); intro; elimtype False; auto.
Qed.
-Lemma Rabsolu_R1: (Rabsolu R1)==R1.
-Unfold Rabsolu; Case (case_Rabsolu R1); Auto with real.
-Intros H; Absurd ``1 < 0``;Auto with real.
+Lemma Rabs_R1 : Rabs 1 = 1.
+unfold Rabs in |- *; case (Rcase_abs 1); auto with real.
+intros H; absurd (1 < 0); auto with real.
Qed.
(*********)
-Lemma Rabsolu_no_R0:(r:R)~r==R0->~(Rabsolu r)==R0.
-Intros;Unfold Rabsolu;Case (case_Rabsolu r);Intro;Auto.
-Apply Ropp_neq;Auto.
+Lemma Rabs_no_R0 : forall r, r <> 0 -> Rabs r <> 0.
+intros; unfold Rabs in |- *; case (Rcase_abs r); intro; auto.
+apply Ropp_neq_0_compat; auto.
Qed.
(*********)
-Lemma Rabsolu_left: (r:R)(Rlt r R0)->((Rabsolu r) == (Ropp r)).
-Intros;Unfold Rabsolu;Case (case_Rabsolu r);Trivial;Intro;Absurd (Rge r R0).
-Exact (Rlt_ge_not r R0 H).
-Assumption.
+Lemma Rabs_left : forall r, r < 0 -> Rabs r = - r.
+intros; unfold Rabs in |- *; case (Rcase_abs r); trivial; intro;
+ absurd (r >= 0).
+exact (Rlt_not_ge r 0 H).
+assumption.
Qed.
(*********)
-Lemma Rabsolu_right: (r:R)(Rge r R0)->((Rabsolu r) == r).
-Intros;Unfold Rabsolu;Case (case_Rabsolu r);Intro.
-Absurd (Rge r R0).
-Exact (Rlt_ge_not r R0 r0).
-Assumption.
-Trivial.
+Lemma Rabs_right : forall r, r >= 0 -> Rabs r = r.
+intros; unfold Rabs in |- *; case (Rcase_abs r); intro.
+absurd (r >= 0).
+exact (Rlt_not_ge r 0 r0).
+assumption.
+trivial.
Qed.
-Lemma Rabsolu_left1: (a : R) (Rle a R0) -> (Rabsolu a) == (Ropp a).
-Intros a H; Case H; Intros H1.
-Apply Rabsolu_left; Auto.
-Rewrite H1; Simpl; Rewrite Rabsolu_right; Auto with real.
+Lemma Rabs_left1 : forall a:R, a <= 0 -> Rabs a = - a.
+intros a H; case H; intros H1.
+apply Rabs_left; auto.
+rewrite H1; simpl in |- *; rewrite Rabs_right; auto with real.
Qed.
(*********)
-Lemma Rabsolu_pos:(x:R)(Rle R0 (Rabsolu x)).
-Intros;Unfold Rabsolu;Case (case_Rabsolu x);Intro.
-Generalize (Rlt_Ropp x R0 r);Intro;Unfold Rgt in H;
- Rewrite Ropp_O in H;Unfold Rle;Left;Assumption.
-Apply Rle_sym2;Assumption.
+Lemma Rabs_pos : forall x:R, 0 <= Rabs x.
+intros; unfold Rabs in |- *; case (Rcase_abs x); intro.
+generalize (Ropp_lt_gt_contravar x 0 r); intro; unfold Rgt in H;
+ rewrite Ropp_0 in H; unfold Rle in |- *; left; assumption.
+apply Rge_le; assumption.
Qed.
-Lemma Rle_Rabsolu:
- (x:R) (Rle x (Rabsolu x)).
-Intro; Unfold Rabsolu;Case (case_Rabsolu x);Intros;Fourier.
+Lemma RRle_abs : forall x:R, x <= Rabs x.
+intro; unfold Rabs in |- *; case (Rcase_abs x); intros; fourier.
Qed.
(*********)
-Lemma Rabsolu_pos_eq:(x:R)(Rle R0 x)->(Rabsolu x)==x.
-Intros;Unfold Rabsolu;Case (case_Rabsolu x);Intro;
- [Generalize (Rle_not R0 x r);Intro;ElimType False;Auto|Trivial].
+Lemma Rabs_pos_eq : forall x:R, 0 <= x -> Rabs x = x.
+intros; unfold Rabs in |- *; case (Rcase_abs x); intro;
+ [ generalize (Rgt_not_le 0 x r); intro; elimtype False; auto | trivial ].
Qed.
(*********)
-Lemma Rabsolu_Rabsolu:(x:R)(Rabsolu (Rabsolu x))==(Rabsolu x).
-Intro;Apply (Rabsolu_pos_eq (Rabsolu x) (Rabsolu_pos x)).
+Lemma Rabs_Rabsolu : forall x:R, Rabs (Rabs x) = Rabs x.
+intro; apply (Rabs_pos_eq (Rabs x) (Rabs_pos x)).
Qed.
(*********)
-Lemma Rabsolu_pos_lt:(x:R)(~x==R0)->(Rlt R0 (Rabsolu x)).
-Intros;Generalize (Rabsolu_pos x);Intro;Unfold Rle in H0;
- Elim H0;Intro;Auto.
-ElimType False;Clear H0;Elim H;Clear H;Generalize H1;
- Unfold Rabsolu;Case (case_Rabsolu x);Intros;Auto.
-Clear r H1; Generalize (Rplus_plus_r x R0 (Ropp x) H0);
- Rewrite (let (H1,H2)=(Rplus_ne x) in H1);Rewrite (Rplus_Ropp_r x);Trivial.
+Lemma Rabs_pos_lt : forall x:R, x <> 0 -> 0 < Rabs x.
+intros; generalize (Rabs_pos x); intro; unfold Rle in H0; elim H0; intro;
+ auto.
+elimtype False; clear H0; elim H; clear H; generalize H1; unfold Rabs in |- *;
+ case (Rcase_abs x); intros; auto.
+clear r H1; generalize (Rplus_eq_compat_l x 0 (- x) H0);
+ rewrite (let (H1, H2) := Rplus_ne x in H1); rewrite (Rplus_opp_r x);
+ trivial.
Qed.
(*********)
-Lemma Rabsolu_minus_sym:(x,y:R)
- (Rabsolu (Rminus x y))==(Rabsolu (Rminus y x)).
-Intros;Unfold Rabsolu;Case (case_Rabsolu (Rminus x y));
- Case (case_Rabsolu (Rminus y x));Intros.
- Generalize (Rminus_lt y x r);Generalize (Rminus_lt x y r0);Intros;
- Generalize (Rlt_antisym x y H);Intro;ElimType False;Auto.
-Rewrite (Ropp_distr2 x y);Trivial.
-Rewrite (Ropp_distr2 y x);Trivial.
-Unfold Rge in r r0;Elim r;Elim r0;Intros;Clear r r0.
-Generalize (Rgt_RoppO (Rminus x y) H);Rewrite (Ropp_distr2 x y);
- Intro;Unfold Rgt in H0;Generalize (Rlt_antisym R0 (Rminus y x) H0);
- Intro;ElimType False;Auto.
-Rewrite (Rminus_eq x y H);Trivial.
-Rewrite (Rminus_eq y x H0);Trivial.
-Rewrite (Rminus_eq y x H0);Trivial.
+Lemma Rabs_minus_sym : forall x y:R, Rabs (x - y) = Rabs (y - x).
+intros; unfold Rabs in |- *; case (Rcase_abs (x - y));
+ case (Rcase_abs (y - x)); intros.
+ generalize (Rminus_lt y x r); generalize (Rminus_lt x y r0); intros;
+ generalize (Rlt_asym x y H); intro; elimtype False;
+ auto.
+rewrite (Ropp_minus_distr x y); trivial.
+rewrite (Ropp_minus_distr y x); trivial.
+unfold Rge in r, r0; elim r; elim r0; intros; clear r r0.
+generalize (Ropp_lt_gt_0_contravar (x - y) H); rewrite (Ropp_minus_distr x y);
+ intro; unfold Rgt in H0; generalize (Rlt_asym 0 (y - x) H0);
+ intro; elimtype False; auto.
+rewrite (Rminus_diag_uniq x y H); trivial.
+rewrite (Rminus_diag_uniq y x H0); trivial.
+rewrite (Rminus_diag_uniq y x H0); trivial.
Qed.
(*********)
-Lemma Rabsolu_mult:(x,y:R)
- (Rabsolu (Rmult x y))==(Rmult (Rabsolu x) (Rabsolu y)).
-Intros;Unfold Rabsolu;Case (case_Rabsolu (Rmult x y));
- Case (case_Rabsolu x);Case (case_Rabsolu y);Intros;Auto.
-Generalize (Rlt_anti_monotony y x R0 r r0);Intro;
- Rewrite (Rmult_Or y) in H;Generalize (Rlt_antisym (Rmult x y) R0 r1);
- Intro;Unfold Rgt in H;ElimType False;Rewrite (Rmult_sym y x) in H;
- Auto.
-Rewrite (Ropp_mul1 x y);Trivial.
-Rewrite (Rmult_sym x (Ropp y));Rewrite (Ropp_mul1 y x);
- Rewrite (Rmult_sym x y);Trivial.
-Unfold Rge in r r0;Elim r;Elim r0;Clear r r0;Intros;Unfold Rgt in H H0.
-Generalize (Rlt_monotony x R0 y H H0);Intro;Rewrite (Rmult_Or x) in H1;
- Generalize (Rlt_antisym (Rmult x y) R0 r1);Intro;ElimType False;Auto.
-Rewrite H in r1;Rewrite (Rmult_Ol y) in r1;Generalize (Rlt_antirefl R0);
- Intro;ElimType False;Auto.
-Rewrite H0 in r1;Rewrite (Rmult_Or x) in r1;Generalize (Rlt_antirefl R0);
- Intro;ElimType False;Auto.
-Rewrite H0 in r1;Rewrite (Rmult_Or x) in r1;Generalize (Rlt_antirefl R0);
- Intro;ElimType False;Auto.
-Rewrite (Ropp_mul2 x y);Trivial.
-Unfold Rge in r r1;Elim r;Elim r1;Clear r r1;Intros;Unfold Rgt in H0 H.
-Generalize (Rlt_monotony y x R0 H0 r0);Intro;Rewrite (Rmult_Or y) in H1;
- Rewrite (Rmult_sym y x) in H1;
- Generalize (Rlt_antisym (Rmult x y) R0 H1);Intro;ElimType False;Auto.
-Generalize (imp_not_Req x R0 (or_introl (Rlt x R0) (Rgt x R0) r0));
- Generalize (imp_not_Req y R0 (or_intror (Rlt y R0) (Rgt y R0) H0));Intros;
- Generalize (without_div_Od x y H);Intro;Elim H3;Intro;ElimType False;
- Auto.
-Rewrite H0 in H;Rewrite (Rmult_Or x) in H;Unfold Rgt in H;
- Generalize (Rlt_antirefl R0);Intro;ElimType False;Auto.
-Rewrite H0;Rewrite (Rmult_Or x);Rewrite (Rmult_Or (Ropp x));Trivial.
-Unfold Rge in r0 r1;Elim r0;Elim r1;Clear r0 r1;Intros;Unfold Rgt in H0 H.
-Generalize (Rlt_monotony x y R0 H0 r);Intro;Rewrite (Rmult_Or x) in H1;
- Generalize (Rlt_antisym (Rmult x y) R0 H1);Intro;ElimType False;Auto.
-Generalize (imp_not_Req y R0 (or_introl (Rlt y R0) (Rgt y R0) r));
- Generalize (imp_not_Req R0 x (or_introl (Rlt R0 x) (Rgt R0 x) H0));Intros;
- Generalize (without_div_Od x y H);Intro;Elim H3;Intro;ElimType False;
- Auto.
-Rewrite H0 in H;Rewrite (Rmult_Ol y) in H;Unfold Rgt in H;
- Generalize (Rlt_antirefl R0);Intro;ElimType False;Auto.
-Rewrite H0;Rewrite (Rmult_Ol y);Rewrite (Rmult_Ol (Ropp y));Trivial.
+Lemma Rabs_mult : forall x y:R, Rabs (x * y) = Rabs x * Rabs y.
+intros; unfold Rabs in |- *; case (Rcase_abs (x * y)); case (Rcase_abs x);
+ case (Rcase_abs y); intros; auto.
+generalize (Rmult_lt_gt_compat_neg_l y x 0 r r0); intro;
+ rewrite (Rmult_0_r y) in H; generalize (Rlt_asym (x * y) 0 r1);
+ intro; unfold Rgt in H; elimtype False; rewrite (Rmult_comm y x) in H;
+ auto.
+rewrite (Ropp_mult_distr_l_reverse x y); trivial.
+rewrite (Rmult_comm x (- y)); rewrite (Ropp_mult_distr_l_reverse y x);
+ rewrite (Rmult_comm x y); trivial.
+unfold Rge in r, r0; elim r; elim r0; clear r r0; intros; unfold Rgt in H, H0.
+generalize (Rmult_lt_compat_l x 0 y H H0); intro; rewrite (Rmult_0_r x) in H1;
+ generalize (Rlt_asym (x * y) 0 r1); intro; elimtype False;
+ auto.
+rewrite H in r1; rewrite (Rmult_0_l y) in r1; generalize (Rlt_irrefl 0);
+ intro; elimtype False; auto.
+rewrite H0 in r1; rewrite (Rmult_0_r x) in r1; generalize (Rlt_irrefl 0);
+ intro; elimtype False; auto.
+rewrite H0 in r1; rewrite (Rmult_0_r x) in r1; generalize (Rlt_irrefl 0);
+ intro; elimtype False; auto.
+rewrite (Rmult_opp_opp x y); trivial.
+unfold Rge in r, r1; elim r; elim r1; clear r r1; intros; unfold Rgt in H0, H.
+generalize (Rmult_lt_compat_l y x 0 H0 r0); intro;
+ rewrite (Rmult_0_r y) in H1; rewrite (Rmult_comm y x) in H1;
+ generalize (Rlt_asym (x * y) 0 H1); intro; elimtype False;
+ auto.
+generalize (Rlt_dichotomy_converse x 0 (or_introl (x > 0) r0));
+ generalize (Rlt_dichotomy_converse y 0 (or_intror (y < 0) H0));
+ intros; generalize (Rmult_integral x y H); intro;
+ elim H3; intro; elimtype False; auto.
+rewrite H0 in H; rewrite (Rmult_0_r x) in H; unfold Rgt in H;
+ generalize (Rlt_irrefl 0); intro; elimtype False;
+ auto.
+rewrite H0; rewrite (Rmult_0_r x); rewrite (Rmult_0_r (- x)); trivial.
+unfold Rge in r0, r1; elim r0; elim r1; clear r0 r1; intros;
+ unfold Rgt in H0, H.
+generalize (Rmult_lt_compat_l x y 0 H0 r); intro; rewrite (Rmult_0_r x) in H1;
+ generalize (Rlt_asym (x * y) 0 H1); intro; elimtype False;
+ auto.
+generalize (Rlt_dichotomy_converse y 0 (or_introl (y > 0) r));
+ generalize (Rlt_dichotomy_converse 0 x (or_introl (0 > x) H0));
+ intros; generalize (Rmult_integral x y H); intro;
+ elim H3; intro; elimtype False; auto.
+rewrite H0 in H; rewrite (Rmult_0_l y) in H; unfold Rgt in H;
+ generalize (Rlt_irrefl 0); intro; elimtype False;
+ auto.
+rewrite H0; rewrite (Rmult_0_l y); rewrite (Rmult_0_l (- y)); trivial.
Qed.
(*********)
-Lemma Rabsolu_Rinv:(r:R)(~r==R0)->(Rabsolu (Rinv r))==
- (Rinv (Rabsolu r)).
-Intro;Unfold Rabsolu;Case (case_Rabsolu r);
- Case (case_Rabsolu (Rinv r));Auto;Intros.
-Apply Ropp_Rinv;Auto.
-Generalize (Rlt_Rinv2 r r1);Intro;Unfold Rge in r0;Elim r0;Intros.
-Unfold Rgt in H1;Generalize (Rlt_antisym R0 (Rinv r) H1);Intro;
- ElimType False;Auto.
-Generalize
- (imp_not_Req (Rinv r) R0
- (or_introl (Rlt (Rinv r) R0) (Rgt (Rinv r) R0) H0));Intro;
- ElimType False;Auto.
-Unfold Rge in r1;Elim r1;Clear r1;Intro.
-Unfold Rgt in H0;Generalize (Rlt_antisym R0 (Rinv r)
- (Rlt_Rinv r H0));Intro;ElimType False;Auto.
-ElimType False;Auto.
+Lemma Rabs_Rinv : forall r, r <> 0 -> Rabs (/ r) = / Rabs r.
+intro; unfold Rabs in |- *; case (Rcase_abs r); case (Rcase_abs (/ r)); auto;
+ intros.
+apply Ropp_inv_permute; auto.
+generalize (Rinv_lt_0_compat r r1); intro; unfold Rge in r0; elim r0; intros.
+unfold Rgt in H1; generalize (Rlt_asym 0 (/ r) H1); intro; elimtype False;
+ auto.
+generalize (Rlt_dichotomy_converse (/ r) 0 (or_introl (/ r > 0) H0)); intro;
+ elimtype False; auto.
+unfold Rge in r1; elim r1; clear r1; intro.
+unfold Rgt in H0; generalize (Rlt_asym 0 (/ r) (Rinv_0_lt_compat r H0));
+ intro; elimtype False; auto.
+elimtype False; auto.
Qed.
-Lemma Rabsolu_Ropp:
- (x:R) (Rabsolu (Ropp x))==(Rabsolu x).
-Intro;Cut (Ropp x)==(Rmult (Ropp R1) x).
-Intros; Rewrite H.
-Rewrite Rabsolu_mult.
-Cut (Rabsolu (Ropp R1))==R1.
-Intros; Rewrite H0.
-Ring.
-Unfold Rabsolu; Case (case_Rabsolu (Ropp R1)).
-Intro; Ring.
-Intro H0;Generalize (Rle_sym2 R0 (Ropp R1) H0);Intros.
-Generalize (Rle_Ropp R0 (Ropp R1) H1).
-Rewrite Ropp_Ropp; Rewrite Ropp_O.
-Intro;Generalize (Rle_not R1 R0 Rlt_R0_R1);Intro;
- Generalize (Rle_sym2 R1 R0 H2);Intro;
- ElimType False;Auto.
-Ring.
+Lemma Rabs_Ropp : forall x:R, Rabs (- x) = Rabs x.
+intro; cut (- x = -1 * x).
+intros; rewrite H.
+rewrite Rabs_mult.
+cut (Rabs (-1) = 1).
+intros; rewrite H0.
+ring.
+unfold Rabs in |- *; case (Rcase_abs (-1)).
+intro; ring.
+intro H0; generalize (Rge_le (-1) 0 H0); intros.
+generalize (Ropp_le_ge_contravar 0 (-1) H1).
+rewrite Ropp_involutive; rewrite Ropp_0.
+intro; generalize (Rgt_not_le 1 0 Rlt_0_1); intro; generalize (Rge_le 0 1 H2);
+ intro; elimtype False; auto.
+ring.
Qed.
(*********)
-Lemma Rabsolu_triang:(a,b:R)(Rle (Rabsolu (Rplus a b))
- (Rplus (Rabsolu a) (Rabsolu b))).
-Intros a b;Unfold Rabsolu;Case (case_Rabsolu (Rplus a b));
- Case (case_Rabsolu a);Case (case_Rabsolu b);Intros.
-Apply (eq_Rle (Ropp (Rplus a b)) (Rplus (Ropp a) (Ropp b)));
- Rewrite (Ropp_distr1 a b);Reflexivity.
+Lemma Rabs_triang : forall a b:R, Rabs (a + b) <= Rabs a + Rabs b.
+intros a b; unfold Rabs in |- *; case (Rcase_abs (a + b)); case (Rcase_abs a);
+ case (Rcase_abs b); intros.
+apply (Req_le (- (a + b)) (- a + - b)); rewrite (Ropp_plus_distr a b);
+ reflexivity.
(**)
-Rewrite (Ropp_distr1 a b);
- Apply (Rle_compatibility (Ropp a) (Ropp b) b);
- Unfold Rle;Unfold Rge in r;Elim r;Intro.
-Left;Unfold Rgt in H;Generalize (Rlt_compatibility (Ropp b) R0 b H);
- Intro;Elim (Rplus_ne (Ropp b));Intros v w;Rewrite v in H0;Clear v w;
- Rewrite (Rplus_Ropp_l b) in H0;Apply (Rlt_trans (Ropp b) R0 b H0 H).
-Right;Rewrite H;Apply Ropp_O.
+rewrite (Ropp_plus_distr a b); apply (Rplus_le_compat_l (- a) (- b) b);
+ unfold Rle in |- *; unfold Rge in r; elim r; intro.
+left; unfold Rgt in H; generalize (Rplus_lt_compat_l (- b) 0 b H); intro;
+ elim (Rplus_ne (- b)); intros v w; rewrite v in H0;
+ clear v w; rewrite (Rplus_opp_l b) in H0; apply (Rlt_trans (- b) 0 b H0 H).
+right; rewrite H; apply Ropp_0.
(**)
-Rewrite (Ropp_distr1 a b);
- Rewrite (Rplus_sym (Ropp a) (Ropp b));
- Rewrite (Rplus_sym a (Ropp b));
- Apply (Rle_compatibility (Ropp b) (Ropp a) a);
- Unfold Rle;Unfold Rge in r0;Elim r0;Intro.
-Left;Unfold Rgt in H;Generalize (Rlt_compatibility (Ropp a) R0 a H);
- Intro;Elim (Rplus_ne (Ropp a));Intros v w;Rewrite v in H0;Clear v w;
- Rewrite (Rplus_Ropp_l a) in H0;Apply (Rlt_trans (Ropp a) R0 a H0 H).
-Right;Rewrite H;Apply Ropp_O.
+rewrite (Ropp_plus_distr a b); rewrite (Rplus_comm (- a) (- b));
+ rewrite (Rplus_comm a (- b)); apply (Rplus_le_compat_l (- b) (- a) a);
+ unfold Rle in |- *; unfold Rge in r0; elim r0; intro.
+left; unfold Rgt in H; generalize (Rplus_lt_compat_l (- a) 0 a H); intro;
+ elim (Rplus_ne (- a)); intros v w; rewrite v in H0;
+ clear v w; rewrite (Rplus_opp_l a) in H0; apply (Rlt_trans (- a) 0 a H0 H).
+right; rewrite H; apply Ropp_0.
(**)
-ElimType False;Generalize (Rge_plus_plus_r a b R0 r);Intro;
- Elim (Rplus_ne a);Intros v w;Rewrite v in H;Clear v w;
- Generalize (Rge_trans (Rplus a b) a R0 H r0);Intro;Clear H;
- Unfold Rge in H0;Elim H0;Intro;Clear H0.
-Unfold Rgt in H;Generalize (Rlt_antisym (Rplus a b) R0 r1);Intro;Auto.
-Absurd (Rplus a b)==R0;Auto.
-Apply (imp_not_Req (Rplus a b) R0);Left;Assumption.
+elimtype False; generalize (Rplus_ge_compat_l a b 0 r); intro;
+ elim (Rplus_ne a); intros v w; rewrite v in H; clear v w;
+ generalize (Rge_trans (a + b) a 0 H r0); intro; clear H;
+ unfold Rge in H0; elim H0; intro; clear H0.
+unfold Rgt in H; generalize (Rlt_asym (a + b) 0 r1); intro; auto.
+absurd (a + b = 0); auto.
+apply (Rlt_dichotomy_converse (a + b) 0); left; assumption.
(**)
-ElimType False;Generalize (Rlt_compatibility a b R0 r);Intro;
- Elim (Rplus_ne a);Intros v w;Rewrite v in H;Clear v w;
- Generalize (Rlt_trans (Rplus a b) a R0 H r0);Intro;Clear H;
- Unfold Rge in r1;Elim r1;Clear r1;Intro.
-Unfold Rgt in H;
- Generalize (Rlt_trans (Rplus a b) R0 (Rplus a b) H0 H);Intro;
- Apply (Rlt_antirefl (Rplus a b));Assumption.
-Rewrite H in H0;Apply (Rlt_antirefl R0);Assumption.
+elimtype False; generalize (Rplus_lt_compat_l a b 0 r); intro;
+ elim (Rplus_ne a); intros v w; rewrite v in H; clear v w;
+ generalize (Rlt_trans (a + b) a 0 H r0); intro; clear H;
+ unfold Rge in r1; elim r1; clear r1; intro.
+unfold Rgt in H; generalize (Rlt_trans (a + b) 0 (a + b) H0 H); intro;
+ apply (Rlt_irrefl (a + b)); assumption.
+rewrite H in H0; apply (Rlt_irrefl 0); assumption.
(**)
-Rewrite (Rplus_sym a b);Rewrite (Rplus_sym (Ropp a) b);
- Apply (Rle_compatibility b a (Ropp a));
- Apply (Rminus_le a (Ropp a));Unfold Rminus;Rewrite (Ropp_Ropp a);
- Generalize (Rlt_compatibility a a R0 r0);Clear r r1;Intro;
- Elim (Rplus_ne a);Intros v w;Rewrite v in H;Clear v w;
- Generalize (Rlt_trans (Rplus a a) a R0 H r0);Intro;
- Apply (Rlt_le (Rplus a a) R0 H0).
+rewrite (Rplus_comm a b); rewrite (Rplus_comm (- a) b);
+ apply (Rplus_le_compat_l b a (- a)); apply (Rminus_le a (- a));
+ unfold Rminus in |- *; rewrite (Ropp_involutive a);
+ generalize (Rplus_lt_compat_l a a 0 r0); clear r r1;
+ intro; elim (Rplus_ne a); intros v w; rewrite v in H;
+ clear v w; generalize (Rlt_trans (a + a) a 0 H r0);
+ intro; apply (Rlt_le (a + a) 0 H0).
(**)
-Apply (Rle_compatibility a b (Ropp b));
- Apply (Rminus_le b (Ropp b));Unfold Rminus;Rewrite (Ropp_Ropp b);
- Generalize (Rlt_compatibility b b R0 r);Clear r0 r1;Intro;
- Elim (Rplus_ne b);Intros v w;Rewrite v in H;Clear v w;
- Generalize (Rlt_trans (Rplus b b) b R0 H r);Intro;
- Apply (Rlt_le (Rplus b b) R0 H0).
+apply (Rplus_le_compat_l a b (- b)); apply (Rminus_le b (- b));
+ unfold Rminus in |- *; rewrite (Ropp_involutive b);
+ generalize (Rplus_lt_compat_l b b 0 r); clear r0 r1;
+ intro; elim (Rplus_ne b); intros v w; rewrite v in H;
+ clear v w; generalize (Rlt_trans (b + b) b 0 H r);
+ intro; apply (Rlt_le (b + b) 0 H0).
(**)
-Unfold Rle;Right;Reflexivity.
+unfold Rle in |- *; right; reflexivity.
Qed.
(*********)
-Lemma Rabsolu_triang_inv:(a,b:R)(Rle (Rminus (Rabsolu a) (Rabsolu b))
- (Rabsolu (Rminus a b))).
-Intros;
- Apply (Rle_anti_compatibility (Rabsolu b)
- (Rminus (Rabsolu a) (Rabsolu b)) (Rabsolu (Rminus a b)));
- Unfold Rminus;
- Rewrite <- (Rplus_assoc (Rabsolu b) (Rabsolu a) (Ropp (Rabsolu b)));
- Rewrite (Rplus_sym (Rabsolu b) (Rabsolu a));
- Rewrite (Rplus_assoc (Rabsolu a) (Rabsolu b) (Ropp (Rabsolu b)));
- Rewrite (Rplus_Ropp_r (Rabsolu b));
- Rewrite (proj1 ? ? (Rplus_ne (Rabsolu a)));
- Replace (Rabsolu a) with (Rabsolu (Rplus a R0)).
- Rewrite <- (Rplus_Ropp_r b);
- Rewrite <- (Rplus_assoc a b (Ropp b));
- Rewrite (Rplus_sym a b);
- Rewrite (Rplus_assoc b a (Ropp b)).
- Exact (Rabsolu_triang b (Rplus a (Ropp b))).
- Rewrite (proj1 ? ? (Rplus_ne a));Trivial.
+Lemma Rabs_triang_inv : forall a b:R, Rabs a - Rabs b <= Rabs (a - b).
+intros; apply (Rplus_le_reg_l (Rabs b) (Rabs a - Rabs b) (Rabs (a - b)));
+ unfold Rminus in |- *; rewrite <- (Rplus_assoc (Rabs b) (Rabs a) (- Rabs b));
+ rewrite (Rplus_comm (Rabs b) (Rabs a));
+ rewrite (Rplus_assoc (Rabs a) (Rabs b) (- Rabs b));
+ rewrite (Rplus_opp_r (Rabs b)); rewrite (proj1 (Rplus_ne (Rabs a)));
+ replace (Rabs a) with (Rabs (a + 0)).
+ rewrite <- (Rplus_opp_r b); rewrite <- (Rplus_assoc a b (- b));
+ rewrite (Rplus_comm a b); rewrite (Rplus_assoc b a (- b)).
+ exact (Rabs_triang b (a + - b)).
+ rewrite (proj1 (Rplus_ne a)); trivial.
Qed.
(* ||a|-|b||<=|a-b| *)
-Lemma Rabsolu_triang_inv2 : (a,b:R) ``(Rabsolu ((Rabsolu a)-(Rabsolu b)))<=(Rabsolu (a-b))``.
-Cut (a,b:R) ``(Rabsolu b)<=(Rabsolu a)``->``(Rabsolu ((Rabsolu a)-(Rabsolu b))) <= (Rabsolu (a-b))``.
-Intros; NewDestruct (total_order (Rabsolu a) (Rabsolu b)) as [Hlt|[Heq|Hgt]].
-Rewrite <- (Rabsolu_Ropp ``(Rabsolu a)-(Rabsolu b)``); Rewrite <- (Rabsolu_Ropp ``a-b``); Do 2 Rewrite Ropp_distr2.
-Apply H; Left; Assumption.
-Rewrite Heq; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply Rabsolu_pos.
-Apply H; Left; Assumption.
-Intros; Replace ``(Rabsolu ((Rabsolu a)-(Rabsolu b)))`` with ``(Rabsolu a)-(Rabsolu b)``.
-Apply Rabsolu_triang_inv.
-Rewrite (Rabsolu_right ``(Rabsolu a)-(Rabsolu b)``); [Reflexivity | Apply Rle_sym1; Apply Rle_anti_compatibility with (Rabsolu b); Rewrite Rplus_Or; Replace ``(Rabsolu b)+((Rabsolu a)-(Rabsolu b))`` with (Rabsolu a); [Assumption | Ring]].
+Lemma Rabs_triang_inv2 : forall a b:R, Rabs (Rabs a - Rabs b) <= Rabs (a - b).
+cut
+ (forall a b:R, Rabs b <= Rabs a -> Rabs (Rabs a - Rabs b) <= Rabs (a - b)).
+intros; destruct (Rtotal_order (Rabs a) (Rabs b)) as [Hlt| [Heq| Hgt]].
+rewrite <- (Rabs_Ropp (Rabs a - Rabs b)); rewrite <- (Rabs_Ropp (a - b));
+ do 2 rewrite Ropp_minus_distr.
+apply H; left; assumption.
+rewrite Heq; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+ apply Rabs_pos.
+apply H; left; assumption.
+intros; replace (Rabs (Rabs a - Rabs b)) with (Rabs a - Rabs b).
+apply Rabs_triang_inv.
+rewrite (Rabs_right (Rabs a - Rabs b));
+ [ reflexivity
+ | apply Rle_ge; apply Rplus_le_reg_l with (Rabs b); rewrite Rplus_0_r;
+ replace (Rabs b + (Rabs a - Rabs b)) with (Rabs a);
+ [ assumption | ring ] ].
Qed.
(*********)
-Lemma Rabsolu_def1:(x,a:R)(Rlt x a)->(Rlt (Ropp a) x)->(Rlt (Rabsolu x) a).
-Unfold Rabsolu;Intros;Case (case_Rabsolu x);Intro.
-Generalize (Rlt_Ropp (Ropp a) x H0);Unfold Rgt;Rewrite Ropp_Ropp;Intro;
- Assumption.
-Assumption.
+Lemma Rabs_def1 : forall x a:R, x < a -> - a < x -> Rabs x < a.
+unfold Rabs in |- *; intros; case (Rcase_abs x); intro.
+generalize (Ropp_lt_gt_contravar (- a) x H0); unfold Rgt in |- *;
+ rewrite Ropp_involutive; intro; assumption.
+assumption.
Qed.
(*********)
-Lemma Rabsolu_def2:(x,a:R)(Rlt (Rabsolu x) a)->(Rlt x a)/\(Rlt (Ropp a) x).
-Unfold Rabsolu;Intro x;Case (case_Rabsolu x);Intros.
-Generalize (Rlt_RoppO x r);Unfold Rgt;Intro;
- Generalize (Rlt_trans R0 (Ropp x) a H0 H);Intro;Split.
-Apply (Rlt_trans x R0 a r H1).
-Generalize (Rlt_Ropp (Ropp x) a H);Rewrite (Ropp_Ropp x);Unfold Rgt;Trivial.
-Fold (Rgt a x) in H;Generalize (Rgt_ge_trans a x R0 H r);Intro;
- Generalize (Rgt_RoppO a H0);Intro;Fold (Rgt R0 (Ropp a));
- Generalize (Rge_gt_trans x R0 (Ropp a) r H1);Unfold Rgt;Intro;Split;
- Assumption.
-Qed.
-
-Lemma RmaxAbs:
- (p, q, r : R)
- (Rle p q) -> (Rle q r) -> (Rle (Rabsolu q) (Rmax (Rabsolu p) (Rabsolu r))).
-Intros p q r H' H'0; Case (Rle_or_lt R0 p); Intros H'1.
-Repeat Rewrite Rabsolu_right; Auto with real.
-Apply Rle_trans with r; Auto with real.
-Apply RmaxLess2; Auto.
-Apply Rge_trans with p; Auto with real; Apply Rge_trans with q; Auto with real.
-Apply Rge_trans with p; Auto with real.
-Rewrite (Rabsolu_left p); Auto.
-Case (Rle_or_lt R0 q); Intros H'2.
-Repeat Rewrite Rabsolu_right; Auto with real.
-Apply Rle_trans with r; Auto.
-Apply RmaxLess2; Auto.
-Apply Rge_trans with q; Auto with real.
-Rewrite (Rabsolu_left q); Auto.
-Case (Rle_or_lt R0 r); Intros H'3.
-Repeat Rewrite Rabsolu_right; Auto with real.
-Apply Rle_trans with (Ropp p); Auto with real.
-Apply RmaxLess1; Auto.
-Rewrite (Rabsolu_left r); Auto.
-Apply Rle_trans with (Ropp p); Auto with real.
-Apply RmaxLess1; Auto.
-Qed.
-
-Lemma Rabsolu_Zabs: (z : Z) (Rabsolu (IZR z)) == (IZR (Zabs z)).
-Intros z; Case z; Simpl; Auto with real.
-Apply Rabsolu_right; Auto with real.
-Intros p0; Apply Rabsolu_right; Auto with real zarith.
-Intros p0; Rewrite Rabsolu_Ropp.
-Apply Rabsolu_right; Auto with real zarith.
-Qed.
-
+Lemma Rabs_def2 : forall x a:R, Rabs x < a -> x < a /\ - a < x.
+unfold Rabs in |- *; intro x; case (Rcase_abs x); intros.
+generalize (Ropp_gt_lt_0_contravar x r); unfold Rgt in |- *; intro;
+ generalize (Rlt_trans 0 (- x) a H0 H); intro; split.
+apply (Rlt_trans x 0 a r H1).
+generalize (Ropp_lt_gt_contravar (- x) a H); rewrite (Ropp_involutive x);
+ unfold Rgt in |- *; trivial.
+fold (a > x) in H; generalize (Rgt_ge_trans a x 0 H r); intro;
+ generalize (Ropp_lt_gt_0_contravar a H0); intro; fold (0 > - a) in |- *;
+ generalize (Rge_gt_trans x 0 (- a) r H1); unfold Rgt in |- *;
+ intro; split; assumption.
+Qed.
+
+Lemma RmaxAbs :
+ forall (p q:R) r, p <= q -> q <= r -> Rabs q <= Rmax (Rabs p) (Rabs r).
+intros p q r H' H'0; case (Rle_or_lt 0 p); intros H'1.
+repeat rewrite Rabs_right; auto with real.
+apply Rle_trans with r; auto with real.
+apply RmaxLess2; auto.
+apply Rge_trans with p; auto with real; apply Rge_trans with q;
+ auto with real.
+apply Rge_trans with p; auto with real.
+rewrite (Rabs_left p); auto.
+case (Rle_or_lt 0 q); intros H'2.
+repeat rewrite Rabs_right; auto with real.
+apply Rle_trans with r; auto.
+apply RmaxLess2; auto.
+apply Rge_trans with q; auto with real.
+rewrite (Rabs_left q); auto.
+case (Rle_or_lt 0 r); intros H'3.
+repeat rewrite Rabs_right; auto with real.
+apply Rle_trans with (- p); auto with real.
+apply RmaxLess1; auto.
+rewrite (Rabs_left r); auto.
+apply Rle_trans with (- p); auto with real.
+apply RmaxLess1; auto.
+Qed.
+
+Lemma Rabs_Zabs : forall z:Z, Rabs (IZR z) = IZR (Zabs z).
+intros z; case z; simpl in |- *; auto with real.
+apply Rabs_right; auto with real.
+intros p0; apply Rabs_right; auto with real zarith.
+intros p0; rewrite Rabs_Ropp.
+apply Rabs_right; auto with real zarith.
+Qed.
+ \ No newline at end of file
diff --git a/theories/Reals/Rcomplete.v b/theories/Reals/Rcomplete.v
index 5dca3068c..53624cbb2 100644
--- a/theories/Reals/Rcomplete.v
+++ b/theories/Reals/Rcomplete.v
@@ -8,12 +8,11 @@
(*i $Id$ i*)
-Require Rbase.
-Require Rfunctions.
-Require Rseries.
-Require SeqProp.
-Require Max.
-V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
+Require Import Rbase.
+Require Import Rfunctions.
+Require Import Rseries.
+Require Import SeqProp.
+Require Import Max.
Open Local Scope R_scope.
(****************************************************)
@@ -24,152 +23,176 @@ Open Local Scope R_scope.
(* Proof with adjacent sequences (Vn and Wn) *)
(****************************************************)
-Theorem R_complete : (Un:nat->R) (Cauchy_crit Un) -> (sigTT R [l:R](Un_cv Un l)).
-Intros.
-Pose Vn := (sequence_minorant Un (cauchy_min Un H)).
-Pose Wn := (sequence_majorant Un (cauchy_maj Un H)).
-Assert H0 := (maj_cv Un H).
-Fold Wn in H0.
-Assert H1 := (min_cv Un H).
-Fold Vn in H1.
-Elim H0; Intros.
-Elim H1; Intros.
-Cut x==x0.
-Intros.
-Apply existTT with x.
-Rewrite <- H2 in p0.
-Unfold Un_cv.
-Intros.
-Unfold Un_cv in p; Unfold Un_cv in p0.
-Cut ``0<eps/3``.
-Intro.
-Elim (p ``eps/3`` H4); Intros.
-Elim (p0 ``eps/3`` H4); Intros.
-Exists (max x1 x2).
-Intros.
-Unfold R_dist.
-Apply Rle_lt_trans with ``(Rabsolu ((Un n)-(Vn n)))+(Rabsolu ((Vn n)-x))``.
-Replace ``(Un n)-x`` with ``((Un n)-(Vn n))+((Vn n)-x)``; [Apply Rabsolu_triang | Ring].
-Apply Rle_lt_trans with ``(Rabsolu ((Wn n)-(Vn n)))+(Rabsolu ((Vn n)-x))``.
-Do 2 Rewrite <- (Rplus_sym ``(Rabsolu ((Vn n)-x))``).
-Apply Rle_compatibility.
-Repeat Rewrite Rabsolu_right.
-Unfold Rminus; Do 2 Rewrite <- (Rplus_sym ``-(Vn n)``); Apply Rle_compatibility.
-Assert H8 := (Vn_Un_Wn_order Un (cauchy_maj Un H) (cauchy_min Un H)).
-Fold Vn Wn in H8.
-Elim (H8 n); Intros.
-Assumption.
-Apply Rle_sym1.
-Unfold Rminus; Apply Rle_anti_compatibility with (Vn n).
-Rewrite Rplus_Or.
-Replace ``(Vn n)+((Wn n)+ -(Vn n))`` with (Wn n); [Idtac | Ring].
-Assert H8 := (Vn_Un_Wn_order Un (cauchy_maj Un H) (cauchy_min Un H)).
-Fold Vn Wn in H8.
-Elim (H8 n); Intros.
-Apply Rle_trans with (Un n); Assumption.
-Apply Rle_sym1.
-Unfold Rminus; Apply Rle_anti_compatibility with (Vn n).
-Rewrite Rplus_Or.
-Replace ``(Vn n)+((Un n)+ -(Vn n))`` with (Un n); [Idtac | Ring].
-Assert H8 := (Vn_Un_Wn_order Un (cauchy_maj Un H) (cauchy_min Un H)).
-Fold Vn Wn in H8.
-Elim (H8 n); Intros.
-Assumption.
-Apply Rle_lt_trans with ``(Rabsolu ((Wn n)-x))+(Rabsolu (x-(Vn n)))+(Rabsolu ((Vn n)-x))``.
-Do 2 Rewrite <- (Rplus_sym ``(Rabsolu ((Vn n)-x))``).
-Apply Rle_compatibility.
-Replace ``(Wn n)-(Vn n)`` with ``((Wn n)-x)+(x-(Vn n))``; [Apply Rabsolu_triang | Ring].
-Apply Rlt_le_trans with ``eps/3+eps/3+eps/3``.
-Repeat Apply Rplus_lt.
-Unfold R_dist in H5.
-Apply H5.
-Unfold ge; Apply le_trans with (max x1 x2).
-Apply le_max_l.
-Assumption.
-Rewrite <- Rabsolu_Ropp.
-Replace ``-(x-(Vn n))`` with ``(Vn n)-x``; [Idtac | Ring].
-Unfold R_dist in H6.
-Apply H6.
-Unfold ge; Apply le_trans with (max x1 x2).
-Apply le_max_r.
-Assumption.
-Unfold R_dist in H6.
-Apply H6.
-Unfold ge; Apply le_trans with (max x1 x2).
-Apply le_max_r.
-Assumption.
-Right.
-Pattern 4 eps; Replace ``eps`` with ``3*eps/3``.
-Ring.
-Unfold Rdiv; Rewrite <- Rmult_assoc; Apply Rinv_r_simpl_m; DiscrR.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
-Apply cond_eq.
-Intros.
-Cut ``0<eps/5``.
-Intro.
-Unfold Un_cv in p; Unfold Un_cv in p0.
-Unfold R_dist in p; Unfold R_dist in p0.
-Elim (p ``eps/5`` H3); Intros N1 H4.
-Elim (p0 ``eps/5`` H3); Intros N2 H5.
-Unfold Cauchy_crit in H.
-Unfold R_dist in H.
-Elim (H ``eps/5`` H3); Intros N3 H6.
-Pose N := (max (max N1 N2) N3).
-Apply Rle_lt_trans with ``(Rabsolu (x-(Wn N)))+(Rabsolu ((Wn N)-x0))``.
-Replace ``x-x0`` with ``(x-(Wn N))+((Wn N)-x0)``; [Apply Rabsolu_triang | Ring].
-Apply Rle_lt_trans with ``(Rabsolu (x-(Wn N)))+(Rabsolu ((Wn N)-(Vn N)))+(Rabsolu (((Vn N)-x0)))``.
-Rewrite Rplus_assoc.
-Apply Rle_compatibility.
-Replace ``(Wn N)-x0`` with ``((Wn N)-(Vn N))+((Vn N)-x0)``; [Apply Rabsolu_triang | Ring].
-Replace ``eps`` with ``eps/5+3*eps/5+eps/5``.
-Repeat Apply Rplus_lt.
-Rewrite <- Rabsolu_Ropp.
-Replace ``-(x-(Wn N))`` with ``(Wn N)-x``; [Apply H4 | Ring].
-Unfold ge N.
-Apply le_trans with (max N1 N2); Apply le_max_l.
-Unfold Wn Vn.
-Unfold sequence_majorant sequence_minorant.
-Assert H7 := (approx_maj [k:nat](Un (plus N k)) (maj_ss Un N (cauchy_maj Un H))).
-Assert H8 := (approx_min [k:nat](Un (plus N k)) (min_ss Un N (cauchy_min Un H))).
-Cut (Wn N)==(majorant ([k:nat](Un (plus N k))) (maj_ss Un N (cauchy_maj Un H))).
-Cut (Vn N)==(minorant ([k:nat](Un (plus N k))) (min_ss Un N (cauchy_min Un H))).
-Intros.
-Rewrite <- H9; Rewrite <- H10.
-Rewrite <- H9 in H8.
-Rewrite <- H10 in H7.
-Elim (H7 ``eps/5`` H3); Intros k2 H11.
-Elim (H8 ``eps/5`` H3); Intros k1 H12.
-Apply Rle_lt_trans with ``(Rabsolu ((Wn N)-(Un (plus N k2))))+(Rabsolu ((Un (plus N k2))-(Vn N)))``.
-Replace ``(Wn N)-(Vn N)`` with ``((Wn N)-(Un (plus N k2)))+((Un (plus N k2))-(Vn N))``; [Apply Rabsolu_triang | Ring].
-Apply Rle_lt_trans with ``(Rabsolu ((Wn N)-(Un (plus N k2))))+(Rabsolu ((Un (plus N k2))-(Un (plus N k1))))+(Rabsolu ((Un (plus N k1))-(Vn N)))``.
-Rewrite Rplus_assoc.
-Apply Rle_compatibility.
-Replace ``(Un (plus N k2))-(Vn N)`` with ``((Un (plus N k2))-(Un (plus N k1)))+((Un (plus N k1))-(Vn N))``; [Apply Rabsolu_triang | Ring].
-Replace ``3*eps/5`` with ``eps/5+eps/5+eps/5``; [Repeat Apply Rplus_lt | Ring].
-Assumption.
-Apply H6.
-Unfold ge.
-Apply le_trans with N.
-Unfold N; Apply le_max_r.
-Apply le_plus_l.
-Unfold ge.
-Apply le_trans with N.
-Unfold N; Apply le_max_r.
-Apply le_plus_l.
-Rewrite <- Rabsolu_Ropp.
-Replace ``-((Un (plus N k1))-(Vn N))`` with ``(Vn N)-(Un (plus N k1))``; [Assumption | Ring].
-Reflexivity.
-Reflexivity.
-Apply H5.
-Unfold ge; Apply le_trans with (max N1 N2).
-Apply le_max_r.
-Unfold N; Apply le_max_l.
-Pattern 4 eps; Replace ``eps`` with ``5*eps/5``.
-Ring.
-Unfold Rdiv; Rewrite <- Rmult_assoc; Apply Rinv_r_simpl_m.
-DiscrR.
-Unfold Rdiv; Apply Rmult_lt_pos.
-Assumption.
-Apply Rlt_Rinv.
-Sup0; Try Apply lt_O_Sn.
-Qed.
+Theorem R_complete :
+ forall Un:nat -> R, Cauchy_crit Un -> sigT (fun l:R => Un_cv Un l).
+intros.
+pose (Vn := sequence_minorant Un (cauchy_min Un H)).
+pose (Wn := sequence_majorant Un (cauchy_maj Un H)).
+assert (H0 := maj_cv Un H).
+fold Wn in H0.
+assert (H1 := min_cv Un H).
+fold Vn in H1.
+elim H0; intros.
+elim H1; intros.
+cut (x = x0).
+intros.
+apply existT with x.
+rewrite <- H2 in p0.
+unfold Un_cv in |- *.
+intros.
+unfold Un_cv in p; unfold Un_cv in p0.
+cut (0 < eps / 3).
+intro.
+elim (p (eps / 3) H4); intros.
+elim (p0 (eps / 3) H4); intros.
+exists (max x1 x2).
+intros.
+unfold R_dist in |- *.
+apply Rle_lt_trans with (Rabs (Un n - Vn n) + Rabs (Vn n - x)).
+replace (Un n - x) with (Un n - Vn n + (Vn n - x));
+ [ apply Rabs_triang | ring ].
+apply Rle_lt_trans with (Rabs (Wn n - Vn n) + Rabs (Vn n - x)).
+do 2 rewrite <- (Rplus_comm (Rabs (Vn n - x))).
+apply Rplus_le_compat_l.
+repeat rewrite Rabs_right.
+unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (- Vn n));
+ apply Rplus_le_compat_l.
+assert (H8 := Vn_Un_Wn_order Un (cauchy_maj Un H) (cauchy_min Un H)).
+fold Vn Wn in H8.
+elim (H8 n); intros.
+assumption.
+apply Rle_ge.
+unfold Rminus in |- *; apply Rplus_le_reg_l with (Vn n).
+rewrite Rplus_0_r.
+replace (Vn n + (Wn n + - Vn n)) with (Wn n); [ idtac | ring ].
+assert (H8 := Vn_Un_Wn_order Un (cauchy_maj Un H) (cauchy_min Un H)).
+fold Vn Wn in H8.
+elim (H8 n); intros.
+apply Rle_trans with (Un n); assumption.
+apply Rle_ge.
+unfold Rminus in |- *; apply Rplus_le_reg_l with (Vn n).
+rewrite Rplus_0_r.
+replace (Vn n + (Un n + - Vn n)) with (Un n); [ idtac | ring ].
+assert (H8 := Vn_Un_Wn_order Un (cauchy_maj Un H) (cauchy_min Un H)).
+fold Vn Wn in H8.
+elim (H8 n); intros.
+assumption.
+apply Rle_lt_trans with (Rabs (Wn n - x) + Rabs (x - Vn n) + Rabs (Vn n - x)).
+do 2 rewrite <- (Rplus_comm (Rabs (Vn n - x))).
+apply Rplus_le_compat_l.
+replace (Wn n - Vn n) with (Wn n - x + (x - Vn n));
+ [ apply Rabs_triang | ring ].
+apply Rlt_le_trans with (eps / 3 + eps / 3 + eps / 3).
+repeat apply Rplus_lt_compat.
+unfold R_dist in H5.
+apply H5.
+unfold ge in |- *; apply le_trans with (max x1 x2).
+apply le_max_l.
+assumption.
+rewrite <- Rabs_Ropp.
+replace (- (x - Vn n)) with (Vn n - x); [ idtac | ring ].
+unfold R_dist in H6.
+apply H6.
+unfold ge in |- *; apply le_trans with (max x1 x2).
+apply le_max_r.
+assumption.
+unfold R_dist in H6.
+apply H6.
+unfold ge in |- *; apply le_trans with (max x1 x2).
+apply le_max_r.
+assumption.
+right.
+pattern eps at 4 in |- *; replace eps with (3 * (eps / 3)).
+ring.
+unfold Rdiv in |- *; rewrite <- Rmult_assoc; apply Rinv_r_simpl_m; discrR.
+unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
+apply cond_eq.
+intros.
+cut (0 < eps / 5).
+intro.
+unfold Un_cv in p; unfold Un_cv in p0.
+unfold R_dist in p; unfold R_dist in p0.
+elim (p (eps / 5) H3); intros N1 H4.
+elim (p0 (eps / 5) H3); intros N2 H5.
+unfold Cauchy_crit in H.
+unfold R_dist in H.
+elim (H (eps / 5) H3); intros N3 H6.
+pose (N := max (max N1 N2) N3).
+apply Rle_lt_trans with (Rabs (x - Wn N) + Rabs (Wn N - x0)).
+replace (x - x0) with (x - Wn N + (Wn N - x0)); [ apply Rabs_triang | ring ].
+apply Rle_lt_trans with
+ (Rabs (x - Wn N) + Rabs (Wn N - Vn N) + Rabs (Vn N - x0)).
+rewrite Rplus_assoc.
+apply Rplus_le_compat_l.
+replace (Wn N - x0) with (Wn N - Vn N + (Vn N - x0));
+ [ apply Rabs_triang | ring ].
+replace eps with (eps / 5 + 3 * (eps / 5) + eps / 5).
+repeat apply Rplus_lt_compat.
+rewrite <- Rabs_Ropp.
+replace (- (x - Wn N)) with (Wn N - x); [ apply H4 | ring ].
+unfold ge, N in |- *.
+apply le_trans with (max N1 N2); apply le_max_l.
+unfold Wn, Vn in |- *.
+unfold sequence_majorant, sequence_minorant in |- *.
+assert
+ (H7 :=
+ approx_maj (fun k:nat => Un (N + k)%nat) (maj_ss Un N (cauchy_maj Un H))).
+assert
+ (H8 :=
+ approx_min (fun k:nat => Un (N + k)%nat) (min_ss Un N (cauchy_min Un H))).
+cut
+ (Wn N =
+ majorant (fun k:nat => Un (N + k)%nat) (maj_ss Un N (cauchy_maj Un H))).
+cut
+ (Vn N =
+ minorant (fun k:nat => Un (N + k)%nat) (min_ss Un N (cauchy_min Un H))).
+intros.
+rewrite <- H9; rewrite <- H10.
+rewrite <- H9 in H8.
+rewrite <- H10 in H7.
+elim (H7 (eps / 5) H3); intros k2 H11.
+elim (H8 (eps / 5) H3); intros k1 H12.
+apply Rle_lt_trans with
+ (Rabs (Wn N - Un (N + k2)%nat) + Rabs (Un (N + k2)%nat - Vn N)).
+replace (Wn N - Vn N) with
+ (Wn N - Un (N + k2)%nat + (Un (N + k2)%nat - Vn N));
+ [ apply Rabs_triang | ring ].
+apply Rle_lt_trans with
+ (Rabs (Wn N - Un (N + k2)%nat) + Rabs (Un (N + k2)%nat - Un (N + k1)%nat) +
+ Rabs (Un (N + k1)%nat - Vn N)).
+rewrite Rplus_assoc.
+apply Rplus_le_compat_l.
+replace (Un (N + k2)%nat - Vn N) with
+ (Un (N + k2)%nat - Un (N + k1)%nat + (Un (N + k1)%nat - Vn N));
+ [ apply Rabs_triang | ring ].
+replace (3 * (eps / 5)) with (eps / 5 + eps / 5 + eps / 5);
+ [ repeat apply Rplus_lt_compat | ring ].
+assumption.
+apply H6.
+unfold ge in |- *.
+apply le_trans with N.
+unfold N in |- *; apply le_max_r.
+apply le_plus_l.
+unfold ge in |- *.
+apply le_trans with N.
+unfold N in |- *; apply le_max_r.
+apply le_plus_l.
+rewrite <- Rabs_Ropp.
+replace (- (Un (N + k1)%nat - Vn N)) with (Vn N - Un (N + k1)%nat);
+ [ assumption | ring ].
+reflexivity.
+reflexivity.
+apply H5.
+unfold ge in |- *; apply le_trans with (max N1 N2).
+apply le_max_r.
+unfold N in |- *; apply le_max_l.
+pattern eps at 4 in |- *; replace eps with (5 * (eps / 5)).
+ring.
+unfold Rdiv in |- *; rewrite <- Rmult_assoc; apply Rinv_r_simpl_m.
+discrR.
+unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+assumption.
+apply Rinv_0_lt_compat.
+prove_sup0; try apply lt_O_Sn.
+Qed. \ No newline at end of file
diff --git a/theories/Reals/Rdefinitions.v b/theories/Reals/Rdefinitions.v
index 75a082cfc..a862a0ac3 100644
--- a/theories/Reals/Rdefinitions.v
+++ b/theories/Reals/Rdefinitions.v
@@ -15,55 +15,55 @@
Require Export ZArith_base.
-Parameter R:Set.
+Parameter R : Set.
(* Declare Scope positive_scope with Key R *)
-Delimits Scope R_scope with R.
+Delimit Scope R_scope with R.
(* Automatically open scope R_scope for arguments of type R *)
Bind Scope R_scope with R.
-Parameter R0:R.
-Parameter R1:R.
-Parameter Rplus:R->R->R.
-Parameter Rmult:R->R->R.
-Parameter Ropp:R->R.
-Parameter Rinv:R->R.
-Parameter Rlt:R->R->Prop.
-Parameter up:R->Z.
+Parameter R0 : R.
+Parameter R1 : R.
+Parameter Rplus : R -> R -> R.
+Parameter Rmult : R -> R -> R.
+Parameter Ropp : R -> R.
+Parameter Rinv : R -> R.
+Parameter Rlt : R -> R -> Prop.
+Parameter up : R -> Z.
-V8Infix "+" Rplus : R_scope.
-V8Infix "*" Rmult : R_scope.
-V8Notation "- x" := (Ropp x) : R_scope.
-V8Notation "/ x" := (Rinv x) : R_scope.
+Infix "+" := Rplus : R_scope.
+Infix "*" := Rmult : R_scope.
+Notation "- x" := (Ropp x) : R_scope.
+Notation "/ x" := (Rinv x) : R_scope.
-V8Infix "<" Rlt : R_scope.
+Infix "<" := Rlt : R_scope.
(*i*******************************************************i*)
(**********)
-Definition Rgt:R->R->Prop:=[r1,r2:R](Rlt r2 r1).
+Definition Rgt (r1 r2:R) : Prop := (r2 < r1)%R.
(**********)
-Definition Rle:R->R->Prop:=[r1,r2:R]((Rlt r1 r2)\/(r1==r2)).
+Definition Rle (r1 r2:R) : Prop := (r1 < r2)%R \/ r1 = r2.
(**********)
-Definition Rge:R->R->Prop:=[r1,r2:R]((Rgt r1 r2)\/(r1==r2)).
+Definition Rge (r1 r2:R) : Prop := Rgt r1 r2 \/ r1 = r2.
(**********)
-Definition Rminus:R->R->R:=[r1,r2:R](Rplus r1 (Ropp r2)).
+Definition Rminus (r1 r2:R) : R := (r1 + - r2)%R.
(**********)
-Definition Rdiv:R->R->R:=[r1,r2:R](Rmult r1 (Rinv r2)).
+Definition Rdiv (r1 r2:R) : R := (r1 * / r2)%R.
-V8Infix "-" Rminus : R_scope.
-V8Infix "/" Rdiv : R_scope.
+Infix "-" := Rminus : R_scope.
+Infix "/" := Rdiv : R_scope.
-V8Infix "<=" Rle : R_scope.
-V8Infix ">=" Rge : R_scope.
-V8Infix ">" Rgt : R_scope.
+Infix "<=" := Rle : R_scope.
+Infix ">=" := Rge : R_scope.
+Infix ">" := Rgt : R_scope.
-V8Notation "x <= y <= z" := (Rle x y)/\(Rle y z) : R_scope.
-V8Notation "x <= y < z" := (Rle x y)/\(Rlt y z) : R_scope.
-V8Notation "x < y < z" := (Rlt x y)/\(Rlt y z) : R_scope.
-V8Notation "x < y <= z" := (Rlt x y)/\(Rle y z) : R_scope.
+Notation "x <= y <= z" := ((x <= y)%R /\ (y <= z)%R) : R_scope.
+Notation "x <= y < z" := ((x <= y)%R /\ (y < z)%R) : R_scope.
+Notation "x < y < z" := ((x < y)%R /\ (y < z)%R) : R_scope.
+Notation "x < y <= z" := ((x < y)%R /\ (y <= z)%R) : R_scope. \ No newline at end of file
diff --git a/theories/Reals/Rderiv.v b/theories/Reals/Rderiv.v
index 4f7420306..3f56ccdf1 100644
--- a/theories/Reals/Rderiv.v
+++ b/theories/Reals/Rderiv.v
@@ -13,441 +13,419 @@
(* *)
(*********************************************************)
-Require Rbase.
-Require Rfunctions.
-Require Rlimit.
-Require Fourier.
-Require Classical_Prop.
-Require Classical_Pred_Type.
-Require Omega.
-V7only [Import R_scope.]. Open Local Scope R_scope.
+Require Import Rbase.
+Require Import Rfunctions.
+Require Import Rlimit.
+Require Import Fourier.
+Require Import Classical_Prop.
+Require Import Classical_Pred_Type.
+Require Import Omega. Open Local Scope R_scope.
(*********)
-Definition D_x:(R->Prop)->R->R->Prop:=[D:R->Prop][y:R][x:R]
- (D x)/\(~y==x).
+Definition D_x (D:R -> Prop) (y x:R) : Prop := D x /\ y <> x.
(*********)
-Definition continue_in:(R->R)->(R->Prop)->R->Prop:=
- [f:R->R; D:R->Prop; x0:R](limit1_in f (D_x D x0) (f x0) x0).
+Definition continue_in (f:R -> R) (D:R -> Prop) (x0:R) : Prop :=
+ limit1_in f (D_x D x0) (f x0) x0.
(*********)
-Definition D_in:(R->R)->(R->R)->(R->Prop)->R->Prop:=
- [f:R->R; d:R->R; D:R->Prop; x0:R](limit1_in
- [x:R] (Rdiv (Rminus (f x) (f x0)) (Rminus x x0))
- (D_x D x0) (d x0) x0).
+Definition D_in (f d:R -> R) (D:R -> Prop) (x0:R) : Prop :=
+ limit1_in (fun x:R => (f x - f x0) / (x - x0)) (D_x D x0) (d x0) x0.
(*********)
-Lemma cont_deriv:(f,d:R->R;D:R->Prop;x0:R)
- (D_in f d D x0)->(continue_in f D x0).
-Unfold continue_in;Unfold D_in;Unfold limit1_in;Unfold limit_in;
- Unfold Rdiv;Simpl;Intros;Elim (H eps H0); Clear H;Intros;
- Elim H;Clear H;Intros; Elim (Req_EM (d x0) R0);Intro.
-Split with (Rmin R1 x);Split.
-Elim (Rmin_Rgt R1 x R0);Intros a b;
- Apply (b (conj (Rgt R1 R0) (Rgt x R0) Rlt_R0_R1 H)).
-Intros;Elim H3;Clear H3;Intros;
-Generalize (let (H1,H2)=(Rmin_Rgt R1 x (R_dist x1 x0)) in H1);
- Unfold Rgt;Intro;Elim (H5 H4);Clear H5;Intros;
- Generalize (H1 x1 (conj (D_x D x0 x1) (Rlt (R_dist x1 x0) x) H3 H6));
- Clear H1;Intro;Unfold D_x in H3;Elim H3;Intros.
-Rewrite H2 in H1;Unfold R_dist; Unfold R_dist in H1;
- Cut (Rlt (Rabsolu (Rminus (f x1) (f x0)))
- (Rmult eps (Rabsolu (Rminus x1 x0)))).
-Intro;Unfold R_dist in H5;
- Generalize (Rlt_monotony eps ``(Rabsolu (x1-x0))`` ``1`` H0 H5);
-Rewrite Rmult_1r;Intro;Apply Rlt_trans with r2:=``eps*(Rabsolu (x1-x0))``;
- Assumption.
-Rewrite (minus_R0 ``((f x1)-(f x0))*/(x1-x0)``) in H1;
- Rewrite Rabsolu_mult in H1; Cut ``x1-x0 <> 0``.
-Intro;Rewrite (Rabsolu_Rinv (Rminus x1 x0) H9) in H1;
- Generalize (Rlt_monotony ``(Rabsolu (x1-x0))``
- ``(Rabsolu ((f x1)-(f x0)))*/(Rabsolu (x1-x0))`` eps
- (Rabsolu_pos_lt ``x1-x0`` H9) H1);Intro; Rewrite Rmult_sym in H10;
- Rewrite Rmult_assoc in H10;Rewrite Rinv_l in H10.
-Rewrite Rmult_1r in H10;Rewrite Rmult_sym;Assumption.
-Apply Rabsolu_no_R0;Auto.
-Apply Rminus_eq_contra;Auto.
+Lemma cont_deriv :
+ forall (f d:R -> R) (D:R -> Prop) (x0:R),
+ D_in f d D x0 -> continue_in f D x0.
+unfold continue_in in |- *; unfold D_in in |- *; unfold limit1_in in |- *;
+ unfold limit_in in |- *; unfold Rdiv in |- *; simpl in |- *;
+ intros; elim (H eps H0); clear H; intros; elim H;
+ clear H; intros; elim (Req_dec (d x0) 0); intro.
+split with (Rmin 1 x); split.
+elim (Rmin_Rgt 1 x 0); intros a b; apply (b (conj Rlt_0_1 H)).
+intros; elim H3; clear H3; intros;
+ generalize (let (H1, H2) := Rmin_Rgt 1 x (R_dist x1 x0) in H1);
+ unfold Rgt in |- *; intro; elim (H5 H4); clear H5;
+ intros; generalize (H1 x1 (conj H3 H6)); clear H1;
+ intro; unfold D_x in H3; elim H3; intros.
+rewrite H2 in H1; unfold R_dist in |- *; unfold R_dist in H1;
+ cut (Rabs (f x1 - f x0) < eps * Rabs (x1 - x0)).
+intro; unfold R_dist in H5;
+ generalize (Rmult_lt_compat_l eps (Rabs (x1 - x0)) 1 H0 H5);
+ rewrite Rmult_1_r; intro; apply Rlt_trans with (r2 := eps * Rabs (x1 - x0));
+ assumption.
+rewrite (Rminus_0_r ((f x1 - f x0) * / (x1 - x0))) in H1;
+ rewrite Rabs_mult in H1; cut (x1 - x0 <> 0).
+intro; rewrite (Rabs_Rinv (x1 - x0) H9) in H1;
+ generalize
+ (Rmult_lt_compat_l (Rabs (x1 - x0)) (Rabs (f x1 - f x0) * / Rabs (x1 - x0))
+ eps (Rabs_pos_lt (x1 - x0) H9) H1); intro; rewrite Rmult_comm in H10;
+ rewrite Rmult_assoc in H10; rewrite Rinv_l in H10.
+rewrite Rmult_1_r in H10; rewrite Rmult_comm; assumption.
+apply Rabs_no_R0; auto.
+apply Rminus_eq_contra; auto.
(**)
- Split with (Rmin (Rmin (Rinv (Rplus R1 R1)) x)
- (Rmult eps (Rinv (Rabsolu (Rmult (Rplus R1 R1) (d x0))))));
- Split.
-Cut (Rgt (Rmin (Rinv (Rplus R1 R1)) x) R0).
-Cut (Rgt (Rmult eps (Rinv (Rabsolu (Rmult (Rplus R1 R1) (d x0))))) R0).
-Intros;Elim (Rmin_Rgt (Rmin (Rinv (Rplus R1 R1)) x)
- (Rmult eps (Rinv (Rabsolu (Rmult (Rplus R1 R1) (d x0))))) R0);
- Intros a b;
- Apply (b (conj (Rgt (Rmin (Rinv (Rplus R1 R1)) x) R0)
- (Rgt (Rmult eps (Rinv (Rabsolu (Rmult (Rplus R1 R1) (d x0))))) R0)
- H4 H3)).
-Apply Rmult_gt;Auto.
-Unfold Rgt;Apply Rlt_Rinv;Apply Rabsolu_pos_lt;Apply mult_non_zero;
- Split.
-DiscrR.
-Assumption.
-Elim (Rmin_Rgt (Rinv (Rplus R1 R1)) x R0);Intros a b;
- Cut (Rlt R0 (Rplus R1 R1)).
-Intro;Generalize (Rlt_Rinv (Rplus R1 R1) H3);Intro;
- Fold (Rgt (Rinv (Rplus R1 R1)) R0) in H4;
- Apply (b (conj (Rgt (Rinv (Rplus R1 R1)) R0) (Rgt x R0) H4 H)).
-Fourier.
-Intros;Elim H3;Clear H3;Intros;
- Generalize (let (H1,H2)=(Rmin_Rgt (Rmin (Rinv (Rplus R1 R1)) x)
- (Rmult eps (Rinv (Rabsolu (Rmult (Rplus R1 R1) (d x0)))))
- (R_dist x1 x0)) in H1);Unfold Rgt;Intro;Elim (H5 H4);Clear H5;
- Intros;
- Generalize (let (H1,H2)=(Rmin_Rgt (Rinv (Rplus R1 R1)) x
- (R_dist x1 x0)) in H1);Unfold Rgt;Intro;Elim (H7 H5);Clear H7;
- Intros;Clear H4 H5;
- Generalize (H1 x1 (conj (D_x D x0 x1) (Rlt (R_dist x1 x0) x) H3 H8));
- Clear H1;Intro;Unfold D_x in H3;Elim H3;Intros;
- Generalize (sym_not_eqT R x0 x1 H5);Clear H5;Intro H5;
- Generalize (Rminus_eq_contra x1 x0 H5);
- Intro;Generalize H1;Pattern 1 (d x0);
- Rewrite <-(let (H1,H2)=(Rmult_ne (d x0)) in H2);
- Rewrite <-(Rinv_l (Rminus x1 x0) H9); Unfold R_dist;Unfold 1 Rminus;
- Rewrite (Rmult_sym (Rminus (f x1) (f x0)) (Rinv (Rminus x1 x0)));
- Rewrite (Rmult_sym (Rmult (Rinv (Rminus x1 x0)) (Rminus x1 x0)) (d x0));
- Rewrite <-(Ropp_mul1 (d x0) (Rmult (Rinv (Rminus x1 x0)) (Rminus x1 x0)));
- Rewrite (Rmult_sym (Ropp (d x0))
- (Rmult (Rinv (Rminus x1 x0)) (Rminus x1 x0)));
- Rewrite (Rmult_assoc (Rinv (Rminus x1 x0)) (Rminus x1 x0) (Ropp (d x0)));
- Rewrite <-(Rmult_Rplus_distr (Rinv (Rminus x1 x0)) (Rminus (f x1) (f x0))
- (Rmult (Rminus x1 x0) (Ropp (d x0))));
- Rewrite (Rabsolu_mult (Rinv (Rminus x1 x0))
- (Rplus (Rminus (f x1) (f x0))
- (Rmult (Rminus x1 x0) (Ropp (d x0)))));
- Clear H1;Intro;Generalize (Rlt_monotony (Rabsolu (Rminus x1 x0))
- (Rmult (Rabsolu (Rinv (Rminus x1 x0)))
- (Rabsolu
- (Rplus (Rminus (f x1) (f x0))
- (Rmult (Rminus x1 x0) (Ropp (d x0)))))) eps
- (Rabsolu_pos_lt (Rminus x1 x0) H9) H1);
- Rewrite <-(Rmult_assoc (Rabsolu (Rminus x1 x0))
- (Rabsolu (Rinv (Rminus x1 x0)))
- (Rabsolu
- (Rplus (Rminus (f x1) (f x0))
- (Rmult (Rminus x1 x0) (Ropp (d x0))))));
- Rewrite (Rabsolu_Rinv (Rminus x1 x0) H9);
- Rewrite (Rinv_r (Rabsolu (Rminus x1 x0))
- (Rabsolu_no_R0 (Rminus x1 x0) H9));
- Rewrite (let (H1,H2)=(Rmult_ne (Rabsolu
- (Rplus (Rminus (f x1) (f x0))
- (Rmult (Rminus x1 x0) (Ropp (d x0)))))) in H2);
- Generalize (Rabsolu_triang_inv (Rminus (f x1) (f x0))
- (Rmult (Rminus x1 x0) (d x0)));Intro;
- Rewrite (Rmult_sym (Rminus x1 x0) (Ropp (d x0)));
- Rewrite (Ropp_mul1 (d x0) (Rminus x1 x0));
- Fold (Rminus (Rminus (f x1) (f x0)) (Rmult (d x0) (Rminus x1 x0)));
- Rewrite (Rmult_sym (Rminus x1 x0) (d x0)) in H10;
- Clear H1;Intro;Generalize (Rle_lt_trans
- (Rminus (Rabsolu (Rminus (f x1) (f x0)))
- (Rabsolu (Rmult (d x0) (Rminus x1 x0))))
- (Rabsolu
- (Rminus (Rminus (f x1) (f x0)) (Rmult (d x0) (Rminus x1 x0))))
- (Rmult (Rabsolu (Rminus x1 x0)) eps) H10 H1);
- Clear H1;Intro;
- Generalize (Rlt_compatibility (Rabsolu (Rmult (d x0) (Rminus x1 x0)))
- (Rminus (Rabsolu (Rminus (f x1) (f x0)))
- (Rabsolu (Rmult (d x0) (Rminus x1 x0))))
- (Rmult (Rabsolu (Rminus x1 x0)) eps) H1);
- Unfold 2 Rminus;Rewrite (Rplus_sym (Rabsolu (Rminus (f x1) (f x0)))
- (Ropp (Rabsolu (Rmult (d x0) (Rminus x1 x0)))));
- Rewrite <-(Rplus_assoc (Rabsolu (Rmult (d x0) (Rminus x1 x0)))
- (Ropp (Rabsolu (Rmult (d x0) (Rminus x1 x0))))
- (Rabsolu (Rminus (f x1) (f x0))));
- Rewrite (Rplus_Ropp_r (Rabsolu (Rmult (d x0) (Rminus x1 x0))));
- Rewrite (let (H1,H2)=(Rplus_ne (Rabsolu (Rminus (f x1) (f x0)))) in H2);
- Clear H1;Intro;Cut (Rlt (Rplus (Rabsolu (Rmult (d x0) (Rminus x1 x0)))
- (Rmult (Rabsolu (Rminus x1 x0)) eps)) eps).
-Intro;Apply (Rlt_trans (Rabsolu (Rminus (f x1) (f x0)))
- (Rplus (Rabsolu (Rmult (d x0) (Rminus x1 x0)))
- (Rmult (Rabsolu (Rminus x1 x0)) eps)) eps H1 H11).
-Clear H1 H5 H3 H10;Generalize (Rabsolu_pos_lt (d x0) H2);
- Intro;Unfold Rgt in H0;Generalize (Rlt_monotony eps (R_dist x1 x0)
- (Rinv (Rplus R1 R1)) H0 H7);Clear H7;Intro;
- Generalize (Rlt_monotony (Rabsolu (d x0)) (R_dist x1 x0)
- (Rmult eps (Rinv (Rabsolu (Rmult (Rplus R1 R1) (d x0))))) H1 H6);
- Clear H6;Intro;Rewrite (Rmult_sym eps (R_dist x1 x0)) in H3;
- Unfold R_dist in H3 H5;
- Rewrite <-(Rabsolu_mult (d x0) (Rminus x1 x0)) in H5;
- Rewrite (Rabsolu_mult (Rplus R1 R1) (d x0)) in H5;
- Cut ~(Rabsolu (Rplus R1 R1))==R0.
-Intro;Fold (Rgt (Rabsolu (d x0)) R0) in H1;
- Rewrite (Rinv_Rmult (Rabsolu (Rplus R1 R1)) (Rabsolu (d x0))
- H6 (imp_not_Req (Rabsolu (d x0)) R0
- (or_intror (Rlt (Rabsolu (d x0)) R0) (Rgt (Rabsolu (d x0)) R0) H1)))
- in H5;
- Rewrite (Rmult_sym (Rabsolu (d x0)) (Rmult eps
- (Rmult (Rinv (Rabsolu (Rplus R1 R1)))
- (Rinv (Rabsolu (d x0)))))) in H5;
- Rewrite <-(Rmult_assoc eps (Rinv (Rabsolu (Rplus R1 R1)))
- (Rinv (Rabsolu (d x0)))) in H5;
- Rewrite (Rmult_assoc (Rmult eps (Rinv (Rabsolu (Rplus R1 R1))))
- (Rinv (Rabsolu (d x0))) (Rabsolu (d x0))) in H5;
- Rewrite (Rinv_l (Rabsolu (d x0)) (imp_not_Req (Rabsolu (d x0)) R0
- (or_intror (Rlt (Rabsolu (d x0)) R0) (Rgt (Rabsolu (d x0)) R0) H1)))
- in H5;
- Rewrite (let (H1,H2)=(Rmult_ne (Rmult eps (Rinv (Rabsolu (Rplus R1 R1)))))
- in H1) in H5;Cut (Rabsolu (Rplus R1 R1))==(Rplus R1 R1).
-Intro;Rewrite H7 in H5;
- Generalize (Rplus_lt (Rabsolu (Rmult (d x0) (Rminus x1 x0)))
- (Rmult eps (Rinv (Rplus R1 R1)))
- (Rmult (Rabsolu (Rminus x1 x0)) eps)
- (Rmult eps (Rinv (Rplus R1 R1))) H5 H3);Intro;
- Rewrite eps2 in H10;Assumption.
-Unfold Rabsolu;Case (case_Rabsolu (Rplus R1 R1));Auto.
- Intro;Cut (Rlt R0 (Rplus R1 R1)).
-Intro;Generalize (Rlt_antisym R0 (Rplus R1 R1) H7);Intro;ElimType False;
- Auto.
-Fourier.
-Apply Rabsolu_no_R0.
-DiscrR.
+ split with (Rmin (Rmin (/ 2) x) (eps * / Rabs (2 * d x0))); split.
+cut (Rmin (/ 2) x > 0).
+cut (eps * / Rabs (2 * d x0) > 0).
+intros; elim (Rmin_Rgt (Rmin (/ 2) x) (eps * / Rabs (2 * d x0)) 0);
+ intros a b; apply (b (conj H4 H3)).
+apply Rmult_gt_0_compat; auto.
+unfold Rgt in |- *; apply Rinv_0_lt_compat; apply Rabs_pos_lt;
+ apply Rmult_integral_contrapositive; split.
+discrR.
+assumption.
+elim (Rmin_Rgt (/ 2) x 0); intros a b; cut (0 < 2).
+intro; generalize (Rinv_0_lt_compat 2 H3); intro; fold (/ 2 > 0) in H4;
+ apply (b (conj H4 H)).
+fourier.
+intros; elim H3; clear H3; intros;
+ generalize
+ (let (H1, H2) :=
+ Rmin_Rgt (Rmin (/ 2) x) (eps * / Rabs (2 * d x0)) (R_dist x1 x0) in
+ H1); unfold Rgt in |- *; intro; elim (H5 H4); clear H5;
+ intros; generalize (let (H1, H2) := Rmin_Rgt (/ 2) x (R_dist x1 x0) in H1);
+ unfold Rgt in |- *; intro; elim (H7 H5); clear H7;
+ intros; clear H4 H5; generalize (H1 x1 (conj H3 H8));
+ clear H1; intro; unfold D_x in H3; elim H3; intros;
+ generalize (sym_not_eq H5); clear H5; intro H5;
+ generalize (Rminus_eq_contra x1 x0 H5); intro; generalize H1;
+ pattern (d x0) at 1 in |- *;
+ rewrite <- (let (H1, H2) := Rmult_ne (d x0) in H2);
+ rewrite <- (Rinv_l (x1 - x0) H9); unfold R_dist in |- *;
+ unfold Rminus at 1 in |- *; rewrite (Rmult_comm (f x1 - f x0) (/ (x1 - x0)));
+ rewrite (Rmult_comm (/ (x1 - x0) * (x1 - x0)) (d x0));
+ rewrite <- (Ropp_mult_distr_l_reverse (d x0) (/ (x1 - x0) * (x1 - x0)));
+ rewrite (Rmult_comm (- d x0) (/ (x1 - x0) * (x1 - x0)));
+ rewrite (Rmult_assoc (/ (x1 - x0)) (x1 - x0) (- d x0));
+ rewrite <-
+ (Rmult_plus_distr_l (/ (x1 - x0)) (f x1 - f x0) ((x1 - x0) * - d x0))
+ ; rewrite (Rabs_mult (/ (x1 - x0)) (f x1 - f x0 + (x1 - x0) * - d x0));
+ clear H1; intro;
+ generalize
+ (Rmult_lt_compat_l (Rabs (x1 - x0))
+ (Rabs (/ (x1 - x0)) * Rabs (f x1 - f x0 + (x1 - x0) * - d x0)) eps
+ (Rabs_pos_lt (x1 - x0) H9) H1);
+ rewrite <-
+ (Rmult_assoc (Rabs (x1 - x0)) (Rabs (/ (x1 - x0)))
+ (Rabs (f x1 - f x0 + (x1 - x0) * - d x0)));
+ rewrite (Rabs_Rinv (x1 - x0) H9);
+ rewrite (Rinv_r (Rabs (x1 - x0)) (Rabs_no_R0 (x1 - x0) H9));
+ rewrite
+ (let (H1, H2) := Rmult_ne (Rabs (f x1 - f x0 + (x1 - x0) * - d x0)) in H2)
+ ; generalize (Rabs_triang_inv (f x1 - f x0) ((x1 - x0) * d x0));
+ intro; rewrite (Rmult_comm (x1 - x0) (- d x0));
+ rewrite (Ropp_mult_distr_l_reverse (d x0) (x1 - x0));
+ fold (f x1 - f x0 - d x0 * (x1 - x0)) in |- *;
+ rewrite (Rmult_comm (x1 - x0) (d x0)) in H10; clear H1;
+ intro;
+ generalize
+ (Rle_lt_trans (Rabs (f x1 - f x0) - Rabs (d x0 * (x1 - x0)))
+ (Rabs (f x1 - f x0 - d x0 * (x1 - x0))) (Rabs (x1 - x0) * eps) H10 H1);
+ clear H1; intro;
+ generalize
+ (Rplus_lt_compat_l (Rabs (d x0 * (x1 - x0)))
+ (Rabs (f x1 - f x0) - Rabs (d x0 * (x1 - x0))) (
+ Rabs (x1 - x0) * eps) H1); unfold Rminus at 2 in |- *;
+ rewrite (Rplus_comm (Rabs (f x1 - f x0)) (- Rabs (d x0 * (x1 - x0))));
+ rewrite <-
+ (Rplus_assoc (Rabs (d x0 * (x1 - x0))) (- Rabs (d x0 * (x1 - x0)))
+ (Rabs (f x1 - f x0))); rewrite (Rplus_opp_r (Rabs (d x0 * (x1 - x0))));
+ rewrite (let (H1, H2) := Rplus_ne (Rabs (f x1 - f x0)) in H2);
+ clear H1; intro; cut (Rabs (d x0 * (x1 - x0)) + Rabs (x1 - x0) * eps < eps).
+intro;
+ apply
+ (Rlt_trans (Rabs (f x1 - f x0))
+ (Rabs (d x0 * (x1 - x0)) + Rabs (x1 - x0) * eps) eps H1 H11).
+clear H1 H5 H3 H10; generalize (Rabs_pos_lt (d x0) H2); intro;
+ unfold Rgt in H0;
+ generalize (Rmult_lt_compat_l eps (R_dist x1 x0) (/ 2) H0 H7);
+ clear H7; intro;
+ generalize
+ (Rmult_lt_compat_l (Rabs (d x0)) (R_dist x1 x0) (
+ eps * / Rabs (2 * d x0)) H1 H6); clear H6; intro;
+ rewrite (Rmult_comm eps (R_dist x1 x0)) in H3; unfold R_dist in H3, H5;
+ rewrite <- (Rabs_mult (d x0) (x1 - x0)) in H5;
+ rewrite (Rabs_mult 2 (d x0)) in H5; cut (Rabs 2 <> 0).
+intro; fold (Rabs (d x0) > 0) in H1;
+ rewrite
+ (Rinv_mult_distr (Rabs 2) (Rabs (d x0)) H6
+ (Rlt_dichotomy_converse (Rabs (d x0)) 0 (or_intror (Rabs (d x0) < 0) H1)))
+ in H5;
+ rewrite (Rmult_comm (Rabs (d x0)) (eps * (/ Rabs 2 * / Rabs (d x0)))) in H5;
+ rewrite <- (Rmult_assoc eps (/ Rabs 2) (/ Rabs (d x0))) in H5;
+ rewrite (Rmult_assoc (eps * / Rabs 2) (/ Rabs (d x0)) (Rabs (d x0))) in H5;
+ rewrite
+ (Rinv_l (Rabs (d x0))
+ (Rlt_dichotomy_converse (Rabs (d x0)) 0 (or_intror (Rabs (d x0) < 0) H1)))
+ in H5; rewrite (let (H1, H2) := Rmult_ne (eps * / Rabs 2) in H1) in H5;
+ cut (Rabs 2 = 2).
+intro; rewrite H7 in H5;
+ generalize
+ (Rplus_lt_compat (Rabs (d x0 * (x1 - x0))) (eps * / 2)
+ (Rabs (x1 - x0) * eps) (eps * / 2) H5 H3); intro;
+ rewrite eps2 in H10; assumption.
+unfold Rabs in |- *; case (Rcase_abs 2); auto.
+ intro; cut (0 < 2).
+intro; generalize (Rlt_asym 0 2 H7); intro; elimtype False; auto.
+fourier.
+apply Rabs_no_R0.
+discrR.
Qed.
(*********)
-Lemma Dconst:(D:R->Prop)(y:R)(x0:R)(D_in [x:R]y [x:R]R0 D x0).
-Unfold D_in;Intros;Unfold limit1_in;Unfold limit_in;Unfold Rdiv;Intros;Simpl;
- Split with eps;Split;Auto.
-Intros;Rewrite (eq_Rminus y y (refl_eqT R y));
- Rewrite Rmult_Ol;Unfold R_dist;
- Rewrite (eq_Rminus R0 R0 (refl_eqT R R0));Unfold Rabsolu;
- Case (case_Rabsolu R0);Intro.
-Absurd (Rlt R0 R0);Auto.
-Red;Intro;Apply (Rlt_antirefl R0 H1).
-Unfold Rgt in H0;Assumption.
+Lemma Dconst :
+ forall (D:R -> Prop) (y x0:R), D_in (fun x:R => y) (fun x:R => 0) D x0.
+unfold D_in in |- *; intros; unfold limit1_in in |- *;
+ unfold limit_in in |- *; unfold Rdiv in |- *; intros;
+ simpl in |- *; split with eps; split; auto.
+intros; rewrite (Rminus_diag_eq y y (refl_equal y)); rewrite Rmult_0_l;
+ unfold R_dist in |- *; rewrite (Rminus_diag_eq 0 0 (refl_equal 0));
+ unfold Rabs in |- *; case (Rcase_abs 0); intro.
+absurd (0 < 0); auto.
+red in |- *; intro; apply (Rlt_irrefl 0 H1).
+unfold Rgt in H0; assumption.
Qed.
(*********)
-Lemma Dx:(D:R->Prop)(x0:R)(D_in [x:R]x [x:R]R1 D x0).
-Unfold D_in;Unfold Rdiv;Intros;Unfold limit1_in;Unfold limit_in;Intros;Simpl;
- Split with eps;Split;Auto.
-Intros;Elim H0;Clear H0;Intros;Unfold D_x in H0;
- Elim H0;Intros;
- Rewrite (Rinv_r (Rminus x x0) (Rminus_eq_contra x x0
- (sym_not_eqT R x0 x H3)));
- Unfold R_dist;
- Rewrite (eq_Rminus R1 R1 (refl_eqT R R1));Unfold Rabsolu;
- Case (case_Rabsolu R0);Intro.
-Absurd (Rlt R0 R0);Auto.
-Red;Intro;Apply (Rlt_antirefl R0 r).
-Unfold Rgt in H;Assumption.
+Lemma Dx :
+ forall (D:R -> Prop) (x0:R), D_in (fun x:R => x) (fun x:R => 1) D x0.
+unfold D_in in |- *; unfold Rdiv in |- *; intros; unfold limit1_in in |- *;
+ unfold limit_in in |- *; intros; simpl in |- *; split with eps;
+ split; auto.
+intros; elim H0; clear H0; intros; unfold D_x in H0; elim H0; intros;
+ rewrite (Rinv_r (x - x0) (Rminus_eq_contra x x0 (sym_not_eq H3)));
+ unfold R_dist in |- *; rewrite (Rminus_diag_eq 1 1 (refl_equal 1));
+ unfold Rabs in |- *; case (Rcase_abs 0); intro.
+absurd (0 < 0); auto.
+red in |- *; intro; apply (Rlt_irrefl 0 r).
+unfold Rgt in H; assumption.
Qed.
(*********)
-Lemma Dadd:(D:R->Prop)(df,dg:R->R)(f,g:R->R)(x0:R)
- (D_in f df D x0)->(D_in g dg D x0)->
- (D_in [x:R](Rplus (f x) (g x)) [x:R](Rplus (df x) (dg x)) D x0).
-Unfold D_in;Intros;Generalize (limit_plus
- [x:R](Rmult (Rminus (f x) (f x0)) (Rinv (Rminus x x0)))
- [x:R](Rmult (Rminus (g x) (g x0)) (Rinv (Rminus x x0)))
- (D_x D x0) (df x0) (dg x0) x0 H H0);Clear H H0;
- Unfold limit1_in;Unfold limit_in;Simpl;Intros;
- Elim (H eps H0);Clear H;Intros;Elim H;Clear H;Intros;
- Split with x;Split;Auto;Intros;Generalize (H1 x1 H2);Clear H1;Intro;
- Rewrite (Rmult_sym (Rminus (f x1) (f x0)) (Rinv (Rminus x1 x0))) in H1;
- Rewrite (Rmult_sym (Rminus (g x1) (g x0)) (Rinv (Rminus x1 x0))) in H1;
- Rewrite <-(Rmult_Rplus_distr (Rinv (Rminus x1 x0))
- (Rminus (f x1) (f x0))
- (Rminus (g x1) (g x0))) in H1;
- Rewrite (Rmult_sym (Rinv (Rminus x1 x0))
- (Rplus (Rminus (f x1) (f x0)) (Rminus (g x1) (g x0)))) in H1;
- Cut (Rplus (Rminus (f x1) (f x0)) (Rminus (g x1) (g x0)))==
- (Rminus (Rplus (f x1) (g x1)) (Rplus (f x0) (g x0))).
-Intro;Rewrite H3 in H1;Assumption.
-Ring.
+Lemma Dadd :
+ forall (D:R -> Prop) (df dg f g:R -> R) (x0:R),
+ D_in f df D x0 ->
+ D_in g dg D x0 ->
+ D_in (fun x:R => f x + g x) (fun x:R => df x + dg x) D x0.
+unfold D_in in |- *; intros;
+ generalize
+ (limit_plus (fun x:R => (f x - f x0) * / (x - x0))
+ (fun x:R => (g x - g x0) * / (x - x0)) (D_x D x0) (
+ df x0) (dg x0) x0 H H0); clear H H0; unfold limit1_in in |- *;
+ unfold limit_in in |- *; simpl in |- *; intros; elim (H eps H0);
+ clear H; intros; elim H; clear H; intros; split with x;
+ split; auto; intros; generalize (H1 x1 H2); clear H1;
+ intro; rewrite (Rmult_comm (f x1 - f x0) (/ (x1 - x0))) in H1;
+ rewrite (Rmult_comm (g x1 - g x0) (/ (x1 - x0))) in H1;
+ rewrite <- (Rmult_plus_distr_l (/ (x1 - x0)) (f x1 - f x0) (g x1 - g x0))
+ in H1;
+ rewrite (Rmult_comm (/ (x1 - x0)) (f x1 - f x0 + (g x1 - g x0))) in H1;
+ cut (f x1 - f x0 + (g x1 - g x0) = f x1 + g x1 - (f x0 + g x0)).
+intro; rewrite H3 in H1; assumption.
+ring.
Qed.
(*********)
-Lemma Dmult:(D:R->Prop)(df,dg:R->R)(f,g:R->R)(x0:R)
- (D_in f df D x0)->(D_in g dg D x0)->
- (D_in [x:R](Rmult (f x) (g x))
- [x:R](Rplus (Rmult (df x) (g x)) (Rmult (f x) (dg x))) D x0).
-Intros;Unfold D_in;Generalize H H0;Intros;Unfold D_in in H H0;
- Generalize (cont_deriv f df D x0 H1);Unfold continue_in;Intro;
- Generalize (limit_mul
- [x:R](Rmult (Rminus (g x) (g x0)) (Rinv (Rminus x x0)))
- [x:R](f x) (D_x D x0) (dg x0) (f x0) x0 H0 H3);Intro;
- Cut (limit1_in [x:R](g x0) (D_x D x0) (g x0) x0).
-Intro;Generalize (limit_mul
- [x:R](Rmult (Rminus (f x) (f x0)) (Rinv (Rminus x x0)))
- [_:R](g x0) (D_x D x0) (df x0) (g x0) x0 H H5);Clear H H0 H1 H2 H3 H5;
- Intro;Generalize (limit_plus
- [x:R](Rmult (Rmult (Rminus (f x) (f x0)) (Rinv (Rminus x x0))) (g x0))
- [x:R](Rmult (Rmult (Rminus (g x) (g x0)) (Rinv (Rminus x x0)))
- (f x)) (D_x D x0) (Rmult (df x0) (g x0))
- (Rmult (dg x0) (f x0)) x0 H H4);
- Clear H4 H;Intro;Unfold limit1_in in H;Unfold limit_in in H;
- Simpl in H;Unfold limit1_in;Unfold limit_in;Simpl;Intros;
- Elim (H eps H0);Clear H;Intros;Elim H;Clear H;Intros;
- Split with x;Split;Auto;Intros;Generalize (H1 x1 H2);Clear H1;Intro;
- Rewrite (Rmult_sym (Rminus (f x1) (f x0)) (Rinv (Rminus x1 x0))) in H1;
- Rewrite (Rmult_sym (Rminus (g x1) (g x0)) (Rinv (Rminus x1 x0))) in H1;
- Rewrite (Rmult_assoc (Rinv (Rminus x1 x0)) (Rminus (f x1) (f x0))
- (g x0)) in H1;
- Rewrite (Rmult_assoc (Rinv (Rminus x1 x0)) (Rminus (g x1) (g x0))
- (f x1)) in H1;
- Rewrite <-(Rmult_Rplus_distr (Rinv (Rminus x1 x0))
- (Rmult (Rminus (f x1) (f x0)) (g x0))
- (Rmult (Rminus (g x1) (g x0)) (f x1))) in H1;
- Rewrite (Rmult_sym (Rinv (Rminus x1 x0))
- (Rplus (Rmult (Rminus (f x1) (f x0)) (g x0))
- (Rmult (Rminus (g x1) (g x0)) (f x1)))) in H1;
- Rewrite (Rmult_sym (dg x0) (f x0)) in H1;
- Cut (Rplus (Rmult (Rminus (f x1) (f x0)) (g x0))
- (Rmult (Rminus (g x1) (g x0)) (f x1)))==
- (Rminus (Rmult (f x1) (g x1)) (Rmult (f x0) (g x0))).
-Intro;Rewrite H3 in H1;Assumption.
-Ring.
-Unfold limit1_in;Unfold limit_in;Simpl;Intros;
- Split with eps;Split;Auto;Intros;Elim (R_dist_refl (g x0) (g x0));
- Intros a b;Rewrite (b (refl_eqT R (g x0)));Unfold Rgt in H;Assumption.
+Lemma Dmult :
+ forall (D:R -> Prop) (df dg f g:R -> R) (x0:R),
+ D_in f df D x0 ->
+ D_in g dg D x0 ->
+ D_in (fun x:R => f x * g x) (fun x:R => df x * g x + f x * dg x) D x0.
+intros; unfold D_in in |- *; generalize H H0; intros; unfold D_in in H, H0;
+ generalize (cont_deriv f df D x0 H1); unfold continue_in in |- *;
+ intro;
+ generalize
+ (limit_mul (fun x:R => (g x - g x0) * / (x - x0)) (
+ fun x:R => f x) (D_x D x0) (dg x0) (f x0) x0 H0 H3);
+ intro; cut (limit1_in (fun x:R => g x0) (D_x D x0) (g x0) x0).
+intro;
+ generalize
+ (limit_mul (fun x:R => (f x - f x0) * / (x - x0)) (
+ fun _:R => g x0) (D_x D x0) (df x0) (g x0) x0 H H5);
+ clear H H0 H1 H2 H3 H5; intro;
+ generalize
+ (limit_plus (fun x:R => (f x - f x0) * / (x - x0) * g x0)
+ (fun x:R => (g x - g x0) * / (x - x0) * f x) (
+ D_x D x0) (df x0 * g x0) (dg x0 * f x0) x0 H H4);
+ clear H4 H; intro; unfold limit1_in in H; unfold limit_in in H;
+ simpl in H; unfold limit1_in in |- *; unfold limit_in in |- *;
+ simpl in |- *; intros; elim (H eps H0); clear H; intros;
+ elim H; clear H; intros; split with x; split; auto;
+ intros; generalize (H1 x1 H2); clear H1; intro;
+ rewrite (Rmult_comm (f x1 - f x0) (/ (x1 - x0))) in H1;
+ rewrite (Rmult_comm (g x1 - g x0) (/ (x1 - x0))) in H1;
+ rewrite (Rmult_assoc (/ (x1 - x0)) (f x1 - f x0) (g x0)) in H1;
+ rewrite (Rmult_assoc (/ (x1 - x0)) (g x1 - g x0) (f x1)) in H1;
+ rewrite <-
+ (Rmult_plus_distr_l (/ (x1 - x0)) ((f x1 - f x0) * g x0)
+ ((g x1 - g x0) * f x1)) in H1;
+ rewrite
+ (Rmult_comm (/ (x1 - x0)) ((f x1 - f x0) * g x0 + (g x1 - g x0) * f x1))
+ in H1; rewrite (Rmult_comm (dg x0) (f x0)) in H1;
+ cut
+ ((f x1 - f x0) * g x0 + (g x1 - g x0) * f x1 = f x1 * g x1 - f x0 * g x0).
+intro; rewrite H3 in H1; assumption.
+ring.
+unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; intros;
+ split with eps; split; auto; intros; elim (R_dist_refl (g x0) (g x0));
+ intros a b; rewrite (b (refl_equal (g x0))); unfold Rgt in H;
+ assumption.
Qed.
(*********)
-Lemma Dmult_const:(D:R->Prop)(f,df:R->R)(x0:R)(a:R)(D_in f df D x0)->
- (D_in [x:R](Rmult a (f x)) ([x:R](Rmult a (df x))) D x0).
-Intros;Generalize (Dmult D [_:R]R0 df [_:R]a f x0 (Dconst D a x0) H);
- Unfold D_in;Intros;
- Rewrite (Rmult_Ol (f x0)) in H0;
- Rewrite (let (H1,H2)=(Rplus_ne (Rmult a (df x0))) in H2) in H0;
- Assumption.
+Lemma Dmult_const :
+ forall (D:R -> Prop) (f df:R -> R) (x0 a:R),
+ D_in f df D x0 -> D_in (fun x:R => a * f x) (fun x:R => a * df x) D x0.
+intros;
+ generalize (Dmult D (fun _:R => 0) df (fun _:R => a) f x0 (Dconst D a x0) H);
+ unfold D_in in |- *; intros; rewrite (Rmult_0_l (f x0)) in H0;
+ rewrite (let (H1, H2) := Rplus_ne (a * df x0) in H2) in H0;
+ assumption.
Qed.
(*********)
-Lemma Dopp:(D:R->Prop)(f,df:R->R)(x0:R)(D_in f df D x0)->
- (D_in [x:R](Ropp (f x)) ([x:R](Ropp (df x))) D x0).
-Intros;Generalize (Dmult_const D f df x0 (Ropp R1) H); Unfold D_in;
- Unfold limit1_in;Unfold limit_in;Intros;
- Generalize (H0 eps H1);Clear H0;Intro;Elim H0;Clear H0;Intros;
- Elim H0;Clear H0;Simpl;Intros;Split with x;Split;Auto.
-Intros;Generalize (H2 x1 H3);Clear H2;Intro;Rewrite Ropp_mul1 in H2;
- Rewrite Ropp_mul1 in H2;Rewrite Ropp_mul1 in H2;
- Rewrite (let (H1,H2)=(Rmult_ne (f x1)) in H2) in H2;
- Rewrite (let (H1,H2)=(Rmult_ne (f x0)) in H2) in H2;
- Rewrite (let (H1,H2)=(Rmult_ne (df x0)) in H2) in H2;Assumption.
+Lemma Dopp :
+ forall (D:R -> Prop) (f df:R -> R) (x0:R),
+ D_in f df D x0 -> D_in (fun x:R => - f x) (fun x:R => - df x) D x0.
+intros; generalize (Dmult_const D f df x0 (-1) H); unfold D_in in |- *;
+ unfold limit1_in in |- *; unfold limit_in in |- *;
+ intros; generalize (H0 eps H1); clear H0; intro; elim H0;
+ clear H0; intros; elim H0; clear H0; simpl in |- *;
+ intros; split with x; split; auto.
+intros; generalize (H2 x1 H3); clear H2; intro;
+ rewrite Ropp_mult_distr_l_reverse in H2;
+ rewrite Ropp_mult_distr_l_reverse in H2;
+ rewrite Ropp_mult_distr_l_reverse in H2;
+ rewrite (let (H1, H2) := Rmult_ne (f x1) in H2) in H2;
+ rewrite (let (H1, H2) := Rmult_ne (f x0) in H2) in H2;
+ rewrite (let (H1, H2) := Rmult_ne (df x0) in H2) in H2;
+ assumption.
Qed.
(*********)
-Lemma Dminus:(D:R->Prop)(df,dg:R->R)(f,g:R->R)(x0:R)
- (D_in f df D x0)->(D_in g dg D x0)->
- (D_in [x:R](Rminus (f x) (g x)) [x:R](Rminus (df x) (dg x)) D x0).
-Unfold Rminus;Intros;Generalize (Dopp D g dg x0 H0);Intro;
- Apply (Dadd D df [x:R](Ropp (dg x)) f [x:R](Ropp (g x)) x0);Assumption.
+Lemma Dminus :
+ forall (D:R -> Prop) (df dg f g:R -> R) (x0:R),
+ D_in f df D x0 ->
+ D_in g dg D x0 ->
+ D_in (fun x:R => f x - g x) (fun x:R => df x - dg x) D x0.
+unfold Rminus in |- *; intros; generalize (Dopp D g dg x0 H0); intro;
+ apply (Dadd D df (fun x:R => - dg x) f (fun x:R => - g x) x0);
+ assumption.
Qed.
(*********)
-Lemma Dx_pow_n:(n:nat)(D:R->Prop)(x0:R)
- (D_in [x:R](pow x n)
- [x:R](Rmult (INR n) (pow x (minus n (1)))) D x0).
-Induction n;Intros.
-Simpl; Rewrite Rmult_Ol; Apply Dconst.
-Intros;Cut n0=(minus (S n0) (1));
- [ Intro a; Rewrite <- a;Clear a | Simpl; Apply minus_n_O ].
-Generalize (Dmult D [_:R]R1
- [x:R](Rmult (INR n0) (pow x (minus n0 (1)))) [x:R]x [x:R](pow x n0)
- x0 (Dx D x0) (H D x0));Unfold D_in;Unfold limit1_in;Unfold limit_in;
- Simpl;Intros;
- Elim (H0 eps H1);Clear H0;Intros;Elim H0;Clear H0;Intros;
- Split with x;Split;Auto.
-Intros;Generalize (H2 x1 H3);Clear H2 H3;Intro;
- Rewrite (let (H1,H2)=(Rmult_ne (pow x0 n0)) in H2) in H2;
- Rewrite (tech_pow_Rmult x1 n0) in H2;
- Rewrite (tech_pow_Rmult x0 n0) in H2;
- Rewrite (Rmult_sym (INR n0) (pow x0 (minus n0 (1)))) in H2;
- Rewrite <-(Rmult_assoc x0 (pow x0 (minus n0 (1))) (INR n0)) in H2;
- Rewrite (tech_pow_Rmult x0 (minus n0 (1))) in H2;
- Elim (classic (n0=O));Intro cond.
-Rewrite cond in H2;Rewrite cond;Simpl in H2;Simpl;
- Cut (Rplus R1 (Rmult (Rmult x0 R1) R0))==(Rmult R1 R1);
- [Intro A; Rewrite A in H2; Assumption|Ring].
-Cut ~(n0=O)->(S (minus n0 (1)))=n0;[Intro|Omega];
- Rewrite (H3 cond) in H2; Rewrite (Rmult_sym (pow x0 n0) (INR n0)) in H2;
- Rewrite (tech_pow_Rplus x0 n0 n0) in H2; Assumption.
+Lemma Dx_pow_n :
+ forall (n:nat) (D:R -> Prop) (x0:R),
+ D_in (fun x:R => x ^ n) (fun x:R => INR n * x ^ (n - 1)) D x0.
+simple induction n; intros.
+simpl in |- *; rewrite Rmult_0_l; apply Dconst.
+intros; cut (n0 = (S n0 - 1)%nat);
+ [ intro a; rewrite <- a; clear a | simpl in |- *; apply minus_n_O ].
+generalize
+ (Dmult D (fun _:R => 1) (fun x:R => INR n0 * x ^ (n0 - 1)) (
+ fun x:R => x) (fun x:R => x ^ n0) x0 (Dx D x0) (
+ H D x0)); unfold D_in in |- *; unfold limit1_in in |- *;
+ unfold limit_in in |- *; simpl in |- *; intros; elim (H0 eps H1);
+ clear H0; intros; elim H0; clear H0; intros; split with x;
+ split; auto.
+intros; generalize (H2 x1 H3); clear H2 H3; intro;
+ rewrite (let (H1, H2) := Rmult_ne (x0 ^ n0) in H2) in H2;
+ rewrite (tech_pow_Rmult x1 n0) in H2; rewrite (tech_pow_Rmult x0 n0) in H2;
+ rewrite (Rmult_comm (INR n0) (x0 ^ (n0 - 1))) in H2;
+ rewrite <- (Rmult_assoc x0 (x0 ^ (n0 - 1)) (INR n0)) in H2;
+ rewrite (tech_pow_Rmult x0 (n0 - 1)) in H2; elim (classic (n0 = 0%nat));
+ intro cond.
+rewrite cond in H2; rewrite cond; simpl in H2; simpl in |- *;
+ cut (1 + x0 * 1 * 0 = 1 * 1);
+ [ intro A; rewrite A in H2; assumption | ring ].
+cut (n0 <> 0%nat -> S (n0 - 1) = n0); [ intro | omega ];
+ rewrite (H3 cond) in H2; rewrite (Rmult_comm (x0 ^ n0) (INR n0)) in H2;
+ rewrite (tech_pow_Rplus x0 n0 n0) in H2; assumption.
Qed.
(*********)
-Lemma Dcomp:(Df,Dg:R->Prop)(df,dg:R->R)(f,g:R->R)(x0:R)
- (D_in f df Df x0)->(D_in g dg Dg (f x0))->
- (D_in [x:R](g (f x)) [x:R](Rmult (df x) (dg (f x)))
- (Dgf Df Dg f) x0).
-Intros Df Dg df dg f g x0 H H0;Generalize H H0;Unfold D_in;Unfold Rdiv;Intros;
-Generalize (limit_comp f [x:R](Rmult (Rminus (g x) (g (f x0)))
- (Rinv (Rminus x (f x0)))) (D_x Df x0)
- (D_x Dg (f x0))
- (f x0) (dg (f x0)) x0);Intro;
- Generalize (cont_deriv f df Df x0 H);Intro;Unfold continue_in in H4;
- Generalize (H3 H4 H2);Clear H3;Intro;
- Generalize (limit_mul [x:R](Rmult (Rminus (g (f x)) (g (f x0)))
- (Rinv (Rminus (f x) (f x0))))
- [x:R](Rmult (Rminus (f x) (f x0))
- (Rinv (Rminus x x0)))
- (Dgf (D_x Df x0) (D_x Dg (f x0)) f)
- (dg (f x0)) (df x0) x0 H3);Intro;
- Cut (limit1_in
- [x:R](Rmult (Rminus (f x) (f x0)) (Rinv (Rminus x x0)))
- (Dgf (D_x Df x0) (D_x Dg (f x0)) f) (df x0) x0).
-Intro;Generalize (H5 H6);Clear H5;Intro;
- Generalize (limit_mul
- [x:R](Rmult (Rminus (f x) (f x0)) (Rinv (Rminus x x0)))
- [x:R](dg (f x0))
- (D_x Df x0) (df x0) (dg (f x0)) x0 H1
- (limit_free [x:R](dg (f x0)) (D_x Df x0) x0 x0));
- Intro;
- Unfold limit1_in;Unfold limit_in;Simpl;Unfold limit1_in in H5 H7;
- Unfold limit_in in H5 H7;Simpl in H5 H7;Intros;Elim (H5 eps H8);
- Elim (H7 eps H8);Clear H5 H7;Intros;Elim H5;Elim H7;Clear H5 H7;
- Intros;Split with (Rmin x x1);Split.
-Elim (Rmin_Rgt x x1 R0);Intros a b;
- Apply (b (conj (Rgt x R0) (Rgt x1 R0) H9 H5));Clear a b.
-Intros;Elim H11;Clear H11;Intros;Elim (Rmin_Rgt x x1 (R_dist x2 x0));
- Intros a b;Clear b;Unfold Rgt in a;Elim (a H12);Clear H5 a;Intros;
- Unfold D_x Dgf in H11 H7 H10;Clear H12;
- Elim (classic (f x2)==(f x0));Intro.
-Elim H11;Clear H11;Intros;Elim H11;Clear H11;Intros;
- Generalize (H10 x2 (conj (Df x2)/\~x0==x2 (Rlt (R_dist x2 x0) x)
- (conj (Df x2) ~x0==x2 H11 H14) H5));Intro;
- Rewrite (eq_Rminus (f x2) (f x0) H12) in H16;
- Rewrite (Rmult_Ol (Rinv (Rminus x2 x0))) in H16;
- Rewrite (Rmult_Ol (dg (f x0))) in H16;
- Rewrite H12;
- Rewrite (eq_Rminus (g (f x0)) (g (f x0)) (refl_eqT R (g (f x0))));
- Rewrite (Rmult_Ol (Rinv (Rminus x2 x0)));Assumption.
-Clear H10 H5;Elim H11;Clear H11;Intros;Elim H5;Clear H5;Intros;
-Cut (((Df x2)/\~x0==x2)/\(Dg (f x2))/\~(f x0)==(f x2))
- /\(Rlt (R_dist x2 x0) x1);Auto;Intro;
- Generalize (H7 x2 H14);Intro;
- Generalize (Rminus_eq_contra (f x2) (f x0) H12);Intro;
- Rewrite (Rmult_assoc (Rminus (g (f x2)) (g (f x0)))
- (Rinv (Rminus (f x2) (f x0)))
- (Rmult (Rminus (f x2) (f x0)) (Rinv (Rminus x2 x0)))) in H15;
- Rewrite <-(Rmult_assoc (Rinv (Rminus (f x2) (f x0)))
- (Rminus (f x2) (f x0)) (Rinv (Rminus x2 x0))) in H15;
- Rewrite (Rinv_l (Rminus (f x2) (f x0)) H16) in H15;
- Rewrite (let (H1,H2)=(Rmult_ne (Rinv (Rminus x2 x0))) in H2) in H15;
- Rewrite (Rmult_sym (df x0) (dg (f x0)));Assumption.
-Clear H5 H3 H4 H2;Unfold limit1_in;Unfold limit_in;Simpl;
- Unfold limit1_in in H1;Unfold limit_in in H1;Simpl in H1;Intros;
- Elim (H1 eps H2);Clear H1;Intros;Elim H1;Clear H1;Intros;
- Split with x;Split;Auto;Intros;Unfold D_x Dgf in H4 H3;
- Elim H4;Clear H4;Intros;Elim H4;Clear H4;Intros;
- Exact (H3 x1 (conj (Df x1)/\~x0==x1 (Rlt (R_dist x1 x0) x) H4 H5)).
+Lemma Dcomp :
+ forall (Df Dg:R -> Prop) (df dg f g:R -> R) (x0:R),
+ D_in f df Df x0 ->
+ D_in g dg Dg (f x0) ->
+ D_in (fun x:R => g (f x)) (fun x:R => df x * dg (f x)) (Dgf Df Dg f) x0.
+intros Df Dg df dg f g x0 H H0; generalize H H0; unfold D_in in |- *;
+ unfold Rdiv in |- *; intros;
+ generalize
+ (limit_comp f (fun x:R => (g x - g (f x0)) * / (x - f x0)) (
+ D_x Df x0) (D_x Dg (f x0)) (f x0) (dg (f x0)) x0);
+ intro; generalize (cont_deriv f df Df x0 H); intro;
+ unfold continue_in in H4; generalize (H3 H4 H2); clear H3;
+ intro;
+ generalize
+ (limit_mul (fun x:R => (g (f x) - g (f x0)) * / (f x - f x0))
+ (fun x:R => (f x - f x0) * / (x - x0))
+ (Dgf (D_x Df x0) (D_x Dg (f x0)) f) (dg (f x0)) (
+ df x0) x0 H3); intro;
+ cut
+ (limit1_in (fun x:R => (f x - f x0) * / (x - x0))
+ (Dgf (D_x Df x0) (D_x Dg (f x0)) f) (df x0) x0).
+intro; generalize (H5 H6); clear H5; intro;
+ generalize
+ (limit_mul (fun x:R => (f x - f x0) * / (x - x0)) (
+ fun x:R => dg (f x0)) (D_x Df x0) (df x0) (dg (f x0)) x0 H1
+ (limit_free (fun x:R => dg (f x0)) (D_x Df x0) x0 x0));
+ intro; unfold limit1_in in |- *; unfold limit_in in |- *;
+ simpl in |- *; unfold limit1_in in H5, H7; unfold limit_in in H5, H7;
+ simpl in H5, H7; intros; elim (H5 eps H8); elim (H7 eps H8);
+ clear H5 H7; intros; elim H5; elim H7; clear H5 H7;
+ intros; split with (Rmin x x1); split.
+elim (Rmin_Rgt x x1 0); intros a b; apply (b (conj H9 H5)); clear a b.
+intros; elim H11; clear H11; intros; elim (Rmin_Rgt x x1 (R_dist x2 x0));
+ intros a b; clear b; unfold Rgt in a; elim (a H12);
+ clear H5 a; intros; unfold D_x, Dgf in H11, H7, H10;
+ clear H12; elim (classic (f x2 = f x0)); intro.
+elim H11; clear H11; intros; elim H11; clear H11; intros;
+ generalize (H10 x2 (conj (conj H11 H14) H5)); intro;
+ rewrite (Rminus_diag_eq (f x2) (f x0) H12) in H16;
+ rewrite (Rmult_0_l (/ (x2 - x0))) in H16;
+ rewrite (Rmult_0_l (dg (f x0))) in H16; rewrite H12;
+ rewrite (Rminus_diag_eq (g (f x0)) (g (f x0)) (refl_equal (g (f x0))));
+ rewrite (Rmult_0_l (/ (x2 - x0))); assumption.
+clear H10 H5; elim H11; clear H11; intros; elim H5; clear H5; intros;
+ cut
+ (((Df x2 /\ x0 <> x2) /\ Dg (f x2) /\ f x0 <> f x2) /\ R_dist x2 x0 < x1);
+ auto; intro; generalize (H7 x2 H14); intro;
+ generalize (Rminus_eq_contra (f x2) (f x0) H12); intro;
+ rewrite
+ (Rmult_assoc (g (f x2) - g (f x0)) (/ (f x2 - f x0))
+ ((f x2 - f x0) * / (x2 - x0))) in H15;
+ rewrite <- (Rmult_assoc (/ (f x2 - f x0)) (f x2 - f x0) (/ (x2 - x0)))
+ in H15; rewrite (Rinv_l (f x2 - f x0) H16) in H15;
+ rewrite (let (H1, H2) := Rmult_ne (/ (x2 - x0)) in H2) in H15;
+ rewrite (Rmult_comm (df x0) (dg (f x0))); assumption.
+clear H5 H3 H4 H2; unfold limit1_in in |- *; unfold limit_in in |- *;
+ simpl in |- *; unfold limit1_in in H1; unfold limit_in in H1;
+ simpl in H1; intros; elim (H1 eps H2); clear H1; intros;
+ elim H1; clear H1; intros; split with x; split; auto;
+ intros; unfold D_x, Dgf in H4, H3; elim H4; clear H4;
+ intros; elim H4; clear H4; intros; exact (H3 x1 (conj H4 H5)).
Qed.
(*********)
-Lemma D_pow_n:(n:nat)(D:R->Prop)(x0:R)(expr,dexpr:R->R)
- (D_in expr dexpr D x0)-> (D_in [x:R](pow (expr x) n)
- [x:R](Rmult (Rmult (INR n) (pow (expr x) (minus n (1)))) (dexpr x))
- (Dgf D D expr) x0).
-Intros n D x0 expr dexpr H;
- Generalize (Dcomp D D dexpr [x:R](Rmult (INR n) (pow x (minus n (1))))
- expr [x:R](pow x n) x0 H (Dx_pow_n n D (expr x0)));
- Intro; Unfold D_in; Unfold limit1_in; Unfold limit_in;Simpl;Intros;
- Unfold D_in in H0; Unfold limit1_in in H0; Unfold limit_in in H0;Simpl in H0;
- Elim (H0 eps H1);Clear H0;Intros;Elim H0;Clear H0;Intros;Split with x;Split;
- Intros; Auto.
-Cut ``((dexpr x0)*((INR n)*(pow (expr x0) (minus n (S O)))))==
- ((INR n)*(pow (expr x0) (minus n (S O)))*(dexpr x0))``;
- [Intro Rew;Rewrite <- Rew;Exact (H2 x1 H3)|Ring].
+Lemma D_pow_n :
+ forall (n:nat) (D:R -> Prop) (x0:R) (expr dexpr:R -> R),
+ D_in expr dexpr D x0 ->
+ D_in (fun x:R => expr x ^ n)
+ (fun x:R => INR n * expr x ^ (n - 1) * dexpr x) (
+ Dgf D D expr) x0.
+intros n D x0 expr dexpr H;
+ generalize
+ (Dcomp D D dexpr (fun x:R => INR n * x ^ (n - 1)) expr (
+ fun x:R => x ^ n) x0 H (Dx_pow_n n D (expr x0)));
+ intro; unfold D_in in |- *; unfold limit1_in in |- *;
+ unfold limit_in in |- *; simpl in |- *; intros; unfold D_in in H0;
+ unfold limit1_in in H0; unfold limit_in in H0; simpl in H0;
+ elim (H0 eps H1); clear H0; intros; elim H0; clear H0;
+ intros; split with x; split; intros; auto.
+cut
+ (dexpr x0 * (INR n * expr x0 ^ (n - 1)) =
+ INR n * expr x0 ^ (n - 1) * dexpr x0);
+ [ intro Rew; rewrite <- Rew; exact (H2 x1 H3) | ring ].
Qed.
-
diff --git a/theories/Reals/Reals.v b/theories/Reals/Reals.v
index db6df635c..6e10fa8f1 100644
--- a/theories/Reals/Reals.v
+++ b/theories/Reals/Reals.v
@@ -29,4 +29,4 @@ Require Export Rfunctions.
Require Export SeqSeries.
Require Export Rtrigo.
Require Export Ranalysis.
-Require Export Integration.
+Require Export Integration. \ No newline at end of file
diff --git a/theories/Reals/Rfunctions.v b/theories/Reals/Rfunctions.v
index b283b9fd8..30b4a5396 100644
--- a/theories/Reals/Rfunctions.v
+++ b/theories/Reals/Rfunctions.v
@@ -16,16 +16,15 @@
(* *)
(********************************************************)
-Require Rbase.
+Require Import Rbase.
Require Export R_Ifp.
Require Export Rbasic_fun.
Require Export R_sqr.
Require Export SplitAbsolu.
Require Export SplitRmult.
Require Export ArithProp.
-Require Omega.
-Require Zpower.
-V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
+Require Import Omega.
+Require Import Zpower.
Open Local Scope nat_scope.
Open Local Scope R_scope.
@@ -33,522 +32,491 @@ Open Local Scope R_scope.
(** Lemmas about factorial *)
(*******************************)
(*********)
-Lemma INR_fact_neq_0:(n:nat)~(INR (fact n))==R0.
+Lemma INR_fact_neq_0 : forall n:nat, INR (fact n) <> 0.
Proof.
-Intro;Red;Intro;Apply (not_O_INR (fact n) (fact_neq_0 n));Assumption.
+intro; red in |- *; intro; apply (not_O_INR (fact n) (fact_neq_0 n));
+ assumption.
Qed.
(*********)
-Lemma fact_simpl : (n:nat) (fact (S n))=(mult (S n) (fact n)).
+Lemma fact_simpl : forall n:nat, fact (S n) = (S n * fact n)%nat.
Proof.
-Intro; Reflexivity.
+intro; reflexivity.
Qed.
(*********)
-Lemma simpl_fact:(n:nat)(Rmult (Rinv (INR (fact (S n))))
- (Rinv (Rinv (INR (fact n)))))==
- (Rinv (INR (S n))).
+Lemma simpl_fact :
+ forall n:nat, / INR (fact (S n)) * / / INR (fact n) = / INR (S n).
Proof.
-Intro;Rewrite (Rinv_Rinv (INR (fact n)) (INR_fact_neq_0 n));
- Unfold 1 fact;Cbv Beta Iota;Fold fact;
- Rewrite (mult_INR (S n) (fact n));
- Rewrite (Rinv_Rmult (INR (S n)) (INR (fact n))).
-Rewrite (Rmult_assoc (Rinv (INR (S n))) (Rinv (INR (fact n)))
- (INR (fact n)));Rewrite (Rinv_l (INR (fact n)) (INR_fact_neq_0 n));
- Apply (let (H1,H2)=(Rmult_ne (Rinv (INR (S n)))) in H1).
-Apply not_O_INR;Auto.
-Apply INR_fact_neq_0.
+intro; rewrite (Rinv_involutive (INR (fact n)) (INR_fact_neq_0 n));
+ unfold fact at 1 in |- *; cbv beta iota in |- *; fold fact in |- *;
+ rewrite (mult_INR (S n) (fact n));
+ rewrite (Rinv_mult_distr (INR (S n)) (INR (fact n))).
+rewrite (Rmult_assoc (/ INR (S n)) (/ INR (fact n)) (INR (fact n)));
+ rewrite (Rinv_l (INR (fact n)) (INR_fact_neq_0 n));
+ apply (let (H1, H2) := Rmult_ne (/ INR (S n)) in H1).
+apply not_O_INR; auto.
+apply INR_fact_neq_0.
Qed.
(*******************************)
(* Power *)
(*******************************)
(*********)
-Fixpoint pow [r:R;n:nat]:R:=
- Cases n of
- O => R1
- |(S n) => (Rmult r (pow r n))
+Fixpoint pow (r:R) (n:nat) {struct n} : R :=
+ match n with
+ | O => 1
+ | S n => r * pow r n
end.
-Infix "^" pow (at level 2, left associativity) : R_scope V8only.
+Infix "^" := pow : R_scope.
-Lemma pow_O: (x : R) (pow x O) == R1.
+Lemma pow_O : forall x:R, x ^ 0 = 1.
Proof.
-Reflexivity.
+reflexivity.
Qed.
-Lemma pow_1: (x : R) (pow x (1)) == x.
+Lemma pow_1 : forall x:R, x ^ 1 = x.
Proof.
-Simpl; Auto with real.
+simpl in |- *; auto with real.
Qed.
-Lemma pow_add:
- (x : R) (n, m : nat) (pow x (plus n m)) == (Rmult (pow x n) (pow x m)).
+Lemma pow_add : forall (x:R) (n m:nat), x ^ (n + m) = x ^ n * x ^ m.
Proof.
-Intros x n; Elim n; Simpl; Auto with real.
-Intros n0 H' m; Rewrite H'; Auto with real.
+intros x n; elim n; simpl in |- *; auto with real.
+intros n0 H' m; rewrite H'; auto with real.
Qed.
-Lemma pow_nonzero:
- (x:R) (n:nat) ~(x==R0) -> ~((pow x n)==R0).
+Lemma pow_nonzero : forall (x:R) (n:nat), x <> 0 -> x ^ n <> 0.
Proof.
-Intro; Induction n; Simpl.
-Intro; Red;Intro;Apply R1_neq_R0;Assumption.
-Intros;Red; Intro;Elim (without_div_Od x (pow x n0) H1).
-Intro; Auto.
-Apply H;Assumption.
+intro; simple induction n; simpl in |- *.
+intro; red in |- *; intro; apply R1_neq_R0; assumption.
+intros; red in |- *; intro; elim (Rmult_integral x (x ^ n0) H1).
+intro; auto.
+apply H; assumption.
Qed.
-Hints Resolve pow_O pow_1 pow_add pow_nonzero:real.
+Hint Resolve pow_O pow_1 pow_add pow_nonzero: real.
-Lemma pow_RN_plus:
- (x : R)
- (n, m : nat)
- ~ x == R0 -> (pow x n) == (Rmult (pow x (plus n m)) (Rinv (pow x m))).
-Proof.
-Intros x n; Elim n; Simpl; Auto with real.
-Intros n0 H' m H'0.
-Rewrite Rmult_assoc; Rewrite <- H'; Auto.
-Qed.
-
-Lemma pow_lt: (x : R) (n : nat) (Rlt R0 x) -> (Rlt R0 (pow x n)).
-Proof.
-Intros x n; Elim n; Simpl; Auto with real.
-Intros n0 H' H'0; Replace R0 with (Rmult x R0); Auto with real.
-Qed.
-Hints Resolve pow_lt :real.
-
-Lemma Rlt_pow_R1:
- (x : R) (n : nat) (Rlt R1 x) -> (lt O n) -> (Rlt R1 (pow x n)).
-Proof.
-Intros x n; Elim n; Simpl; Auto with real.
-Intros H' H'0; ElimType False; Omega.
-Intros n0; Case n0.
-Simpl; Rewrite Rmult_1r; Auto.
-Intros n1 H' H'0 H'1.
-Replace R1 with (Rmult R1 R1); Auto with real.
-Apply Rlt_trans with r2 := (Rmult x R1); Auto with real.
-Apply Rlt_monotony; Auto with real.
-Apply Rlt_trans with r2 := R1; Auto with real.
-Apply H'; Auto with arith.
-Qed.
-Hints Resolve Rlt_pow_R1 :real.
-
-Lemma Rlt_pow:
- (x : R) (n, m : nat) (Rlt R1 x) -> (lt n m) -> (Rlt (pow x n) (pow x m)).
-Proof.
-Intros x n m H' H'0; Replace m with (plus (minus m n) n).
-Rewrite pow_add.
-Pattern 1 (pow x n); Replace (pow x n) with (Rmult R1 (pow x n));
- Auto with real.
-Apply Rminus_lt.
-Repeat Rewrite [y : R] (Rmult_sym y (pow x n)); Rewrite <- Rminus_distr.
-Replace R0 with (Rmult (pow x n) R0); Auto with real.
-Apply Rlt_monotony; Auto with real.
-Apply pow_lt; Auto with real.
-Apply Rlt_trans with r2 := R1; Auto with real.
-Apply Rlt_minus; Auto with real.
-Apply Rlt_pow_R1; Auto with arith.
-Apply simpl_lt_plus_l with p := n; Auto with arith.
-Rewrite le_plus_minus_r; Auto with arith; Rewrite <- plus_n_O; Auto.
-Rewrite plus_sym; Auto with arith.
-Qed.
-Hints Resolve Rlt_pow :real.
+Lemma pow_RN_plus :
+ forall (x:R) (n m:nat), x <> 0 -> x ^ n = x ^ (n + m) * / x ^ m.
+Proof.
+intros x n; elim n; simpl in |- *; auto with real.
+intros n0 H' m H'0.
+rewrite Rmult_assoc; rewrite <- H'; auto.
+Qed.
+
+Lemma pow_lt : forall (x:R) (n:nat), 0 < x -> 0 < x ^ n.
+Proof.
+intros x n; elim n; simpl in |- *; auto with real.
+intros n0 H' H'0; replace 0 with (x * 0); auto with real.
+Qed.
+Hint Resolve pow_lt: real.
+
+Lemma Rlt_pow_R1 : forall (x:R) (n:nat), 1 < x -> (0 < n)%nat -> 1 < x ^ n.
+Proof.
+intros x n; elim n; simpl in |- *; auto with real.
+intros H' H'0; elimtype False; omega.
+intros n0; case n0.
+simpl in |- *; rewrite Rmult_1_r; auto.
+intros n1 H' H'0 H'1.
+replace 1 with (1 * 1); auto with real.
+apply Rlt_trans with (r2 := x * 1); auto with real.
+apply Rmult_lt_compat_l; auto with real.
+apply Rlt_trans with (r2 := 1); auto with real.
+apply H'; auto with arith.
+Qed.
+Hint Resolve Rlt_pow_R1: real.
+
+Lemma Rlt_pow : forall (x:R) (n m:nat), 1 < x -> (n < m)%nat -> x ^ n < x ^ m.
+Proof.
+intros x n m H' H'0; replace m with (m - n + n)%nat.
+rewrite pow_add.
+pattern (x ^ n) at 1 in |- *; replace (x ^ n) with (1 * x ^ n);
+ auto with real.
+apply Rminus_lt.
+repeat rewrite (fun y:R => Rmult_comm y (x ^ n));
+ rewrite <- Rmult_minus_distr_l.
+replace 0 with (x ^ n * 0); auto with real.
+apply Rmult_lt_compat_l; auto with real.
+apply pow_lt; auto with real.
+apply Rlt_trans with (r2 := 1); auto with real.
+apply Rlt_minus; auto with real.
+apply Rlt_pow_R1; auto with arith.
+apply plus_lt_reg_l with (p := n); auto with arith.
+rewrite le_plus_minus_r; auto with arith; rewrite <- plus_n_O; auto.
+rewrite plus_comm; auto with arith.
+Qed.
+Hint Resolve Rlt_pow: real.
(*********)
-Lemma tech_pow_Rmult:(x:R)(n:nat)(Rmult x (pow x n))==(pow x (S n)).
+Lemma tech_pow_Rmult : forall (x:R) (n:nat), x * x ^ n = x ^ S n.
Proof.
-Induction n; Simpl; Trivial.
+simple induction n; simpl in |- *; trivial.
Qed.
(*********)
-Lemma tech_pow_Rplus:(x:R)(a,n:nat)
- (Rplus (pow x a) (Rmult (INR n) (pow x a)))==
- (Rmult (INR (S n)) (pow x a)).
-Proof.
-Intros; Pattern 1 (pow x a);
- Rewrite <-(let (H1,H2)=(Rmult_ne (pow x a)) in H1);
- Rewrite (Rmult_sym (INR n) (pow x a));
- Rewrite <- (Rmult_Rplus_distr (pow x a) R1 (INR n));
- Rewrite (Rplus_sym R1 (INR n)); Rewrite <-(S_INR n);
- Apply Rmult_sym.
-Qed.
-
-Lemma poly: (n:nat)(x:R)(Rlt R0 x)->
- (Rle (Rplus R1 (Rmult (INR n) x)) (pow (Rplus R1 x) n)).
-Proof.
-Intros;Elim n.
-Simpl;Cut (Rplus R1 (Rmult R0 x))==R1.
-Intro;Rewrite H0;Unfold Rle;Right; Reflexivity.
-Ring.
-Intros;Unfold pow; Fold pow;
- Apply (Rle_trans (Rplus R1 (Rmult (INR (S n0)) x))
- (Rmult (Rplus R1 x) (Rplus R1 (Rmult (INR n0) x)))
- (Rmult (Rplus R1 x) (pow (Rplus R1 x) n0))).
-Cut (Rmult (Rplus R1 x) (Rplus R1 (Rmult (INR n0) x)))==
- (Rplus (Rplus R1 (Rmult (INR (S n0)) x))
- (Rmult (INR n0) (Rmult x x))).
-Intro;Rewrite H1;Pattern 1 (Rplus R1 (Rmult (INR (S n0)) x));
- Rewrite <-(let (H1,H2)=
- (Rplus_ne (Rplus R1 (Rmult (INR (S n0)) x))) in H1);
- Apply Rle_compatibility;Elim n0;Intros.
-Simpl;Rewrite Rmult_Ol;Unfold Rle;Right;Auto.
-Unfold Rle;Left;Generalize Rmult_gt;Unfold Rgt;Intro;
- Fold (Rsqr x);Apply (H3 (INR (S n1)) (Rsqr x)
- (lt_INR_0 (S n1) (lt_O_Sn n1)));Fold (Rgt x R0) in H;
- Apply (pos_Rsqr1 x (imp_not_Req x R0
- (or_intror (Rlt x R0) (Rgt x R0) H))).
-Rewrite (S_INR n0);Ring.
-Unfold Rle in H0;Elim H0;Intro.
-Unfold Rle;Left;Apply Rlt_monotony.
-Rewrite Rplus_sym;
- Apply (Rlt_r_plus_R1 x (Rlt_le R0 x H)).
-Assumption.
-Rewrite H1;Unfold Rle;Right;Trivial.
-Qed.
-
-Lemma Power_monotonic:
- (x:R) (m,n:nat) (Rgt (Rabsolu x) R1)
- -> (le m n)
- -> (Rle (Rabsolu (pow x m)) (Rabsolu (pow x n))).
-Proof.
-Intros x m n H;Induction n;Intros;Inversion H0.
-Unfold Rle; Right; Reflexivity.
-Unfold Rle; Right; Reflexivity.
-Apply (Rle_trans (Rabsolu (pow x m))
- (Rabsolu (pow x n))
- (Rabsolu (pow x (S n)))).
-Apply Hrecn; Assumption.
-Simpl;Rewrite Rabsolu_mult.
-Pattern 1 (Rabsolu (pow x n)).
-Rewrite <-Rmult_1r.
-Rewrite (Rmult_sym (Rabsolu x) (Rabsolu (pow x n))).
-Apply Rle_monotony.
-Apply Rabsolu_pos.
-Unfold Rgt in H.
-Apply Rlt_le; Assumption.
-Qed.
-
-Lemma Pow_Rabsolu: (x:R) (n:nat)
- (pow (Rabsolu x) n)==(Rabsolu (pow x n)).
-Proof.
-Intro;Induction n;Simpl.
-Apply sym_eqT;Apply Rabsolu_pos_eq;Apply Rlt_le;Apply Rlt_R0_R1.
-Intros; Rewrite H;Apply sym_eqT;Apply Rabsolu_mult.
-Qed.
-
-
-Lemma Pow_x_infinity:
- (x:R) (Rgt (Rabsolu x) R1)
- -> (b:R) (Ex [N:nat] ((n:nat) (ge n N)
- -> (Rge (Rabsolu (pow x n)) b ))).
-Proof.
-Intros;Elim (archimed (Rmult b (Rinv (Rminus (Rabsolu x) R1))));Intros;
- Clear H1;
- Cut (Ex[N:nat] (Rge (INR N) (Rmult b (Rinv (Rminus (Rabsolu x) R1))))).
-Intro; Elim H1;Clear H1;Intros;Exists x0;Intros;
- Apply (Rge_trans (Rabsolu (pow x n)) (Rabsolu (pow x x0)) b).
-Apply Rle_sym1;Apply Power_monotonic;Assumption.
-Rewrite <- Pow_Rabsolu;Cut (Rabsolu x)==(Rplus R1 (Rminus (Rabsolu x) R1)).
-Intro; Rewrite H3;
- Apply (Rge_trans (pow (Rplus R1 (Rminus (Rabsolu x) R1)) x0)
- (Rplus R1 (Rmult (INR x0)
- (Rminus (Rabsolu x) R1)))
- b).
-Apply Rle_sym1;Apply poly;Fold (Rgt (Rminus (Rabsolu x) R1) R0);
- Apply Rgt_minus;Assumption.
-Apply (Rge_trans
- (Rplus R1 (Rmult (INR x0) (Rminus (Rabsolu x) R1)))
- (Rmult (INR x0) (Rminus (Rabsolu x) R1))
- b).
-Apply Rle_sym1; Apply Rlt_le;Rewrite (Rplus_sym R1
- (Rmult (INR x0) (Rminus (Rabsolu x) R1)));
- Pattern 1 (Rmult (INR x0) (Rminus (Rabsolu x) R1));
- Rewrite <- (let (H1,H2) = (Rplus_ne
- (Rmult (INR x0) (Rminus (Rabsolu x) R1))) in
- H1);
- Apply Rlt_compatibility;
- Apply Rlt_R0_R1.
-Cut b==(Rmult (Rmult b (Rinv (Rminus (Rabsolu x) R1)))
- (Rminus (Rabsolu x) R1)).
-Intros; Rewrite H4;Apply Rge_monotony.
-Apply Rge_minus;Unfold Rge; Left; Assumption.
-Assumption.
-Rewrite Rmult_assoc;Rewrite Rinv_l.
-Ring.
-Apply imp_not_Req; Right;Apply Rgt_minus;Assumption.
-Ring.
-Cut `0<= (up (Rmult b (Rinv (Rminus (Rabsolu x) R1))))`\/
- `(up (Rmult b (Rinv (Rminus (Rabsolu x) R1)))) <= 0`.
-Intros;Elim H1;Intro.
-Elim (IZN (up (Rmult b (Rinv (Rminus (Rabsolu x) R1)))) H2);Intros;Exists x0;
- Apply (Rge_trans
- (INR x0)
- (IZR (up (Rmult b (Rinv (Rminus (Rabsolu x) R1)))))
- (Rmult b (Rinv (Rminus (Rabsolu x) R1)))).
-Rewrite INR_IZR_INZ;Apply IZR_ge;Omega.
-Unfold Rge; Left; Assumption.
-Exists O;Apply (Rge_trans (INR (0))
- (IZR (up (Rmult b (Rinv (Rminus (Rabsolu x) R1)))))
- (Rmult b (Rinv (Rminus (Rabsolu x) R1)))).
-Rewrite INR_IZR_INZ;Apply IZR_ge;Simpl;Omega.
-Unfold Rge; Left; Assumption.
-Omega.
-Qed.
-
-Lemma pow_ne_zero:
- (n:nat) ~(n=(0))-> (pow R0 n) == R0.
-Proof.
-Induction n.
-Simpl;Auto.
-Intros;Elim H;Reflexivity.
-Intros; Simpl;Apply Rmult_Ol.
-Qed.
-
-Lemma Rinv_pow:
- (x:R) (n:nat) ~(x==R0) -> (Rinv (pow x n))==(pow (Rinv x) n).
-Proof.
-Intros; Elim n; Simpl.
-Apply Rinv_R1.
-Intro m;Intro;Rewrite Rinv_Rmult.
-Rewrite H0; Reflexivity;Assumption.
-Assumption.
-Apply pow_nonzero;Assumption.
-Qed.
-
-Lemma pow_lt_1_zero:
- (x:R) (Rlt (Rabsolu x) R1)
- -> (y:R) (Rlt R0 y)
- -> (Ex[N:nat] (n:nat) (ge n N)
- -> (Rlt (Rabsolu (pow x n)) y)).
-Proof.
-Intros;Elim (Req_EM x R0);Intro.
-Exists (1);Rewrite H1;Intros n GE;Rewrite pow_ne_zero.
-Rewrite Rabsolu_R0;Assumption.
-Inversion GE;Auto.
-Cut (Rgt (Rabsolu (Rinv x)) R1).
-Intros;Elim (Pow_x_infinity (Rinv x) H2 (Rplus (Rinv y) R1));Intros N.
-Exists N;Intros;Rewrite <- (Rinv_Rinv y).
-Rewrite <- (Rinv_Rinv (Rabsolu (pow x n))).
-Apply Rinv_lt.
-Apply Rmult_lt_pos.
-Apply Rlt_Rinv.
-Assumption.
-Apply Rlt_Rinv.
-Apply Rabsolu_pos_lt.
-Apply pow_nonzero.
-Assumption.
-Rewrite <- Rabsolu_Rinv.
-Rewrite Rinv_pow.
-Apply (Rlt_le_trans (Rinv y)
- (Rplus (Rinv y) R1)
- (Rabsolu (pow (Rinv x) n))).
-Pattern 1 (Rinv y).
-Rewrite <- (let (H1,H2) =
- (Rplus_ne (Rinv y)) in H1).
-Apply Rlt_compatibility.
-Apply Rlt_R0_R1.
-Apply Rle_sym2.
-Apply H3.
-Assumption.
-Assumption.
-Apply pow_nonzero.
-Assumption.
-Apply Rabsolu_no_R0.
-Apply pow_nonzero.
-Assumption.
-Apply imp_not_Req.
-Right; Unfold Rgt; Assumption.
-Rewrite <- (Rinv_Rinv R1).
-Rewrite Rabsolu_Rinv.
-Unfold Rgt; Apply Rinv_lt.
-Apply Rmult_lt_pos.
-Apply Rabsolu_pos_lt.
-Assumption.
-Rewrite Rinv_R1; Apply Rlt_R0_R1.
-Rewrite Rinv_R1; Assumption.
-Assumption.
-Red;Intro; Apply R1_neq_R0;Assumption.
-Qed.
-
-Lemma pow_R1:
- (r : R) (n : nat) (pow r n) == R1 -> (Rabsolu r) == R1 \/ n = O.
-Proof.
-Intros r n H'.
-Case (Req_EM (Rabsolu r) R1); Auto; Intros H'1.
-Case (not_Req ? ? H'1); Intros H'2.
-Generalize H'; Case n; Auto.
-Intros n0 H'0.
-Cut ~ r == R0; [Intros Eq1 | Idtac].
-Cut ~ (Rabsolu r) == R0; [Intros Eq2 | Apply Rabsolu_no_R0]; Auto.
-Absurd (Rlt (pow (Rabsolu (Rinv r)) O) (pow (Rabsolu (Rinv r)) (S n0))); Auto.
-Replace (pow (Rabsolu (Rinv r)) (S n0)) with R1.
-Simpl; Apply Rlt_antirefl; Auto.
-Rewrite Rabsolu_Rinv; Auto.
-Rewrite <- Rinv_pow; Auto.
-Rewrite Pow_Rabsolu; Auto.
-Rewrite H'0; Rewrite Rabsolu_right; Auto with real.
-Apply Rle_ge; Auto with real.
-Apply Rlt_pow; Auto with arith.
-Rewrite Rabsolu_Rinv; Auto.
-Apply Rlt_monotony_contra with z := (Rabsolu r).
-Case (Rabsolu_pos r); Auto.
-Intros H'3; Case Eq2; Auto.
-Rewrite Rmult_1r; Rewrite Rinv_r; Auto with real.
-Red;Intro;Absurd ``(pow r (S n0)) == 1``;Auto.
-Simpl; Rewrite H; Rewrite Rmult_Ol; Auto with real.
-Generalize H'; Case n; Auto.
-Intros n0 H'0.
-Cut ~ r == R0; [Intros Eq1 | Auto with real].
-Cut ~ (Rabsolu r) == R0; [Intros Eq2 | Apply Rabsolu_no_R0]; Auto.
-Absurd (Rlt (pow (Rabsolu r) O) (pow (Rabsolu r) (S n0)));
- Auto with real arith.
-Repeat Rewrite Pow_Rabsolu; Rewrite H'0; Simpl; Auto with real.
-Red;Intro;Absurd ``(pow r (S n0)) == 1``;Auto.
-Simpl; Rewrite H; Rewrite Rmult_Ol; Auto with real.
-Qed.
-
-Lemma pow_Rsqr : (x:R;n:nat) (pow x (mult (2) n))==(pow (Rsqr x) n).
-Proof.
-Intros; Induction n.
-Reflexivity.
-Replace (mult (2) (S n)) with (S (S (mult (2) n))).
-Replace (pow x (S (S (mult (2) n)))) with ``x*x*(pow x (mult (S (S O)) n))``.
-Rewrite Hrecn; Reflexivity.
-Simpl; Ring.
-Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Qed.
-
-Lemma pow_le : (a:R;n:nat) ``0<=a`` -> ``0<=(pow a n)``.
-Proof.
-Intros; Induction n.
-Simpl; Left; Apply Rlt_R0_R1.
-Simpl; Apply Rmult_le_pos; Assumption.
+Lemma tech_pow_Rplus :
+ forall (x:R) (a n:nat), x ^ a + INR n * x ^ a = INR (S n) * x ^ a.
+Proof.
+intros; pattern (x ^ a) at 1 in |- *;
+ rewrite <- (let (H1, H2) := Rmult_ne (x ^ a) in H1);
+ rewrite (Rmult_comm (INR n) (x ^ a));
+ rewrite <- (Rmult_plus_distr_l (x ^ a) 1 (INR n));
+ rewrite (Rplus_comm 1 (INR n)); rewrite <- (S_INR n);
+ apply Rmult_comm.
+Qed.
+
+Lemma poly : forall (n:nat) (x:R), 0 < x -> 1 + INR n * x <= (1 + x) ^ n.
+Proof.
+intros; elim n.
+simpl in |- *; cut (1 + 0 * x = 1).
+intro; rewrite H0; unfold Rle in |- *; right; reflexivity.
+ring.
+intros; unfold pow in |- *; fold pow in |- *;
+ apply
+ (Rle_trans (1 + INR (S n0) * x) ((1 + x) * (1 + INR n0 * x))
+ ((1 + x) * (1 + x) ^ n0)).
+cut ((1 + x) * (1 + INR n0 * x) = 1 + INR (S n0) * x + INR n0 * (x * x)).
+intro; rewrite H1; pattern (1 + INR (S n0) * x) at 1 in |- *;
+ rewrite <- (let (H1, H2) := Rplus_ne (1 + INR (S n0) * x) in H1);
+ apply Rplus_le_compat_l; elim n0; intros.
+simpl in |- *; rewrite Rmult_0_l; unfold Rle in |- *; right; auto.
+unfold Rle in |- *; left; generalize Rmult_gt_0_compat; unfold Rgt in |- *;
+ intro; fold (Rsqr x) in |- *;
+ apply (H3 (INR (S n1)) (Rsqr x) (lt_INR_0 (S n1) (lt_O_Sn n1)));
+ fold (x > 0) in H;
+ apply (Rlt_0_sqr x (Rlt_dichotomy_converse x 0 (or_intror (x < 0) H))).
+rewrite (S_INR n0); ring.
+unfold Rle in H0; elim H0; intro.
+unfold Rle in |- *; left; apply Rmult_lt_compat_l.
+rewrite Rplus_comm; apply (Rle_lt_0_plus_1 x (Rlt_le 0 x H)).
+assumption.
+rewrite H1; unfold Rle in |- *; right; trivial.
+Qed.
+
+Lemma Power_monotonic :
+ forall (x:R) (m n:nat),
+ Rabs x > 1 -> (m <= n)%nat -> Rabs (x ^ m) <= Rabs (x ^ n).
+Proof.
+intros x m n H; induction n as [| n Hrecn]; intros; inversion H0.
+unfold Rle in |- *; right; reflexivity.
+unfold Rle in |- *; right; reflexivity.
+apply (Rle_trans (Rabs (x ^ m)) (Rabs (x ^ n)) (Rabs (x ^ S n))).
+apply Hrecn; assumption.
+simpl in |- *; rewrite Rabs_mult.
+pattern (Rabs (x ^ n)) at 1 in |- *.
+rewrite <- Rmult_1_r.
+rewrite (Rmult_comm (Rabs x) (Rabs (x ^ n))).
+apply Rmult_le_compat_l.
+apply Rabs_pos.
+unfold Rgt in H.
+apply Rlt_le; assumption.
+Qed.
+
+Lemma RPow_abs : forall (x:R) (n:nat), Rabs x ^ n = Rabs (x ^ n).
+Proof.
+intro; simple induction n; simpl in |- *.
+apply sym_eq; apply Rabs_pos_eq; apply Rlt_le; apply Rlt_0_1.
+intros; rewrite H; apply sym_eq; apply Rabs_mult.
+Qed.
+
+
+Lemma Pow_x_infinity :
+ forall x:R,
+ Rabs x > 1 ->
+ forall b:R,
+ exists N : nat | (forall n:nat, (n >= N)%nat -> Rabs (x ^ n) >= b).
+Proof.
+intros; elim (archimed (b * / (Rabs x - 1))); intros; clear H1;
+ cut ( exists N : nat | INR N >= b * / (Rabs x - 1)).
+intro; elim H1; clear H1; intros; exists x0; intros;
+ apply (Rge_trans (Rabs (x ^ n)) (Rabs (x ^ x0)) b).
+apply Rle_ge; apply Power_monotonic; assumption.
+rewrite <- RPow_abs; cut (Rabs x = 1 + (Rabs x - 1)).
+intro; rewrite H3;
+ apply (Rge_trans ((1 + (Rabs x - 1)) ^ x0) (1 + INR x0 * (Rabs x - 1)) b).
+apply Rle_ge; apply poly; fold (Rabs x - 1 > 0) in |- *; apply Rgt_minus;
+ assumption.
+apply (Rge_trans (1 + INR x0 * (Rabs x - 1)) (INR x0 * (Rabs x - 1)) b).
+apply Rle_ge; apply Rlt_le; rewrite (Rplus_comm 1 (INR x0 * (Rabs x - 1)));
+ pattern (INR x0 * (Rabs x - 1)) at 1 in |- *;
+ rewrite <- (let (H1, H2) := Rplus_ne (INR x0 * (Rabs x - 1)) in H1);
+ apply Rplus_lt_compat_l; apply Rlt_0_1.
+cut (b = b * / (Rabs x - 1) * (Rabs x - 1)).
+intros; rewrite H4; apply Rmult_ge_compat_r.
+apply Rge_minus; unfold Rge in |- *; left; assumption.
+assumption.
+rewrite Rmult_assoc; rewrite Rinv_l.
+ring.
+apply Rlt_dichotomy_converse; right; apply Rgt_minus; assumption.
+ring.
+cut ((0 <= up (b * / (Rabs x - 1)))%Z \/ (up (b * / (Rabs x - 1)) <= 0)%Z).
+intros; elim H1; intro.
+elim (IZN (up (b * / (Rabs x - 1))) H2); intros; exists x0;
+ apply
+ (Rge_trans (INR x0) (IZR (up (b * / (Rabs x - 1)))) (b * / (Rabs x - 1))).
+rewrite INR_IZR_INZ; apply IZR_ge; omega.
+unfold Rge in |- *; left; assumption.
+exists 0%nat;
+ apply
+ (Rge_trans (INR 0) (IZR (up (b * / (Rabs x - 1)))) (b * / (Rabs x - 1))).
+rewrite INR_IZR_INZ; apply IZR_ge; simpl in |- *; omega.
+unfold Rge in |- *; left; assumption.
+omega.
+Qed.
+
+Lemma pow_ne_zero : forall n:nat, n <> 0%nat -> 0 ^ n = 0.
+Proof.
+simple induction n.
+simpl in |- *; auto.
+intros; elim H; reflexivity.
+intros; simpl in |- *; apply Rmult_0_l.
+Qed.
+
+Lemma Rinv_pow : forall (x:R) (n:nat), x <> 0 -> / x ^ n = (/ x) ^ n.
+Proof.
+intros; elim n; simpl in |- *.
+apply Rinv_1.
+intro m; intro; rewrite Rinv_mult_distr.
+rewrite H0; reflexivity; assumption.
+assumption.
+apply pow_nonzero; assumption.
+Qed.
+
+Lemma pow_lt_1_zero :
+ forall x:R,
+ Rabs x < 1 ->
+ forall y:R,
+ 0 < y ->
+ exists N : nat | (forall n:nat, (n >= N)%nat -> Rabs (x ^ n) < y).
+Proof.
+intros; elim (Req_dec x 0); intro.
+exists 1%nat; rewrite H1; intros n GE; rewrite pow_ne_zero.
+rewrite Rabs_R0; assumption.
+inversion GE; auto.
+cut (Rabs (/ x) > 1).
+intros; elim (Pow_x_infinity (/ x) H2 (/ y + 1)); intros N.
+exists N; intros; rewrite <- (Rinv_involutive y).
+rewrite <- (Rinv_involutive (Rabs (x ^ n))).
+apply Rinv_lt_contravar.
+apply Rmult_lt_0_compat.
+apply Rinv_0_lt_compat.
+assumption.
+apply Rinv_0_lt_compat.
+apply Rabs_pos_lt.
+apply pow_nonzero.
+assumption.
+rewrite <- Rabs_Rinv.
+rewrite Rinv_pow.
+apply (Rlt_le_trans (/ y) (/ y + 1) (Rabs ((/ x) ^ n))).
+pattern (/ y) at 1 in |- *.
+rewrite <- (let (H1, H2) := Rplus_ne (/ y) in H1).
+apply Rplus_lt_compat_l.
+apply Rlt_0_1.
+apply Rge_le.
+apply H3.
+assumption.
+assumption.
+apply pow_nonzero.
+assumption.
+apply Rabs_no_R0.
+apply pow_nonzero.
+assumption.
+apply Rlt_dichotomy_converse.
+right; unfold Rgt in |- *; assumption.
+rewrite <- (Rinv_involutive 1).
+rewrite Rabs_Rinv.
+unfold Rgt in |- *; apply Rinv_lt_contravar.
+apply Rmult_lt_0_compat.
+apply Rabs_pos_lt.
+assumption.
+rewrite Rinv_1; apply Rlt_0_1.
+rewrite Rinv_1; assumption.
+assumption.
+red in |- *; intro; apply R1_neq_R0; assumption.
+Qed.
+
+Lemma pow_R1 : forall (r:R) (n:nat), r ^ n = 1 -> Rabs r = 1 \/ n = 0%nat.
+Proof.
+intros r n H'.
+case (Req_dec (Rabs r) 1); auto; intros H'1.
+case (Rdichotomy _ _ H'1); intros H'2.
+generalize H'; case n; auto.
+intros n0 H'0.
+cut (r <> 0); [ intros Eq1 | idtac ].
+cut (Rabs r <> 0); [ intros Eq2 | apply Rabs_no_R0 ]; auto.
+absurd (Rabs (/ r) ^ 0 < Rabs (/ r) ^ S n0); auto.
+replace (Rabs (/ r) ^ S n0) with 1.
+simpl in |- *; apply Rlt_irrefl; auto.
+rewrite Rabs_Rinv; auto.
+rewrite <- Rinv_pow; auto.
+rewrite RPow_abs; auto.
+rewrite H'0; rewrite Rabs_right; auto with real.
+apply Rle_ge; auto with real.
+apply Rlt_pow; auto with arith.
+rewrite Rabs_Rinv; auto.
+apply Rmult_lt_reg_l with (r := Rabs r).
+case (Rabs_pos r); auto.
+intros H'3; case Eq2; auto.
+rewrite Rmult_1_r; rewrite Rinv_r; auto with real.
+red in |- *; intro; absurd (r ^ S n0 = 1); auto.
+simpl in |- *; rewrite H; rewrite Rmult_0_l; auto with real.
+generalize H'; case n; auto.
+intros n0 H'0.
+cut (r <> 0); [ intros Eq1 | auto with real ].
+cut (Rabs r <> 0); [ intros Eq2 | apply Rabs_no_R0 ]; auto.
+absurd (Rabs r ^ 0 < Rabs r ^ S n0); auto with real arith.
+repeat rewrite RPow_abs; rewrite H'0; simpl in |- *; auto with real.
+red in |- *; intro; absurd (r ^ S n0 = 1); auto.
+simpl in |- *; rewrite H; rewrite Rmult_0_l; auto with real.
+Qed.
+
+Lemma pow_Rsqr : forall (x:R) (n:nat), x ^ (2 * n) = Rsqr x ^ n.
+Proof.
+intros; induction n as [| n Hrecn].
+reflexivity.
+replace (2 * S n)%nat with (S (S (2 * n))).
+replace (x ^ S (S (2 * n))) with (x * x * x ^ (2 * n)).
+rewrite Hrecn; reflexivity.
+simpl in |- *; ring.
+apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR;
+ ring.
+Qed.
+
+Lemma pow_le : forall (a:R) (n:nat), 0 <= a -> 0 <= a ^ n.
+Proof.
+intros; induction n as [| n Hrecn].
+simpl in |- *; left; apply Rlt_0_1.
+simpl in |- *; apply Rmult_le_pos; assumption.
Qed.
(**********)
-Lemma pow_1_even : (n:nat) ``(pow (-1) (mult (S (S O)) n))==1``.
+Lemma pow_1_even : forall n:nat, (-1) ^ (2 * n) = 1.
Proof.
-Intro; Induction n.
-Reflexivity.
-Replace (mult (2) (S n)) with (plus (2) (mult (2) n)).
-Rewrite pow_add; Rewrite Hrecn; Simpl; Ring.
-Replace (S n) with (plus n (1)); [Ring | Ring].
+intro; induction n as [| n Hrecn].
+reflexivity.
+replace (2 * S n)%nat with (2 + 2 * n)%nat.
+rewrite pow_add; rewrite Hrecn; simpl in |- *; ring.
+replace (S n) with (n + 1)%nat; [ ring | ring ].
Qed.
(**********)
-Lemma pow_1_odd : (n:nat) ``(pow (-1) (S (mult (S (S O)) n)))==-1``.
+Lemma pow_1_odd : forall n:nat, (-1) ^ S (2 * n) = -1.
Proof.
-Intro; Replace (S (mult (2) n)) with (plus (mult (2) n) (1)); [Idtac | Ring].
-Rewrite pow_add; Rewrite pow_1_even; Simpl; Ring.
+intro; replace (S (2 * n)) with (2 * n + 1)%nat; [ idtac | ring ].
+rewrite pow_add; rewrite pow_1_even; simpl in |- *; ring.
Qed.
(**********)
-Lemma pow_1_abs : (n:nat) ``(Rabsolu (pow (-1) n))==1``.
-Proof.
-Intro; Induction n.
-Simpl; Apply Rabsolu_R1.
-Replace (S n) with (plus n (1)); [Rewrite pow_add | Ring].
-Rewrite Rabsolu_mult.
-Rewrite Hrecn; Rewrite Rmult_1l; Simpl; Rewrite Rmult_1r; Rewrite Rabsolu_Ropp; Apply Rabsolu_R1.
-Qed.
-
-Lemma pow_mult : (x:R;n1,n2:nat) (pow x (mult n1 n2))==(pow (pow x n1) n2).
-Proof.
-Intros; Induction n2.
-Simpl; Replace (mult n1 O) with O; [Reflexivity | Ring].
-Replace (mult n1 (S n2)) with (plus (mult n1 n2) n1).
-Replace (S n2) with (plus n2 (1)); [Idtac | Ring].
-Do 2 Rewrite pow_add.
-Rewrite Hrecn2.
-Simpl.
-Ring.
-Apply INR_eq; Rewrite plus_INR; Do 2 Rewrite mult_INR; Rewrite S_INR; Ring.
-Qed.
-
-Lemma pow_incr : (x,y:R;n:nat) ``0<=x<=y`` -> ``(pow x n)<=(pow y n)``.
-Proof.
-Intros.
-Induction n.
-Right; Reflexivity.
-Simpl.
-Elim H; Intros.
-Apply Rle_trans with ``y*(pow x n)``.
-Do 2 Rewrite <- (Rmult_sym (pow x n)).
-Apply Rle_monotony.
-Apply pow_le; Assumption.
-Assumption.
-Apply Rle_monotony.
-Apply Rle_trans with x; Assumption.
-Apply Hrecn.
-Qed.
-
-Lemma pow_R1_Rle : (x:R;k:nat) ``1<=x`` -> ``1<=(pow x k)``.
-Proof.
-Intros.
-Induction k.
-Right; Reflexivity.
-Simpl.
-Apply Rle_trans with ``x*1``.
-Rewrite Rmult_1r; Assumption.
-Apply Rle_monotony.
-Left; Apply Rlt_le_trans with R1; [Apply Rlt_R0_R1 | Assumption].
-Exact Hreck.
-Qed.
-
-Lemma Rle_pow : (x:R;m,n:nat) ``1<=x`` -> (le m n) -> ``(pow x m)<=(pow x n)``.
-Proof.
-Intros.
-Replace n with (plus (minus n m) m).
-Rewrite pow_add.
-Rewrite Rmult_sym.
-Pattern 1 (pow x m); Rewrite <- Rmult_1r.
-Apply Rle_monotony.
-Apply pow_le; Left; Apply Rlt_le_trans with R1; [Apply Rlt_R0_R1 | Assumption].
-Apply pow_R1_Rle; Assumption.
-Rewrite plus_sym.
-Symmetry; Apply le_plus_minus; Assumption.
-Qed.
-
-Lemma pow1 : (n:nat) (pow R1 n)==R1.
-Proof.
-Intro; Induction n.
-Reflexivity.
-Simpl; Rewrite Hrecn; Rewrite Rmult_1r; Reflexivity.
-Qed.
-
-Lemma pow_Rabs : (x:R;n:nat) ``(pow x n)<=(pow (Rabsolu x) n)``.
-Proof.
-Intros; Induction n.
-Right; Reflexivity.
-Simpl; Case (case_Rabsolu x); Intro.
-Apply Rle_trans with (Rabsolu ``x*(pow x n)``).
-Apply Rle_Rabsolu.
-Rewrite Rabsolu_mult.
-Apply Rle_monotony.
-Apply Rabsolu_pos.
-Right; Symmetry; Apply Pow_Rabsolu.
-Pattern 1 (Rabsolu x); Rewrite (Rabsolu_right x r); Apply Rle_monotony.
-Apply Rle_sym2; Exact r.
-Apply Hrecn.
-Qed.
-
-Lemma pow_maj_Rabs : (x,y:R;n:nat) ``(Rabsolu y)<=x`` -> ``(pow y n)<=(pow x n)``.
-Proof.
-Intros; Cut ``0<=x``.
-Intro; Apply Rle_trans with (pow (Rabsolu y) n).
-Apply pow_Rabs.
-Induction n.
-Right; Reflexivity.
-Simpl; Apply Rle_trans with ``x*(pow (Rabsolu y) n)``.
-Do 2 Rewrite <- (Rmult_sym (pow (Rabsolu y) n)).
-Apply Rle_monotony.
-Apply pow_le; Apply Rabsolu_pos.
-Assumption.
-Apply Rle_monotony.
-Apply H0.
-Apply Hrecn.
-Apply Rle_trans with (Rabsolu y); [Apply Rabsolu_pos | Exact H].
+Lemma pow_1_abs : forall n:nat, Rabs ((-1) ^ n) = 1.
+Proof.
+intro; induction n as [| n Hrecn].
+simpl in |- *; apply Rabs_R1.
+replace (S n) with (n + 1)%nat; [ rewrite pow_add | ring ].
+rewrite Rabs_mult.
+rewrite Hrecn; rewrite Rmult_1_l; simpl in |- *; rewrite Rmult_1_r;
+ rewrite Rabs_Ropp; apply Rabs_R1.
+Qed.
+
+Lemma pow_mult : forall (x:R) (n1 n2:nat), x ^ (n1 * n2) = x ^ n1 ^ n2.
+Proof.
+intros; induction n2 as [| n2 Hrecn2].
+simpl in |- *; replace (n1 * 0)%nat with 0%nat; [ reflexivity | ring ].
+replace (n1 * S n2)%nat with (n1 * n2 + n1)%nat.
+replace (S n2) with (n2 + 1)%nat; [ idtac | ring ].
+do 2 rewrite pow_add.
+rewrite Hrecn2.
+simpl in |- *.
+ring.
+apply INR_eq; rewrite plus_INR; do 2 rewrite mult_INR; rewrite S_INR; ring.
+Qed.
+
+Lemma pow_incr : forall (x y:R) (n:nat), 0 <= x <= y -> x ^ n <= y ^ n.
+Proof.
+intros.
+induction n as [| n Hrecn].
+right; reflexivity.
+simpl in |- *.
+elim H; intros.
+apply Rle_trans with (y * x ^ n).
+do 2 rewrite <- (Rmult_comm (x ^ n)).
+apply Rmult_le_compat_l.
+apply pow_le; assumption.
+assumption.
+apply Rmult_le_compat_l.
+apply Rle_trans with x; assumption.
+apply Hrecn.
+Qed.
+
+Lemma pow_R1_Rle : forall (x:R) (k:nat), 1 <= x -> 1 <= x ^ k.
+Proof.
+intros.
+induction k as [| k Hreck].
+right; reflexivity.
+simpl in |- *.
+apply Rle_trans with (x * 1).
+rewrite Rmult_1_r; assumption.
+apply Rmult_le_compat_l.
+left; apply Rlt_le_trans with 1; [ apply Rlt_0_1 | assumption ].
+exact Hreck.
+Qed.
+
+Lemma Rle_pow :
+ forall (x:R) (m n:nat), 1 <= x -> (m <= n)%nat -> x ^ m <= x ^ n.
+Proof.
+intros.
+replace n with (n - m + m)%nat.
+rewrite pow_add.
+rewrite Rmult_comm.
+pattern (x ^ m) at 1 in |- *; rewrite <- Rmult_1_r.
+apply Rmult_le_compat_l.
+apply pow_le; left; apply Rlt_le_trans with 1; [ apply Rlt_0_1 | assumption ].
+apply pow_R1_Rle; assumption.
+rewrite plus_comm.
+symmetry in |- *; apply le_plus_minus; assumption.
+Qed.
+
+Lemma pow1 : forall n:nat, 1 ^ n = 1.
+Proof.
+intro; induction n as [| n Hrecn].
+reflexivity.
+simpl in |- *; rewrite Hrecn; rewrite Rmult_1_r; reflexivity.
+Qed.
+
+Lemma pow_Rabs : forall (x:R) (n:nat), x ^ n <= Rabs x ^ n.
+Proof.
+intros; induction n as [| n Hrecn].
+right; reflexivity.
+simpl in |- *; case (Rcase_abs x); intro.
+apply Rle_trans with (Rabs (x * x ^ n)).
+apply RRle_abs.
+rewrite Rabs_mult.
+apply Rmult_le_compat_l.
+apply Rabs_pos.
+right; symmetry in |- *; apply RPow_abs.
+pattern (Rabs x) at 1 in |- *; rewrite (Rabs_right x r);
+ apply Rmult_le_compat_l.
+apply Rge_le; exact r.
+apply Hrecn.
+Qed.
+
+Lemma pow_maj_Rabs : forall (x y:R) (n:nat), Rabs y <= x -> y ^ n <= x ^ n.
+Proof.
+intros; cut (0 <= x).
+intro; apply Rle_trans with (Rabs y ^ n).
+apply pow_Rabs.
+induction n as [| n Hrecn].
+right; reflexivity.
+simpl in |- *; apply Rle_trans with (x * Rabs y ^ n).
+do 2 rewrite <- (Rmult_comm (Rabs y ^ n)).
+apply Rmult_le_compat_l.
+apply pow_le; apply Rabs_pos.
+assumption.
+apply Rmult_le_compat_l.
+apply H0.
+apply Hrecn.
+apply Rle_trans with (Rabs y); [ apply Rabs_pos | exact H ].
Qed.
(*******************************)
@@ -556,207 +524,200 @@ Qed.
(*******************************)
(*i Due to L.Thery i*)
-Tactic Definition CaseEqk name :=
-Generalize (refl_equal ? name); Pattern -1 name; Case name.
+Ltac case_eq name :=
+ generalize (refl_equal name); pattern name at -1 in |- *; case name.
-Definition powerRZ :=
- [x : R] [n : Z] Cases n of
- ZERO => R1
- | (POS p) => (pow x (convert p))
- | (NEG p) => (Rinv (pow x (convert p)))
- end.
+Definition powerRZ (x:R) (n:Z) :=
+ match n with
+ | Z0 => 1
+ | Zpos p => x ^ nat_of_P p
+ | Zneg p => / x ^ nat_of_P p
+ end.
-Infix Local "^Z" powerRZ (at level 2, left associativity) : R_scope.
+Infix Local "^Z" := powerRZ (at level 30, left associativity) : R_scope.
-Lemma Zpower_NR0:
- (x : Z) (n : nat) (Zle ZERO x) -> (Zle ZERO (Zpower_nat x n)).
+Lemma Zpower_NR0 :
+ forall (x:Z) (n:nat), (0 <= x)%Z -> (0 <= Zpower_nat x n)%Z.
Proof.
-NewInduction n; Unfold Zpower_nat; Simpl; Auto with zarith.
+induction n; unfold Zpower_nat in |- *; simpl in |- *; auto with zarith.
Qed.
-Lemma powerRZ_O: (x : R) (powerRZ x ZERO) == R1.
+Lemma powerRZ_O : forall x:R, x ^Z 0 = 1.
Proof.
-Reflexivity.
+reflexivity.
Qed.
-Lemma powerRZ_1: (x : R) (powerRZ x (Zs ZERO)) == x.
+Lemma powerRZ_1 : forall x:R, x ^Z Zsucc 0 = x.
Proof.
-Simpl; Auto with real.
+simpl in |- *; auto with real.
Qed.
-Lemma powerRZ_NOR: (x : R) (z : Z) ~ x == R0 -> ~ (powerRZ x z) == R0.
+Lemma powerRZ_NOR : forall (x:R) (z:Z), x <> 0 -> x ^Z z <> 0.
Proof.
-NewDestruct z; Simpl; Auto with real.
+destruct z; simpl in |- *; auto with real.
Qed.
-Lemma powerRZ_add:
- (x : R)
- (n, m : Z)
- ~ x == R0 -> (powerRZ x (Zplus n m)) == (Rmult (powerRZ x n) (powerRZ x m)).
+Lemma powerRZ_add :
+ forall (x:R) (n m:Z), x <> 0 -> x ^Z (n + m) = x ^Z n * x ^Z m.
Proof.
-Intro x; NewDestruct n as [|n1|n1]; NewDestruct m as [|m1|m1]; Simpl;
- Auto with real.
+intro x; destruct n as [| n1| n1]; destruct m as [| m1| m1]; simpl in |- *;
+ auto with real.
(* POS/POS *)
-Rewrite convert_add; Auto with real.
+rewrite nat_of_P_plus_morphism; auto with real.
(* POS/NEG *)
-(CaseEqk '(compare n1 m1 EGAL)); Simpl; Auto with real.
-Intros H' H'0; Rewrite compare_convert_EGAL with 1 := H'; Auto with real.
-Intros H' H'0; Rewrite (true_sub_convert m1 n1); Auto with real.
-Rewrite (pow_RN_plus x (minus (convert m1) (convert n1)) (convert n1));
- Auto with real.
-Rewrite plus_sym; Rewrite le_plus_minus_r; Auto with real.
-Rewrite Rinv_Rmult; Auto with real.
-Rewrite Rinv_Rinv; Auto with real.
-Apply lt_le_weak.
-Apply compare_convert_INFERIEUR; Auto.
-Apply ZC2; Auto.
-Intros H' H'0; Rewrite (true_sub_convert n1 m1); Auto with real.
-Rewrite (pow_RN_plus x (minus (convert n1) (convert m1)) (convert m1));
- Auto with real.
-Rewrite plus_sym; Rewrite le_plus_minus_r; Auto with real.
-Apply lt_le_weak.
-Change (gt (convert n1) (convert m1)).
-Apply compare_convert_SUPERIEUR; Auto.
+case_eq ((n1 ?= m1)%positive Datatypes.Eq); simpl in |- *; auto with real.
+intros H' H'0; rewrite Pcompare_Eq_eq with (1 := H'); auto with real.
+intros H' H'0; rewrite (nat_of_P_minus_morphism m1 n1); auto with real.
+rewrite (pow_RN_plus x (nat_of_P m1 - nat_of_P n1) (nat_of_P n1));
+ auto with real.
+rewrite plus_comm; rewrite le_plus_minus_r; auto with real.
+rewrite Rinv_mult_distr; auto with real.
+rewrite Rinv_involutive; auto with real.
+apply lt_le_weak.
+apply nat_of_P_lt_Lt_compare_morphism; auto.
+apply ZC2; auto.
+intros H' H'0; rewrite (nat_of_P_minus_morphism n1 m1); auto with real.
+rewrite (pow_RN_plus x (nat_of_P n1 - nat_of_P m1) (nat_of_P m1));
+ auto with real.
+rewrite plus_comm; rewrite le_plus_minus_r; auto with real.
+apply lt_le_weak.
+change (nat_of_P n1 > nat_of_P m1)%nat in |- *.
+apply nat_of_P_gt_Gt_compare_morphism; auto.
(* NEG/POS *)
-(CaseEqk '(compare n1 m1 EGAL)); Simpl; Auto with real.
-Intros H' H'0; Rewrite compare_convert_EGAL with 1 := H'; Auto with real.
-Intros H' H'0; Rewrite (true_sub_convert m1 n1); Auto with real.
-Rewrite (pow_RN_plus x (minus (convert m1) (convert n1)) (convert n1));
- Auto with real.
-Rewrite plus_sym; Rewrite le_plus_minus_r; Auto with real.
-Apply lt_le_weak.
-Apply compare_convert_INFERIEUR; Auto.
-Apply ZC2; Auto.
-Intros H' H'0; Rewrite (true_sub_convert n1 m1); Auto with real.
-Rewrite (pow_RN_plus x (minus (convert n1) (convert m1)) (convert m1));
- Auto with real.
-Rewrite plus_sym; Rewrite le_plus_minus_r; Auto with real.
-Rewrite Rinv_Rmult; Auto with real.
-Apply lt_le_weak.
-Change (gt (convert n1) (convert m1)).
-Apply compare_convert_SUPERIEUR; Auto.
+case_eq ((n1 ?= m1)%positive Datatypes.Eq); simpl in |- *; auto with real.
+intros H' H'0; rewrite Pcompare_Eq_eq with (1 := H'); auto with real.
+intros H' H'0; rewrite (nat_of_P_minus_morphism m1 n1); auto with real.
+rewrite (pow_RN_plus x (nat_of_P m1 - nat_of_P n1) (nat_of_P n1));
+ auto with real.
+rewrite plus_comm; rewrite le_plus_minus_r; auto with real.
+apply lt_le_weak.
+apply nat_of_P_lt_Lt_compare_morphism; auto.
+apply ZC2; auto.
+intros H' H'0; rewrite (nat_of_P_minus_morphism n1 m1); auto with real.
+rewrite (pow_RN_plus x (nat_of_P n1 - nat_of_P m1) (nat_of_P m1));
+ auto with real.
+rewrite plus_comm; rewrite le_plus_minus_r; auto with real.
+rewrite Rinv_mult_distr; auto with real.
+apply lt_le_weak.
+change (nat_of_P n1 > nat_of_P m1)%nat in |- *.
+apply nat_of_P_gt_Gt_compare_morphism; auto.
(* NEG/NEG *)
-Rewrite convert_add; Auto with real.
-Intros H'; Rewrite pow_add; Auto with real.
-Apply Rinv_Rmult; Auto.
-Apply pow_nonzero; Auto.
-Apply pow_nonzero; Auto.
+rewrite nat_of_P_plus_morphism; auto with real.
+intros H'; rewrite pow_add; auto with real.
+apply Rinv_mult_distr; auto.
+apply pow_nonzero; auto.
+apply pow_nonzero; auto.
Qed.
-Hints Resolve powerRZ_O powerRZ_1 powerRZ_NOR powerRZ_add :real.
+Hint Resolve powerRZ_O powerRZ_1 powerRZ_NOR powerRZ_add: real.
-Lemma Zpower_nat_powerRZ:
- (n, m : nat)
- (IZR (Zpower_nat (inject_nat n) m)) == (powerRZ (INR n) (inject_nat m)).
-Proof.
-Intros n m; Elim m; Simpl; Auto with real.
-Intros m1 H'; Rewrite bij1; Simpl.
-Replace (Zpower_nat (inject_nat n) (S m1))
- with (Zmult (inject_nat n) (Zpower_nat (inject_nat n) m1)).
-Rewrite mult_IZR; Auto with real.
-Repeat Rewrite <- INR_IZR_INZ; Simpl.
-Rewrite H'; Simpl.
-Case m1; Simpl; Auto with real.
-Intros m2; Rewrite bij1; Auto.
-Unfold Zpower_nat; Auto.
+Lemma Zpower_nat_powerRZ :
+ forall n m:nat, IZR (Zpower_nat (Z_of_nat n) m) = INR n ^Z Z_of_nat m.
+Proof.
+intros n m; elim m; simpl in |- *; auto with real.
+intros m1 H'; rewrite nat_of_P_o_P_of_succ_nat_eq_succ; simpl in |- *.
+replace (Zpower_nat (Z_of_nat n) (S m1)) with
+ (Z_of_nat n * Zpower_nat (Z_of_nat n) m1)%Z.
+rewrite mult_IZR; auto with real.
+repeat rewrite <- INR_IZR_INZ; simpl in |- *.
+rewrite H'; simpl in |- *.
+case m1; simpl in |- *; auto with real.
+intros m2; rewrite nat_of_P_o_P_of_succ_nat_eq_succ; auto.
+unfold Zpower_nat in |- *; auto.
Qed.
-Lemma powerRZ_lt: (x : R) (z : Z) (Rlt R0 x) -> (Rlt R0 (powerRZ x z)).
+Lemma powerRZ_lt : forall (x:R) (z:Z), 0 < x -> 0 < x ^Z z.
Proof.
-Intros x z; Case z; Simpl; Auto with real.
+intros x z; case z; simpl in |- *; auto with real.
Qed.
-Hints Resolve powerRZ_lt :real.
+Hint Resolve powerRZ_lt: real.
-Lemma powerRZ_le: (x : R) (z : Z) (Rlt R0 x) -> (Rle R0 (powerRZ x z)).
+Lemma powerRZ_le : forall (x:R) (z:Z), 0 < x -> 0 <= x ^Z z.
Proof.
-Intros x z H'; Apply Rlt_le; Auto with real.
+intros x z H'; apply Rlt_le; auto with real.
Qed.
-Hints Resolve powerRZ_le :real.
+Hint Resolve powerRZ_le: real.
-Lemma Zpower_nat_powerRZ_absolu:
- (n, m : Z)
- (Zle ZERO m) -> (IZR (Zpower_nat n (absolu m))) == (powerRZ (IZR n) m).
+Lemma Zpower_nat_powerRZ_absolu :
+ forall n m:Z, (0 <= m)%Z -> IZR (Zpower_nat n (Zabs_nat m)) = IZR n ^Z m.
Proof.
-Intros n m; Case m; Simpl; Auto with zarith.
-Intros p H'; Elim (convert p); Simpl; Auto with zarith.
-Intros n0 H'0; Rewrite <- H'0; Simpl; Auto with zarith.
-Rewrite <- mult_IZR; Auto.
-Intros p H'; Absurd `0 <= (NEG p)`;Auto with zarith.
+intros n m; case m; simpl in |- *; auto with zarith.
+intros p H'; elim (nat_of_P p); simpl in |- *; auto with zarith.
+intros n0 H'0; rewrite <- H'0; simpl in |- *; auto with zarith.
+rewrite <- mult_IZR; auto.
+intros p H'; absurd (0 <= Zneg p)%Z; auto with zarith.
Qed.
-Lemma powerRZ_R1: (n : Z) (powerRZ R1 n) == R1.
+Lemma powerRZ_R1 : forall n:Z, 1 ^Z n = 1.
Proof.
-Intros n; Case n; Simpl; Auto.
-Intros p; Elim (convert p); Simpl; Auto; Intros n0 H'; Rewrite H'; Ring.
-Intros p; Elim (convert p); Simpl.
-Exact Rinv_R1.
-Intros n1 H'; Rewrite Rinv_Rmult; Try Rewrite Rinv_R1; Try Rewrite H';
- Auto with real.
+intros n; case n; simpl in |- *; auto.
+intros p; elim (nat_of_P p); simpl in |- *; auto; intros n0 H'; rewrite H';
+ ring.
+intros p; elim (nat_of_P p); simpl in |- *.
+exact Rinv_1.
+intros n1 H'; rewrite Rinv_mult_distr; try rewrite Rinv_1; try rewrite H';
+ auto with real.
Qed.
(*******************************)
(** Sum of n first naturals *)
(*******************************)
(*********)
-Fixpoint sum_nat_f_O [f:nat->nat;n:nat]:nat:=
- Cases n of
- O => (f O)
- |(S n') => (plus (sum_nat_f_O f n') (f (S n')))
+Fixpoint sum_nat_f_O (f:nat -> nat) (n:nat) {struct n} : nat :=
+ match n with
+ | O => f 0%nat
+ | S n' => (sum_nat_f_O f n' + f (S n'))%nat
end.
(*********)
-Definition sum_nat_f [s,n:nat;f:nat->nat]:nat:=
- (sum_nat_f_O [x:nat](f (plus x s)) (minus n s)).
+Definition sum_nat_f (s n:nat) (f:nat -> nat) : nat :=
+ sum_nat_f_O (fun x:nat => f (x + s)%nat) (n - s).
(*********)
-Definition sum_nat_O [n:nat]:nat:=
- (sum_nat_f_O [x:nat]x n).
+Definition sum_nat_O (n:nat) : nat := sum_nat_f_O (fun x:nat => x) n.
(*********)
-Definition sum_nat [s,n:nat]:nat:=
- (sum_nat_f s n [x:nat]x).
+Definition sum_nat (s n:nat) : nat := sum_nat_f s n (fun x:nat => x).
(*******************************)
(** Sum *)
(*******************************)
(*********)
-Fixpoint sum_f_R0 [f:nat->R;N:nat]:R:=
- Cases N of
- O => (f O)
- |(S i) => (Rplus (sum_f_R0 f i) (f (S i)))
+Fixpoint sum_f_R0 (f:nat -> R) (N:nat) {struct N} : R :=
+ match N with
+ | O => f 0%nat
+ | S i => sum_f_R0 f i + f (S i)
end.
(*********)
-Definition sum_f [s,n:nat;f:nat->R]:R:=
- (sum_f_R0 [x:nat](f (plus x s)) (minus n s)).
-
-Lemma GP_finite:
- (x:R) (n:nat) (Rmult (sum_f_R0 [n:nat] (pow x n) n)
- (Rminus x R1)) ==
- (Rminus (pow x (plus n (1))) R1).
-Proof.
-Intros; Induction n; Simpl.
-Ring.
-Rewrite Rmult_Rplus_distrl;Rewrite Hrecn;Cut (plus n (1))=(S n).
-Intro H;Rewrite H;Simpl;Ring.
-Omega.
-Qed.
-
-Lemma sum_f_R0_triangle:
- (x:nat->R)(n:nat) (Rle (Rabsolu (sum_f_R0 x n))
- (sum_f_R0 [i:nat] (Rabsolu (x i)) n)).
-Proof.
-Intro; Induction n; Simpl.
-Unfold Rle; Right; Reflexivity.
-Intro m; Intro;Apply (Rle_trans
- (Rabsolu (Rplus (sum_f_R0 x m) (x (S m))))
- (Rplus (Rabsolu (sum_f_R0 x m))
- (Rabsolu (x (S m))))
- (Rplus (sum_f_R0 [i:nat](Rabsolu (x i)) m)
- (Rabsolu (x (S m))))).
-Apply Rabsolu_triang.
-Rewrite Rplus_sym;Rewrite (Rplus_sym
- (sum_f_R0 [i:nat](Rabsolu (x i)) m) (Rabsolu (x (S m))));
- Apply Rle_compatibility;Assumption.
+Definition sum_f (s n:nat) (f:nat -> R) : R :=
+ sum_f_R0 (fun x:nat => f (x + s)%nat) (n - s).
+
+Lemma GP_finite :
+ forall (x:R) (n:nat),
+ sum_f_R0 (fun n:nat => x ^ n) n * (x - 1) = x ^ (n + 1) - 1.
+Proof.
+intros; induction n as [| n Hrecn]; simpl in |- *.
+ring.
+rewrite Rmult_plus_distr_r; rewrite Hrecn; cut ((n + 1)%nat = S n).
+intro H; rewrite H; simpl in |- *; ring.
+omega.
+Qed.
+
+Lemma sum_f_R0_triangle :
+ forall (x:nat -> R) (n:nat),
+ Rabs (sum_f_R0 x n) <= sum_f_R0 (fun i:nat => Rabs (x i)) n.
+Proof.
+intro; simple induction n; simpl in |- *.
+unfold Rle in |- *; right; reflexivity.
+intro m; intro;
+ apply
+ (Rle_trans (Rabs (sum_f_R0 x m + x (S m)))
+ (Rabs (sum_f_R0 x m) + Rabs (x (S m)))
+ (sum_f_R0 (fun i:nat => Rabs (x i)) m + Rabs (x (S m)))).
+apply Rabs_triang.
+rewrite Rplus_comm;
+ rewrite (Rplus_comm (sum_f_R0 (fun i:nat => Rabs (x i)) m) (Rabs (x (S m))));
+ apply Rplus_le_compat_l; assumption.
Qed.
(*******************************)
@@ -764,69 +725,69 @@ Qed.
(*******************************)
(*********)
-Definition R_dist:R->R->R:=[x,y:R](Rabsolu (Rminus x y)).
+Definition R_dist (x y:R) : R := Rabs (x - y).
(*********)
-Lemma R_dist_pos:(x,y:R)(Rge (R_dist x y) R0).
+Lemma R_dist_pos : forall x y:R, R_dist x y >= 0.
Proof.
-Intros;Unfold R_dist;Unfold Rabsolu;Case (case_Rabsolu (Rminus x y));Intro l.
-Unfold Rge;Left;Apply (Rlt_RoppO (Rminus x y) l).
-Trivial.
+intros; unfold R_dist in |- *; unfold Rabs in |- *; case (Rcase_abs (x - y));
+ intro l.
+unfold Rge in |- *; left; apply (Ropp_gt_lt_0_contravar (x - y) l).
+trivial.
Qed.
(*********)
-Lemma R_dist_sym:(x,y:R)(R_dist x y)==(R_dist y x).
+Lemma R_dist_sym : forall x y:R, R_dist x y = R_dist y x.
Proof.
-Unfold R_dist;Intros;SplitAbsolu;Ring.
-Generalize (Rlt_RoppO (Rminus y x) r); Intro;
- Rewrite (Ropp_distr2 y x) in H;
- Generalize (Rlt_antisym (Rminus x y) R0 r0); Intro;Unfold Rgt in H;
- ElimType False; Auto.
-Generalize (minus_Rge y x r); Intro;
- Generalize (minus_Rge x y r0); Intro;
- Generalize (Rge_ge_eq x y H0 H); Intro;Rewrite H1;Ring.
+unfold R_dist in |- *; intros; split_Rabs; ring.
+generalize (Ropp_gt_lt_0_contravar (y - x) r); intro;
+ rewrite (Ropp_minus_distr y x) in H; generalize (Rlt_asym (x - y) 0 r0);
+ intro; unfold Rgt in H; elimtype False; auto.
+generalize (minus_Rge y x r); intro; generalize (minus_Rge x y r0); intro;
+ generalize (Rge_antisym x y H0 H); intro; rewrite H1;
+ ring.
Qed.
(*********)
-Lemma R_dist_refl:(x,y:R)((R_dist x y)==R0<->x==y).
+Lemma R_dist_refl : forall x y:R, R_dist x y = 0 <-> x = y.
Proof.
-Unfold R_dist;Intros;SplitAbsolu;Split;Intros.
-Rewrite (Ropp_distr2 x y) in H;Apply sym_eqT;
- Apply (Rminus_eq y x H).
-Rewrite (Ropp_distr2 x y);Generalize (sym_eqT R x y H);Intro;
- Apply (eq_Rminus y x H0).
-Apply (Rminus_eq x y H).
-Apply (eq_Rminus x y H).
+unfold R_dist in |- *; intros; split_Rabs; split; intros.
+rewrite (Ropp_minus_distr x y) in H; apply sym_eq;
+ apply (Rminus_diag_uniq y x H).
+rewrite (Ropp_minus_distr x y); generalize (sym_eq H); intro;
+ apply (Rminus_diag_eq y x H0).
+apply (Rminus_diag_uniq x y H).
+apply (Rminus_diag_eq x y H).
Qed.
-Lemma R_dist_eq:(x:R)(R_dist x x)==R0.
+Lemma R_dist_eq : forall x:R, R_dist x x = 0.
Proof.
-Unfold R_dist;Intros;SplitAbsolu;Intros;Ring.
+unfold R_dist in |- *; intros; split_Rabs; intros; ring.
Qed.
(***********)
-Lemma R_dist_tri:(x,y,z:R)(Rle (R_dist x y)
- (Rplus (R_dist x z) (R_dist z y))).
+Lemma R_dist_tri : forall x y z:R, R_dist x y <= R_dist x z + R_dist z y.
Proof.
-Intros;Unfold R_dist; Replace ``x-y`` with ``(x-z)+(z-y)``;
- [Apply (Rabsolu_triang ``x-z`` ``z-y``)|Ring].
+intros; unfold R_dist in |- *; replace (x - y) with (x - z + (z - y));
+ [ apply (Rabs_triang (x - z) (z - y)) | ring ].
Qed.
(*********)
-Lemma R_dist_plus: (a,b,c,d:R)(Rle (R_dist (Rplus a c) (Rplus b d))
- (Rplus (R_dist a b) (R_dist c d))).
+Lemma R_dist_plus :
+ forall a b c d:R, R_dist (a + c) (b + d) <= R_dist a b + R_dist c d.
Proof.
-Intros;Unfold R_dist;
- Replace (Rminus (Rplus a c) (Rplus b d))
- with (Rplus (Rminus a b) (Rminus c d)).
-Exact (Rabsolu_triang (Rminus a b) (Rminus c d)).
-Ring.
+intros; unfold R_dist in |- *;
+ replace (a + c - (b + d)) with (a - b + (c - d)).
+exact (Rabs_triang (a - b) (c - d)).
+ring.
Qed.
(*******************************)
(** Infinit Sum *)
(*******************************)
(*********)
-Definition infinit_sum:(nat->R)->R->Prop:=[s:nat->R;l:R]
- (eps:R)(Rgt eps R0)->
- (Ex[N:nat](n:nat)(ge n N)->(Rlt (R_dist (sum_f_R0 s n) l) eps)).
+Definition infinit_sum (s:nat -> R) (l:R) : Prop :=
+ forall eps:R,
+ eps > 0 ->
+ exists N : nat
+ | (forall n:nat, (n >= N)%nat -> R_dist (sum_f_R0 s n) l < eps). \ No newline at end of file
diff --git a/theories/Reals/Rgeom.v b/theories/Reals/Rgeom.v
index 6e7a3bc67..522ae235c 100644
--- a/theories/Reals/Rgeom.v
+++ b/theories/Reals/Rgeom.v
@@ -8,77 +8,180 @@
(*i $Id$ i*)
-Require Rbase.
-Require Rfunctions.
-Require SeqSeries.
-Require Rtrigo.
-Require R_sqrt.
-V7only [Import R_scope.]. Open Local Scope R_scope.
-
-Definition dist_euc [x0,y0,x1,y1:R] : R := ``(sqrt ((Rsqr (x0-x1))+(Rsqr (y0-y1))))``.
-
-Lemma distance_refl : (x0,y0:R) ``(dist_euc x0 y0 x0 y0)==0``.
-Intros x0 y0; Unfold dist_euc; Apply Rsqr_inj; [Apply sqrt_positivity; Apply ge0_plus_ge0_is_ge0; [Apply pos_Rsqr | Apply pos_Rsqr] | Right; Reflexivity | Rewrite Rsqr_O; Rewrite Rsqr_sqrt; [Unfold Rsqr; Ring | Apply ge0_plus_ge0_is_ge0; [Apply pos_Rsqr | Apply pos_Rsqr]]].
+Require Import Rbase.
+Require Import Rfunctions.
+Require Import SeqSeries.
+Require Import Rtrigo.
+Require Import R_sqrt. Open Local Scope R_scope.
+
+Definition dist_euc (x0 y0 x1 y1:R) : R :=
+ sqrt (Rsqr (x0 - x1) + Rsqr (y0 - y1)).
+
+Lemma distance_refl : forall x0 y0:R, dist_euc x0 y0 x0 y0 = 0.
+intros x0 y0; unfold dist_euc in |- *; apply Rsqr_inj;
+ [ apply sqrt_positivity; apply Rplus_le_le_0_compat;
+ [ apply Rle_0_sqr | apply Rle_0_sqr ]
+ | right; reflexivity
+ | rewrite Rsqr_0; rewrite Rsqr_sqrt;
+ [ unfold Rsqr in |- *; ring
+ | apply Rplus_le_le_0_compat; [ apply Rle_0_sqr | apply Rle_0_sqr ] ] ].
Qed.
-Lemma distance_symm : (x0,y0,x1,y1:R) ``(dist_euc x0 y0 x1 y1) == (dist_euc x1 y1 x0 y0)``.
-Intros x0 y0 x1 y1; Unfold dist_euc; Apply Rsqr_inj; [ Apply sqrt_positivity; Apply ge0_plus_ge0_is_ge0 | Apply sqrt_positivity; Apply ge0_plus_ge0_is_ge0 | Repeat Rewrite Rsqr_sqrt; [Unfold Rsqr; Ring | Apply ge0_plus_ge0_is_ge0 |Apply ge0_plus_ge0_is_ge0]]; Apply pos_Rsqr.
+Lemma distance_symm :
+ forall x0 y0 x1 y1:R, dist_euc x0 y0 x1 y1 = dist_euc x1 y1 x0 y0.
+intros x0 y0 x1 y1; unfold dist_euc in |- *; apply Rsqr_inj;
+ [ apply sqrt_positivity; apply Rplus_le_le_0_compat
+ | apply sqrt_positivity; apply Rplus_le_le_0_compat
+ | repeat rewrite Rsqr_sqrt;
+ [ unfold Rsqr in |- *; ring
+ | apply Rplus_le_le_0_compat
+ | apply Rplus_le_le_0_compat ] ]; apply Rle_0_sqr.
Qed.
-Lemma law_cosines : (x0,y0,x1,y1,x2,y2,ac:R) let a = (dist_euc x1 y1 x0 y0) in let b=(dist_euc x2 y2 x0 y0) in let c=(dist_euc x2 y2 x1 y1) in ( ``a*c*(cos ac) == ((x0-x1)*(x2-x1) + (y0-y1)*(y2-y1))`` -> ``(Rsqr b)==(Rsqr c)+(Rsqr a)-2*(a*c*(cos ac))`` ).
-Unfold dist_euc; Intros; Repeat Rewrite -> Rsqr_sqrt; [ Rewrite H; Unfold Rsqr; Ring | Apply ge0_plus_ge0_is_ge0 | Apply ge0_plus_ge0_is_ge0 | Apply ge0_plus_ge0_is_ge0]; Apply pos_Rsqr.
+Lemma law_cosines :
+ forall x0 y0 x1 y1 x2 y2 ac:R,
+ let a := dist_euc x1 y1 x0 y0 in
+ let b := dist_euc x2 y2 x0 y0 in
+ let c := dist_euc x2 y2 x1 y1 in
+ a * c * cos ac = (x0 - x1) * (x2 - x1) + (y0 - y1) * (y2 - y1) ->
+ Rsqr b = Rsqr c + Rsqr a - 2 * (a * c * cos ac).
+unfold dist_euc in |- *; intros; repeat rewrite Rsqr_sqrt;
+ [ rewrite H; unfold Rsqr in |- *; ring
+ | apply Rplus_le_le_0_compat
+ | apply Rplus_le_le_0_compat
+ | apply Rplus_le_le_0_compat ]; apply Rle_0_sqr.
Qed.
-Lemma triangle : (x0,y0,x1,y1,x2,y2:R) ``(dist_euc x0 y0 x1 y1)<=(dist_euc x0 y0 x2 y2)+(dist_euc x2 y2 x1 y1)``.
-Intros; Unfold dist_euc; Apply Rsqr_incr_0; [Rewrite Rsqr_plus; Repeat Rewrite Rsqr_sqrt; [Replace ``(Rsqr (x0-x1))`` with ``(Rsqr (x0-x2))+(Rsqr (x2-x1))+2*(x0-x2)*(x2-x1)``; [Replace ``(Rsqr (y0-y1))`` with ``(Rsqr (y0-y2))+(Rsqr (y2-y1))+2*(y0-y2)*(y2-y1)``; [Apply Rle_anti_compatibility with ``-(Rsqr (x0-x2))-(Rsqr (x2-x1))-(Rsqr (y0-y2))-(Rsqr (y2-y1))``; Replace `` -(Rsqr (x0-x2))-(Rsqr (x2-x1))-(Rsqr (y0-y2))-(Rsqr (y2-y1))+((Rsqr (x0-x2))+(Rsqr (x2-x1))+2*(x0-x2)*(x2-x1)+((Rsqr (y0-y2))+(Rsqr (y2-y1))+2*(y0-y2)*(y2-y1)))`` with ``2*((x0-x2)*(x2-x1)+(y0-y2)*(y2-y1))``; [Replace ``-(Rsqr (x0-x2))-(Rsqr (x2-x1))-(Rsqr (y0-y2))-(Rsqr (y2-y1))+((Rsqr (x0-x2))+(Rsqr (y0-y2))+((Rsqr (x2-x1))+(Rsqr (y2-y1)))+2*(sqrt ((Rsqr (x0-x2))+(Rsqr (y0-y2))))*(sqrt ((Rsqr (x2-x1))+(Rsqr (y2-y1)))))`` with ``2*((sqrt ((Rsqr (x0-x2))+(Rsqr (y0-y2))))*(sqrt ((Rsqr (x2-x1))+(Rsqr (y2-y1)))))``; [Apply Rle_monotony; [Left; Cut ~(O=(2)); [Intros; Generalize (lt_INR_0 (2) (neq_O_lt (2) H)); Intro H0; Assumption | Discriminate] | Apply sqrt_cauchy] | Ring] | Ring] | SqRing] | SqRing] | Apply ge0_plus_ge0_is_ge0; Apply pos_Rsqr | Apply ge0_plus_ge0_is_ge0; Apply pos_Rsqr | Apply ge0_plus_ge0_is_ge0; Apply pos_Rsqr] | Apply sqrt_positivity; Apply ge0_plus_ge0_is_ge0; Apply pos_Rsqr | Apply ge0_plus_ge0_is_ge0; Apply sqrt_positivity; Apply ge0_plus_ge0_is_ge0; Apply pos_Rsqr].
+Lemma triangle :
+ forall x0 y0 x1 y1 x2 y2:R,
+ dist_euc x0 y0 x1 y1 <= dist_euc x0 y0 x2 y2 + dist_euc x2 y2 x1 y1.
+intros; unfold dist_euc in |- *; apply Rsqr_incr_0;
+ [ rewrite Rsqr_plus; repeat rewrite Rsqr_sqrt;
+ [ replace (Rsqr (x0 - x1)) with
+ (Rsqr (x0 - x2) + Rsqr (x2 - x1) + 2 * (x0 - x2) * (x2 - x1));
+ [ replace (Rsqr (y0 - y1)) with
+ (Rsqr (y0 - y2) + Rsqr (y2 - y1) + 2 * (y0 - y2) * (y2 - y1));
+ [ apply Rplus_le_reg_l with
+ (- Rsqr (x0 - x2) - Rsqr (x2 - x1) - Rsqr (y0 - y2) -
+ Rsqr (y2 - y1));
+ replace
+ (- Rsqr (x0 - x2) - Rsqr (x2 - x1) - Rsqr (y0 - y2) -
+ Rsqr (y2 - y1) +
+ (Rsqr (x0 - x2) + Rsqr (x2 - x1) + 2 * (x0 - x2) * (x2 - x1) +
+ (Rsqr (y0 - y2) + Rsqr (y2 - y1) + 2 * (y0 - y2) * (y2 - y1))))
+ with (2 * ((x0 - x2) * (x2 - x1) + (y0 - y2) * (y2 - y1)));
+ [ replace
+ (- Rsqr (x0 - x2) - Rsqr (x2 - x1) - Rsqr (y0 - y2) -
+ Rsqr (y2 - y1) +
+ (Rsqr (x0 - x2) + Rsqr (y0 - y2) +
+ (Rsqr (x2 - x1) + Rsqr (y2 - y1)) +
+ 2 * sqrt (Rsqr (x0 - x2) + Rsqr (y0 - y2)) *
+ sqrt (Rsqr (x2 - x1) + Rsqr (y2 - y1)))) with
+ (2 *
+ (sqrt (Rsqr (x0 - x2) + Rsqr (y0 - y2)) *
+ sqrt (Rsqr (x2 - x1) + Rsqr (y2 - y1))));
+ [ apply Rmult_le_compat_l;
+ [ left; cut (0%nat <> 2%nat);
+ [ intros; generalize (lt_INR_0 2 (neq_O_lt 2 H));
+ intro H0; assumption
+ | discriminate ]
+ | apply sqrt_cauchy ]
+ | ring ]
+ | ring ]
+ | ring_Rsqr ]
+ | ring_Rsqr ]
+ | apply Rplus_le_le_0_compat; apply Rle_0_sqr
+ | apply Rplus_le_le_0_compat; apply Rle_0_sqr
+ | apply Rplus_le_le_0_compat; apply Rle_0_sqr ]
+ | apply sqrt_positivity; apply Rplus_le_le_0_compat; apply Rle_0_sqr
+ | apply Rplus_le_le_0_compat; apply sqrt_positivity;
+ apply Rplus_le_le_0_compat; apply Rle_0_sqr ].
Qed.
(******************************************************************)
(** Translation *)
(******************************************************************)
-Definition xt[x,tx:R] : R := ``x+tx``.
-Definition yt[y,ty:R] : R := ``y+ty``.
+Definition xt (x tx:R) : R := x + tx.
+Definition yt (y ty:R) : R := y + ty.
-Lemma translation_0 : (x,y:R) ``(xt x 0)==x``/\``(yt y 0)==y``.
-Intros x y; Split; [Unfold xt | Unfold yt]; Ring.
+Lemma translation_0 : forall x y:R, xt x 0 = x /\ yt y 0 = y.
+intros x y; split; [ unfold xt in |- * | unfold yt in |- * ]; ring.
Qed.
-Lemma isometric_translation : (x1,x2,y1,y2,tx,ty:R) ``(Rsqr (x1-x2))+(Rsqr (y1-y2))==(Rsqr ((xt x1 tx)-(xt x2 tx)))+(Rsqr ((yt y1 ty)-(yt y2 ty)))``.
-Intros; Unfold Rsqr xt yt; Ring.
+Lemma isometric_translation :
+ forall x1 x2 y1 y2 tx ty:R,
+ Rsqr (x1 - x2) + Rsqr (y1 - y2) =
+ Rsqr (xt x1 tx - xt x2 tx) + Rsqr (yt y1 ty - yt y2 ty).
+intros; unfold Rsqr, xt, yt in |- *; ring.
Qed.
(******************************************************************)
(** Rotation *)
(******************************************************************)
-Definition xr [x,y,theta:R] : R := ``x*(cos theta)+y*(sin theta)``.
-Definition yr [x,y,theta:R] : R := ``-x*(sin theta)+y*(cos theta)``.
+Definition xr (x y theta:R) : R := x * cos theta + y * sin theta.
+Definition yr (x y theta:R) : R := - x * sin theta + y * cos theta.
-Lemma rotation_0 : (x,y:R) ``(xr x y 0)==x`` /\ ``(yr x y 0)==y``.
-Intros x y; Unfold xr yr; Split; Rewrite cos_0; Rewrite sin_0; Ring.
+Lemma rotation_0 : forall x y:R, xr x y 0 = x /\ yr x y 0 = y.
+intros x y; unfold xr, yr in |- *; split; rewrite cos_0; rewrite sin_0; ring.
Qed.
-Lemma rotation_PI2 : (x,y:R) ``(xr x y PI/2)==y`` /\ ``(yr x y PI/2)==-x``.
-Intros x y; Unfold xr yr; Split; Rewrite cos_PI2; Rewrite sin_PI2; Ring.
+Lemma rotation_PI2 :
+ forall x y:R, xr x y (PI / 2) = y /\ yr x y (PI / 2) = - x.
+intros x y; unfold xr, yr in |- *; split; rewrite cos_PI2; rewrite sin_PI2;
+ ring.
Qed.
-Lemma isometric_rotation_0 : (x1,y1,x2,y2,theta:R) ``(Rsqr (x1-x2))+(Rsqr (y1-y2)) == (Rsqr ((xr x1 y1 theta))-(xr x2 y2 theta)) + (Rsqr ((yr x1 y1 theta))-(yr x2 y2 theta))``.
-Intros; Unfold xr yr; Replace ``x1*(cos theta)+y1*(sin theta)-(x2*(cos theta)+y2*(sin theta))`` with ``(cos theta)*(x1-x2)+(sin theta)*(y1-y2)``; [Replace ``-x1*(sin theta)+y1*(cos theta)-( -x2*(sin theta)+y2*(cos theta))`` with ``(cos theta)*(y1-y2)+(sin theta)*(x2-x1)``; [Repeat Rewrite Rsqr_plus; Repeat Rewrite Rsqr_times; Repeat Rewrite cos2; Ring; Replace ``x2-x1`` with ``-(x1-x2)``; [Rewrite <- Rsqr_neg; Ring | Ring] |Ring] | Ring].
+Lemma isometric_rotation_0 :
+ forall x1 y1 x2 y2 theta:R,
+ Rsqr (x1 - x2) + Rsqr (y1 - y2) =
+ Rsqr (xr x1 y1 theta - xr x2 y2 theta) +
+ Rsqr (yr x1 y1 theta - yr x2 y2 theta).
+intros; unfold xr, yr in |- *;
+ replace
+ (x1 * cos theta + y1 * sin theta - (x2 * cos theta + y2 * sin theta)) with
+ (cos theta * (x1 - x2) + sin theta * (y1 - y2));
+ [ replace
+ (- x1 * sin theta + y1 * cos theta - (- x2 * sin theta + y2 * cos theta))
+ with (cos theta * (y1 - y2) + sin theta * (x2 - x1));
+ [ repeat rewrite Rsqr_plus; repeat rewrite Rsqr_mult; repeat rewrite cos2;
+ ring; replace (x2 - x1) with (- (x1 - x2));
+ [ rewrite <- Rsqr_neg; ring | ring ]
+ | ring ]
+ | ring ].
Qed.
-Lemma isometric_rotation : (x1,y1,x2,y2,theta:R) ``(dist_euc x1 y1 x2 y2) == (dist_euc (xr x1 y1 theta) (yr x1 y1 theta) (xr x2 y2 theta) (yr x2 y2 theta))``.
-Unfold dist_euc; Intros; Apply Rsqr_inj; [Apply sqrt_positivity; Apply ge0_plus_ge0_is_ge0 | Apply sqrt_positivity; Apply ge0_plus_ge0_is_ge0 | Repeat Rewrite Rsqr_sqrt; [ Apply isometric_rotation_0 | Apply ge0_plus_ge0_is_ge0 | Apply ge0_plus_ge0_is_ge0]]; Apply pos_Rsqr.
+Lemma isometric_rotation :
+ forall x1 y1 x2 y2 theta:R,
+ dist_euc x1 y1 x2 y2 =
+ dist_euc (xr x1 y1 theta) (yr x1 y1 theta) (xr x2 y2 theta)
+ (yr x2 y2 theta).
+unfold dist_euc in |- *; intros; apply Rsqr_inj;
+ [ apply sqrt_positivity; apply Rplus_le_le_0_compat
+ | apply sqrt_positivity; apply Rplus_le_le_0_compat
+ | repeat rewrite Rsqr_sqrt;
+ [ apply isometric_rotation_0
+ | apply Rplus_le_le_0_compat
+ | apply Rplus_le_le_0_compat ] ]; apply Rle_0_sqr.
Qed.
(******************************************************************)
(** Similarity *)
(******************************************************************)
-Lemma isometric_rot_trans : (x1,y1,x2,y2,tx,ty,theta:R) ``(Rsqr (x1-x2))+(Rsqr (y1-y2)) == (Rsqr ((xr (xt x1 tx) (yt y1 ty) theta)-(xr (xt x2 tx) (yt y2 ty) theta))) + (Rsqr ((yr (xt x1 tx) (yt y1 ty) theta)-(yr (xt x2 tx) (yt y2 ty) theta)))``.
-Intros; Rewrite <- isometric_rotation_0; Apply isometric_translation.
+Lemma isometric_rot_trans :
+ forall x1 y1 x2 y2 tx ty theta:R,
+ Rsqr (x1 - x2) + Rsqr (y1 - y2) =
+ Rsqr (xr (xt x1 tx) (yt y1 ty) theta - xr (xt x2 tx) (yt y2 ty) theta) +
+ Rsqr (yr (xt x1 tx) (yt y1 ty) theta - yr (xt x2 tx) (yt y2 ty) theta).
+intros; rewrite <- isometric_rotation_0; apply isometric_translation.
Qed.
-Lemma isometric_trans_rot : (x1,y1,x2,y2,tx,ty,theta:R) ``(Rsqr (x1-x2))+(Rsqr (y1-y2)) == (Rsqr ((xt (xr x1 y1 theta) tx)-(xt (xr x2 y2 theta) tx))) + (Rsqr ((yt (yr x1 y1 theta) ty)-(yt (yr x2 y2 theta) ty)))``.
-Intros; Rewrite <- isometric_translation; Apply isometric_rotation_0.
-Qed.
+Lemma isometric_trans_rot :
+ forall x1 y1 x2 y2 tx ty theta:R,
+ Rsqr (x1 - x2) + Rsqr (y1 - y2) =
+ Rsqr (xt (xr x1 y1 theta) tx - xt (xr x2 y2 theta) tx) +
+ Rsqr (yt (yr x1 y1 theta) ty - yt (yr x2 y2 theta) ty).
+intros; rewrite <- isometric_translation; apply isometric_rotation_0.
+Qed. \ No newline at end of file
diff --git a/theories/Reals/RiemannInt.v b/theories/Reals/RiemannInt.v
index a44f3c1b5..2766aa2fe 100644
--- a/theories/Reals/RiemannInt.v
+++ b/theories/Reals/RiemannInt.v
@@ -8,1692 +8,3256 @@
(*i $Id$ i*)
-Require Rfunctions.
-Require SeqSeries.
-Require Ranalysis.
-Require Rbase.
-Require RiemannInt_SF.
-Require Classical_Prop.
-Require Classical_Pred_Type.
-Require Max.
-V7only [Import R_scope.]. Open Local Scope R_scope.
-
-Implicit Arguments On.
+Require Import Rfunctions.
+Require Import SeqSeries.
+Require Import Ranalysis.
+Require Import Rbase.
+Require Import RiemannInt_SF.
+Require Import Classical_Prop.
+Require Import Classical_Pred_Type.
+Require Import Max. Open Local Scope R_scope.
+
+Set Implicit Arguments.
(********************************************)
(* Riemann's Integral *)
(********************************************)
-Definition Riemann_integrable [f:R->R;a,b:R] : Type := (eps:posreal) (SigT ? [phi:(StepFun a b)](SigT ? [psi:(StepFun a b)]((t:R)``(Rmin a b)<=t<=(Rmax a b)``->``(Rabsolu ((f t)-(phi t)))<=(psi t)``)/\``(Rabsolu (RiemannInt_SF psi))<eps``)).
-
-Definition phi_sequence [un:nat->posreal;f:R->R;a,b:R;pr:(Riemann_integrable f a b)] := [n:nat](projT1 ? ? (pr (un n))).
-
-Lemma phi_sequence_prop : (un:nat->posreal;f:R->R;a,b:R;pr:(Riemann_integrable f a b);N:nat) (SigT ? [psi:(StepFun a b)]((t:R)``(Rmin a b)<=t<=(Rmax a b)``->``(Rabsolu ((f t)-[(phi_sequence un pr N t)]))<=(psi t)``)/\``(Rabsolu (RiemannInt_SF psi))<(un N)``).
-Intros; Apply (projT2 ? ? (pr (un N))).
+Definition Riemann_integrable (f:R -> R) (a b:R) : Type :=
+ forall eps:posreal,
+ sigT
+ (fun phi:StepFun a b =>
+ sigT
+ (fun psi:StepFun a b =>
+ (forall t:R,
+ Rmin a b <= t <= Rmax a b -> Rabs (f t - phi t) <= psi t) /\
+ Rabs (RiemannInt_SF psi) < eps)).
+
+Definition phi_sequence (un:nat -> posreal) (f:R -> R)
+ (a b:R) (pr:Riemann_integrable f a b) (n:nat) :=
+ projT1 (pr (un n)).
+
+Lemma phi_sequence_prop :
+ forall (un:nat -> posreal) (f:R -> R) (a b:R) (pr:Riemann_integrable f a b)
+ (N:nat),
+ sigT
+ (fun psi:StepFun a b =>
+ (forall t:R,
+ Rmin a b <= t <= Rmax a b ->
+ Rabs (f t - phi_sequence un pr N t) <= psi t) /\
+ Rabs (RiemannInt_SF psi) < un N).
+intros; apply (projT2 (pr (un N))).
Qed.
-Lemma RiemannInt_P1 : (f:R->R;a,b:R) (Riemann_integrable f a b) -> (Riemann_integrable f b a).
-Unfold Riemann_integrable; Intros; Elim (X eps); Clear X; Intros; Elim p; Clear p; Intros; Apply Specif.existT with (mkStepFun (StepFun_P6 (pre x))); Apply Specif.existT with (mkStepFun (StepFun_P6 (pre x0))); Elim p; Clear p; Intros; Split.
-Intros; Apply (H t); Elim H1; Clear H1; Intros; Split; [Apply Rle_trans with (Rmin b a); Try Assumption; Right; Unfold Rmin | Apply Rle_trans with (Rmax b a); Try Assumption; Right; Unfold Rmax]; (Case (total_order_Rle a b); Case (total_order_Rle b a); Intros; Try Reflexivity Orelse Apply Rle_antisym; [Assumption | Assumption | Auto with real | Auto with real]).
-Generalize H0; Unfold RiemannInt_SF; Case (total_order_Rle a b); Case (total_order_Rle b a); Intros; (Replace (Int_SF (subdivision_val (mkStepFun (StepFun_P6 (pre x0)))) (subdivision (mkStepFun (StepFun_P6 (pre x0))))) with (Int_SF (subdivision_val x0) (subdivision x0)); [Idtac | Apply StepFun_P17 with (fe x0) a b; [Apply StepFun_P1 | Apply StepFun_P2; Apply (StepFun_P1 (mkStepFun (StepFun_P6 (pre x0))))]]).
-Apply H1.
-Rewrite Rabsolu_Ropp; Apply H1.
-Rewrite Rabsolu_Ropp in H1; Apply H1.
-Apply H1.
+Lemma RiemannInt_P1 :
+ forall (f:R -> R) (a b:R),
+ Riemann_integrable f a b -> Riemann_integrable f b a.
+unfold Riemann_integrable in |- *; intros; elim (X eps); clear X; intros;
+ elim p; clear p; intros; apply existT with (mkStepFun (StepFun_P6 (pre x)));
+ apply existT with (mkStepFun (StepFun_P6 (pre x0)));
+ elim p; clear p; intros; split.
+intros; apply (H t); elim H1; clear H1; intros; split;
+ [ apply Rle_trans with (Rmin b a); try assumption; right;
+ unfold Rmin in |- *
+ | apply Rle_trans with (Rmax b a); try assumption; right;
+ unfold Rmax in |- * ];
+ (case (Rle_dec a b); case (Rle_dec b a); intros;
+ try reflexivity || apply Rle_antisym;
+ [ assumption | assumption | auto with real | auto with real ]).
+generalize H0; unfold RiemannInt_SF in |- *; case (Rle_dec a b);
+ case (Rle_dec b a); intros;
+ (replace
+ (Int_SF (subdivision_val (mkStepFun (StepFun_P6 (pre x0))))
+ (subdivision (mkStepFun (StepFun_P6 (pre x0))))) with
+ (Int_SF (subdivision_val x0) (subdivision x0));
+ [ idtac
+ | apply StepFun_P17 with (fe x0) a b;
+ [ apply StepFun_P1
+ | apply StepFun_P2;
+ apply (StepFun_P1 (mkStepFun (StepFun_P6 (pre x0)))) ] ]).
+apply H1.
+rewrite Rabs_Ropp; apply H1.
+rewrite Rabs_Ropp in H1; apply H1.
+apply H1.
Qed.
-Lemma RiemannInt_P2 : (f:R->R;a,b:R;un:nat->posreal;vn,wn:nat->(StepFun a b)) (Un_cv un R0) -> ``a<=b`` -> ((n:nat)((t:R)``(Rmin a b)<=t<=(Rmax a b)``->``(Rabsolu ((f t)-(vn n t)))<=(wn n t)``)/\``(Rabsolu (RiemannInt_SF (wn n)))<(un n)``) -> (sigTT ? [l:R](Un_cv [N:nat](RiemannInt_SF (vn N)) l)).
-Intros; Apply R_complete; Unfold Un_cv in H; Unfold Cauchy_crit; Intros; Assert H3 : ``0<eps/2``.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
-Elim (H ? H3); Intros N0 H4; Exists N0; Intros; Unfold R_dist; Unfold R_dist in H4; Elim (H1 n); Elim (H1 m); Intros; Replace ``(RiemannInt_SF (vn n))-(RiemannInt_SF (vn m))`` with ``(RiemannInt_SF (vn n))+(-1)*(RiemannInt_SF (vn m))``; [Idtac | Ring]; Rewrite <- StepFun_P30; Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 ``-1`` (vn n) (vn m)))))).
-Apply StepFun_P34; Assumption.
-Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P28 R1 (wn n) (wn m)))).
-Apply StepFun_P37; Try Assumption.
-Intros; Simpl; Apply Rle_trans with ``(Rabsolu ((vn n x)-(f x)))+(Rabsolu ((f x)-(vn m x)))``.
-Replace ``(vn n x)+-1*(vn m x)`` with ``((vn n x)-(f x))+((f x)-(vn m x))``; [Apply Rabsolu_triang | Ring].
-Assert H12 : (Rmin a b)==a.
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption].
-Assert H13 : (Rmax a b)==b.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption].
-Rewrite <- H12 in H11; Pattern 2 b in H11; Rewrite <- H13 in H11; Rewrite Rmult_1l; Apply Rplus_le.
-Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H9.
-Elim H11; Intros; Split; Left; Assumption.
-Apply H7.
-Elim H11; Intros; Split; Left; Assumption.
-Rewrite StepFun_P30; Rewrite Rmult_1l; Apply Rlt_trans with ``(un n)+(un m)``.
-Apply Rle_lt_trans with ``(Rabsolu (RiemannInt_SF (wn n)))+(Rabsolu (RiemannInt_SF (wn m)))``.
-Apply Rplus_le; Apply Rle_Rabsolu.
-Apply Rplus_lt; Assumption.
-Apply Rle_lt_trans with ``(Rabsolu (un n))+(Rabsolu (un m))``.
-Apply Rplus_le; Apply Rle_Rabsolu.
-Replace (pos (un n)) with ``(un n)-0``; [Idtac | Ring]; Replace (pos (un m)) with ``(un m)-0``; [Idtac | Ring]; Rewrite (double_var eps); Apply Rplus_lt; Apply H4; Assumption.
+Lemma RiemannInt_P2 :
+ forall (f:R -> R) (a b:R) (un:nat -> posreal) (vn wn:nat -> StepFun a b),
+ Un_cv un 0 ->
+ a <= b ->
+ (forall n:nat,
+ (forall t:R, Rmin a b <= t <= Rmax a b -> Rabs (f t - vn n t) <= wn n t) /\
+ Rabs (RiemannInt_SF (wn n)) < un n) ->
+ sigT (fun l:R => Un_cv (fun N:nat => RiemannInt_SF (vn N)) l).
+intros; apply R_complete; unfold Un_cv in H; unfold Cauchy_crit in |- *;
+ intros; assert (H3 : 0 < eps / 2).
+unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
+elim (H _ H3); intros N0 H4; exists N0; intros; unfold R_dist in |- *;
+ unfold R_dist in H4; elim (H1 n); elim (H1 m); intros;
+ replace (RiemannInt_SF (vn n) - RiemannInt_SF (vn m)) with
+ (RiemannInt_SF (vn n) + -1 * RiemannInt_SF (vn m));
+ [ idtac | ring ]; rewrite <- StepFun_P30;
+ apply Rle_lt_trans with
+ (RiemannInt_SF
+ (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (vn n) (vn m)))))).
+apply StepFun_P34; assumption.
+apply Rle_lt_trans with
+ (RiemannInt_SF (mkStepFun (StepFun_P28 1 (wn n) (wn m)))).
+apply StepFun_P37; try assumption.
+intros; simpl in |- *;
+ apply Rle_trans with (Rabs (vn n x - f x) + Rabs (f x - vn m x)).
+replace (vn n x + -1 * vn m x) with (vn n x - f x + (f x - vn m x));
+ [ apply Rabs_triang | ring ].
+assert (H12 : Rmin a b = a).
+unfold Rmin in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n0; assumption ].
+assert (H13 : Rmax a b = b).
+unfold Rmax in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n0; assumption ].
+rewrite <- H12 in H11; pattern b at 2 in H11; rewrite <- H13 in H11;
+ rewrite Rmult_1_l; apply Rplus_le_compat.
+rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H9.
+elim H11; intros; split; left; assumption.
+apply H7.
+elim H11; intros; split; left; assumption.
+rewrite StepFun_P30; rewrite Rmult_1_l; apply Rlt_trans with (un n + un m).
+apply Rle_lt_trans with
+ (Rabs (RiemannInt_SF (wn n)) + Rabs (RiemannInt_SF (wn m))).
+apply Rplus_le_compat; apply RRle_abs.
+apply Rplus_lt_compat; assumption.
+apply Rle_lt_trans with (Rabs (un n) + Rabs (un m)).
+apply Rplus_le_compat; apply RRle_abs.
+replace (pos (un n)) with (un n - 0); [ idtac | ring ];
+ replace (pos (un m)) with (un m - 0); [ idtac | ring ];
+ rewrite (double_var eps); apply Rplus_lt_compat; apply H4;
+ assumption.
Qed.
-Lemma RiemannInt_P3 : (f:R->R;a,b:R;un:nat->posreal;vn,wn:nat->(StepFun a b)) (Un_cv un R0) -> ((n:nat)((t:R)``(Rmin a b)<=t<=(Rmax a b)``->``(Rabsolu ((f t)-(vn n t)))<=(wn n t)``)/\``(Rabsolu (RiemannInt_SF (wn n)))<(un n)``)->(sigTT R ([l:R](Un_cv ([N:nat](RiemannInt_SF (vn N))) l))).
-Intros; Case (total_order_Rle a b); Intro.
-Apply RiemannInt_P2 with f un wn; Assumption.
-Assert H1 : ``b<=a``; Auto with real.
-Pose vn' := [n:nat](mkStepFun (StepFun_P6 (pre (vn n)))); Pose wn' := [n:nat](mkStepFun (StepFun_P6 (pre (wn n)))); Assert H2 : (n:nat)((t:R)``(Rmin b a)<=t<=(Rmax b a)``->``(Rabsolu ((f t)-(vn' n t)))<=(wn' n t)``)/\``(Rabsolu (RiemannInt_SF (wn' n)))<(un n)``.
-Intro; Elim (H0 n0); Intros; Split.
-Intros; Apply (H2 t); Elim H4; Clear H4; Intros; Split; [Apply Rle_trans with (Rmin b a); Try Assumption; Right; Unfold Rmin | Apply Rle_trans with (Rmax b a); Try Assumption; Right; Unfold Rmax]; (Case (total_order_Rle a b); Case (total_order_Rle b a); Intros; Try Reflexivity Orelse Apply Rle_antisym; [Assumption | Assumption | Auto with real | Auto with real]).
-Generalize H3; Unfold RiemannInt_SF; Case (total_order_Rle a b); Case (total_order_Rle b a); Unfold wn'; Intros; (Replace (Int_SF (subdivision_val (mkStepFun (StepFun_P6 (pre (wn n0))))) (subdivision (mkStepFun (StepFun_P6 (pre (wn n0)))))) with (Int_SF (subdivision_val (wn n0)) (subdivision (wn n0))); [Idtac | Apply StepFun_P17 with (fe (wn n0)) a b; [Apply StepFun_P1 | Apply StepFun_P2; Apply (StepFun_P1 (mkStepFun (StepFun_P6 (pre (wn n0)))))]]).
-Apply H4.
-Rewrite Rabsolu_Ropp; Apply H4.
-Rewrite Rabsolu_Ropp in H4; Apply H4.
-Apply H4.
-Assert H3 := (RiemannInt_P2 H H1 H2); Elim H3; Intros; Apply existTT with ``-x``; Unfold Un_cv; Unfold Un_cv in p; Intros; Elim (p ? H4); Intros; Exists x0; Intros; Generalize (H5 ? H6); Unfold R_dist RiemannInt_SF; Case (total_order_Rle b a); Case (total_order_Rle a b); Intros.
-Elim n; Assumption.
-Unfold vn' in H7; Replace (Int_SF (subdivision_val (vn n0)) (subdivision (vn n0))) with (Int_SF (subdivision_val (mkStepFun (StepFun_P6 (pre (vn n0))))) (subdivision (mkStepFun (StepFun_P6 (pre (vn n0)))))); [Unfold Rminus; Rewrite Ropp_Ropp; Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr1; Rewrite Ropp_Ropp; Apply H7 | Symmetry; Apply StepFun_P17 with (fe (vn n0)) a b; [Apply StepFun_P1 | Apply StepFun_P2; Apply (StepFun_P1 (mkStepFun (StepFun_P6 (pre (vn n0)))))]].
-Elim n1; Assumption.
-Elim n2; Assumption.
+Lemma RiemannInt_P3 :
+ forall (f:R -> R) (a b:R) (un:nat -> posreal) (vn wn:nat -> StepFun a b),
+ Un_cv un 0 ->
+ (forall n:nat,
+ (forall t:R, Rmin a b <= t <= Rmax a b -> Rabs (f t - vn n t) <= wn n t) /\
+ Rabs (RiemannInt_SF (wn n)) < un n) ->
+ sigT (fun l:R => Un_cv (fun N:nat => RiemannInt_SF (vn N)) l).
+intros; case (Rle_dec a b); intro.
+apply RiemannInt_P2 with f un wn; assumption.
+assert (H1 : b <= a); auto with real.
+pose (vn' := fun n:nat => mkStepFun (StepFun_P6 (pre (vn n))));
+ pose (wn' := fun n:nat => mkStepFun (StepFun_P6 (pre (wn n))));
+ assert
+ (H2 :
+ forall n:nat,
+ (forall t:R,
+ Rmin b a <= t <= Rmax b a -> Rabs (f t - vn' n t) <= wn' n t) /\
+ Rabs (RiemannInt_SF (wn' n)) < un n).
+intro; elim (H0 n0); intros; split.
+intros; apply (H2 t); elim H4; clear H4; intros; split;
+ [ apply Rle_trans with (Rmin b a); try assumption; right;
+ unfold Rmin in |- *
+ | apply Rle_trans with (Rmax b a); try assumption; right;
+ unfold Rmax in |- * ];
+ (case (Rle_dec a b); case (Rle_dec b a); intros;
+ try reflexivity || apply Rle_antisym;
+ [ assumption | assumption | auto with real | auto with real ]).
+generalize H3; unfold RiemannInt_SF in |- *; case (Rle_dec a b);
+ case (Rle_dec b a); unfold wn' in |- *; intros;
+ (replace
+ (Int_SF (subdivision_val (mkStepFun (StepFun_P6 (pre (wn n0)))))
+ (subdivision (mkStepFun (StepFun_P6 (pre (wn n0)))))) with
+ (Int_SF (subdivision_val (wn n0)) (subdivision (wn n0)));
+ [ idtac
+ | apply StepFun_P17 with (fe (wn n0)) a b;
+ [ apply StepFun_P1
+ | apply StepFun_P2;
+ apply (StepFun_P1 (mkStepFun (StepFun_P6 (pre (wn n0))))) ] ]).
+apply H4.
+rewrite Rabs_Ropp; apply H4.
+rewrite Rabs_Ropp in H4; apply H4.
+apply H4.
+assert (H3 := RiemannInt_P2 _ _ _ _ H H1 H2); elim H3; intros;
+ apply existT with (- x); unfold Un_cv in |- *; unfold Un_cv in p;
+ intros; elim (p _ H4); intros; exists x0; intros;
+ generalize (H5 _ H6); unfold R_dist, RiemannInt_SF in |- *;
+ case (Rle_dec b a); case (Rle_dec a b); intros.
+elim n; assumption.
+unfold vn' in H7;
+ replace (Int_SF (subdivision_val (vn n0)) (subdivision (vn n0))) with
+ (Int_SF (subdivision_val (mkStepFun (StepFun_P6 (pre (vn n0)))))
+ (subdivision (mkStepFun (StepFun_P6 (pre (vn n0))))));
+ [ unfold Rminus in |- *; rewrite Ropp_involutive; rewrite <- Rabs_Ropp;
+ rewrite Ropp_plus_distr; rewrite Ropp_involutive;
+ apply H7
+ | symmetry in |- *; apply StepFun_P17 with (fe (vn n0)) a b;
+ [ apply StepFun_P1
+ | apply StepFun_P2;
+ apply (StepFun_P1 (mkStepFun (StepFun_P6 (pre (vn n0))))) ] ].
+elim n1; assumption.
+elim n2; assumption.
Qed.
-Lemma RiemannInt_exists : (f:R->R;a,b:R;pr:(Riemann_integrable f a b);un:nat->posreal) (Un_cv un R0) -> (sigTT ? [l:R](Un_cv [N:nat](RiemannInt_SF (phi_sequence un pr N)) l)).
-Intros f; Intros; Apply RiemannInt_P3 with f un [n:nat](projT1 ? ? (phi_sequence_prop un pr n)); [Apply H | Intro; Apply (projT2 ? ? (phi_sequence_prop un pr n))].
+Lemma RiemannInt_exists :
+ forall (f:R -> R) (a b:R) (pr:Riemann_integrable f a b)
+ (un:nat -> posreal),
+ Un_cv un 0 ->
+ sigT
+ (fun l:R => Un_cv (fun N:nat => RiemannInt_SF (phi_sequence un pr N)) l).
+intros f; intros;
+ apply RiemannInt_P3 with
+ f un (fun n:nat => projT1 (phi_sequence_prop un pr n));
+ [ apply H | intro; apply (projT2 (phi_sequence_prop un pr n)) ].
Qed.
-Lemma RiemannInt_P4 : (f:R->R;a,b,l:R;pr1,pr2:(Riemann_integrable f a b);un,vn:nat->posreal) (Un_cv un R0) -> (Un_cv vn R0) -> (Un_cv [N:nat](RiemannInt_SF (phi_sequence un pr1 N)) l) -> (Un_cv [N:nat](RiemannInt_SF (phi_sequence vn pr2 N)) l).
-Unfold Un_cv; Unfold R_dist; Intros f; Intros; Assert H3 : ``0<eps/3``.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
-Elim (H ? H3); Clear H; Intros N0 H; Elim (H0 ? H3); Clear H0; Intros N1 H0; Elim (H1 ? H3); Clear H1; Intros N2 H1; Pose N := (max (max N0 N1) N2); Exists N; Intros; Apply Rle_lt_trans with ``(Rabsolu ((RiemannInt_SF [(phi_sequence vn pr2 n)])-(RiemannInt_SF [(phi_sequence un pr1 n)])))+(Rabsolu ((RiemannInt_SF [(phi_sequence un pr1 n)])-l))``.
-Replace ``(RiemannInt_SF [(phi_sequence vn pr2 n)])-l`` with ``((RiemannInt_SF [(phi_sequence vn pr2 n)])-(RiemannInt_SF [(phi_sequence un pr1 n)]))+((RiemannInt_SF [(phi_sequence un pr1 n)])-l)``; [Apply Rabsolu_triang | Ring].
-Replace ``eps`` with ``2*eps/3+eps/3``.
-Apply Rplus_lt.
-Elim (phi_sequence_prop vn pr2 n); Intros psi_vn H5; Elim (phi_sequence_prop un pr1 n); Intros psi_un H6; Replace ``(RiemannInt_SF [(phi_sequence vn pr2 n)])-(RiemannInt_SF [(phi_sequence un pr1 n)])`` with ``(RiemannInt_SF [(phi_sequence vn pr2 n)])+(-1)*(RiemannInt_SF [(phi_sequence un pr1 n)])``; [Idtac | Ring]; Rewrite <- StepFun_P30.
-Case (total_order_Rle a b); Intro.
-Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 ``-1`` (phi_sequence vn pr2 n) (phi_sequence un pr1 n)))))).
-Apply StepFun_P34; Assumption.
-Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P28 R1 psi_un psi_vn))).
-Apply StepFun_P37; Try Assumption; Intros; Simpl; Rewrite Rmult_1l; Apply Rle_trans with ``(Rabsolu ([(phi_sequence vn pr2 n x)]-(f x)))+(Rabsolu ((f x)-[(phi_sequence un pr1 n x)]))``.
-Replace ``[(phi_sequence vn pr2 n x)]+-1*[(phi_sequence un pr1 n x)]`` with ``([(phi_sequence vn pr2 n x)]-(f x))+((f x)-[(phi_sequence un pr1 n x)])``; [Apply Rabsolu_triang | Ring].
-Assert H10 : (Rmin a b)==a.
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption].
-Assert H11 : (Rmax a b)==b.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption].
-Rewrite (Rplus_sym (psi_un x)); Apply Rplus_le.
-Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Elim H5; Intros; Apply H8.
-Rewrite H10; Rewrite H11; Elim H7; Intros; Split; Left; Assumption.
-Elim H6; Intros; Apply H8.
-Rewrite H10; Rewrite H11; Elim H7; Intros; Split; Left; Assumption.
-Rewrite StepFun_P30; Rewrite Rmult_1l; Rewrite double; Apply Rplus_lt.
-Apply Rlt_trans with (pos (un n)).
-Elim H6; Intros; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF psi_un)).
-Apply Rle_Rabsolu.
-Assumption.
-Replace (pos (un n)) with (Rabsolu ``(un n)-0``); [Apply H; Unfold ge; Apply le_trans with N; Try Assumption; Unfold N; Apply le_trans with (max N0 N1); Apply le_max_l | Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right; Apply Rle_sym1; Left; Apply (cond_pos (un n))].
-Apply Rlt_trans with (pos (vn n)).
-Elim H5; Intros; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF psi_vn)).
-Apply Rle_Rabsolu; Assumption.
-Assumption.
-Replace (pos (vn n)) with (Rabsolu ``(vn n)-0``); [Apply H0; Unfold ge; Apply le_trans with N; Try Assumption; Unfold N; Apply le_trans with (max N0 N1); [Apply le_max_r | Apply le_max_l] | Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right; Apply Rle_sym1; Left; Apply (cond_pos (vn n))].
-Rewrite StepFun_P39; Rewrite Rabsolu_Ropp; Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P6 (pre (mkStepFun (StepFun_P28 ``-1`` (phi_sequence vn pr2 n) (phi_sequence un pr1 n))))))))).
-Apply StepFun_P34; Try Auto with real.
-Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P6 (pre (mkStepFun (StepFun_P28 R1 psi_vn psi_un)))))).
-Apply StepFun_P37.
-Auto with real.
-Intros; Simpl; Rewrite Rmult_1l; Apply Rle_trans with ``(Rabsolu ([(phi_sequence vn pr2 n x)]-(f x)))+(Rabsolu ((f x)-[(phi_sequence un pr1 n x)]))``.
-Replace ``[(phi_sequence vn pr2 n x)]+-1*[(phi_sequence un pr1 n x)]`` with ``([(phi_sequence vn pr2 n x)]-(f x))+((f x)-[(phi_sequence un pr1 n x)])``; [Apply Rabsolu_triang | Ring].
-Assert H10 : (Rmin a b)==b.
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Elim n0; Assumption | Reflexivity].
-Assert H11 : (Rmax a b)==a.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Elim n0; Assumption | Reflexivity].
-Apply Rplus_le.
-Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Elim H5; Intros; Apply H8.
-Rewrite H10; Rewrite H11; Elim H7; Intros; Split; Left; Assumption.
-Elim H6; Intros; Apply H8.
-Rewrite H10; Rewrite H11; Elim H7; Intros; Split; Left; Assumption.
-Rewrite <- (Ropp_Ropp (RiemannInt_SF (mkStepFun (StepFun_P6 (pre (mkStepFun (StepFun_P28 R1 psi_vn psi_un))))))); Rewrite <- StepFun_P39; Rewrite StepFun_P30; Rewrite Rmult_1l; Rewrite double; Rewrite Ropp_distr1; Apply Rplus_lt.
-Apply Rlt_trans with (pos (vn n)).
-Elim H5; Intros; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF psi_vn)).
-Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu.
-Assumption.
-Replace (pos (vn n)) with (Rabsolu ``(vn n)-0``); [Apply H0; Unfold ge; Apply le_trans with N; Try Assumption; Unfold N; Apply le_trans with (max N0 N1); [Apply le_max_r | Apply le_max_l] | Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right; Apply Rle_sym1; Left; Apply (cond_pos (vn n))].
-Apply Rlt_trans with (pos (un n)).
-Elim H6; Intros; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF psi_un)).
-Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu; Assumption.
-Assumption.
-Replace (pos (un n)) with (Rabsolu ``(un n)-0``); [Apply H; Unfold ge; Apply le_trans with N; Try Assumption; Unfold N; Apply le_trans with (max N0 N1); Apply le_max_l | Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right; Apply Rle_sym1; Left; Apply (cond_pos (un n))].
-Apply H1; Unfold ge; Apply le_trans with N; Try Assumption; Unfold N; Apply le_max_r.
-Apply r_Rmult_mult with ``3``; [Unfold Rdiv; Rewrite Rmult_Rplus_distr; Do 2 Rewrite (Rmult_sym ``3``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Ring | DiscrR] | DiscrR].
+Lemma RiemannInt_P4 :
+ forall (f:R -> R) (a b l:R) (pr1 pr2:Riemann_integrable f a b)
+ (un vn:nat -> posreal),
+ Un_cv un 0 ->
+ Un_cv vn 0 ->
+ Un_cv (fun N:nat => RiemannInt_SF (phi_sequence un pr1 N)) l ->
+ Un_cv (fun N:nat => RiemannInt_SF (phi_sequence vn pr2 N)) l.
+unfold Un_cv in |- *; unfold R_dist in |- *; intros f; intros;
+ assert (H3 : 0 < eps / 3).
+unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
+elim (H _ H3); clear H; intros N0 H; elim (H0 _ H3); clear H0; intros N1 H0;
+ elim (H1 _ H3); clear H1; intros N2 H1; pose (N := max (max N0 N1) N2);
+ exists N; intros;
+ apply Rle_lt_trans with
+ (Rabs
+ (RiemannInt_SF (phi_sequence vn pr2 n) -
+ RiemannInt_SF (phi_sequence un pr1 n)) +
+ Rabs (RiemannInt_SF (phi_sequence un pr1 n) - l)).
+replace (RiemannInt_SF (phi_sequence vn pr2 n) - l) with
+ (RiemannInt_SF (phi_sequence vn pr2 n) -
+ RiemannInt_SF (phi_sequence un pr1 n) +
+ (RiemannInt_SF (phi_sequence un pr1 n) - l)); [ apply Rabs_triang | ring ].
+replace eps with (2 * (eps / 3) + eps / 3).
+apply Rplus_lt_compat.
+elim (phi_sequence_prop vn pr2 n); intros psi_vn H5;
+ elim (phi_sequence_prop un pr1 n); intros psi_un H6;
+ replace
+ (RiemannInt_SF (phi_sequence vn pr2 n) -
+ RiemannInt_SF (phi_sequence un pr1 n)) with
+ (RiemannInt_SF (phi_sequence vn pr2 n) +
+ -1 * RiemannInt_SF (phi_sequence un pr1 n)); [ idtac | ring ];
+ rewrite <- StepFun_P30.
+case (Rle_dec a b); intro.
+apply Rle_lt_trans with
+ (RiemannInt_SF
+ (mkStepFun
+ (StepFun_P32
+ (mkStepFun
+ (StepFun_P28 (-1) (phi_sequence vn pr2 n)
+ (phi_sequence un pr1 n)))))).
+apply StepFun_P34; assumption.
+apply Rle_lt_trans with
+ (RiemannInt_SF (mkStepFun (StepFun_P28 1 psi_un psi_vn))).
+apply StepFun_P37; try assumption; intros; simpl in |- *; rewrite Rmult_1_l;
+ apply Rle_trans with
+ (Rabs (phi_sequence vn pr2 n x - f x) +
+ Rabs (f x - phi_sequence un pr1 n x)).
+replace (phi_sequence vn pr2 n x + -1 * phi_sequence un pr1 n x) with
+ (phi_sequence vn pr2 n x - f x + (f x - phi_sequence un pr1 n x));
+ [ apply Rabs_triang | ring ].
+assert (H10 : Rmin a b = a).
+unfold Rmin in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n0; assumption ].
+assert (H11 : Rmax a b = b).
+unfold Rmax in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n0; assumption ].
+rewrite (Rplus_comm (psi_un x)); apply Rplus_le_compat.
+rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; elim H5; intros; apply H8.
+rewrite H10; rewrite H11; elim H7; intros; split; left; assumption.
+elim H6; intros; apply H8.
+rewrite H10; rewrite H11; elim H7; intros; split; left; assumption.
+rewrite StepFun_P30; rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat.
+apply Rlt_trans with (pos (un n)).
+elim H6; intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF psi_un)).
+apply RRle_abs.
+assumption.
+replace (pos (un n)) with (Rabs (un n - 0));
+ [ apply H; unfold ge in |- *; apply le_trans with N; try assumption;
+ unfold N in |- *; apply le_trans with (max N0 N1);
+ apply le_max_l
+ | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right;
+ apply Rle_ge; left; apply (cond_pos (un n)) ].
+apply Rlt_trans with (pos (vn n)).
+elim H5; intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF psi_vn)).
+apply RRle_abs; assumption.
+assumption.
+replace (pos (vn n)) with (Rabs (vn n - 0));
+ [ apply H0; unfold ge in |- *; apply le_trans with N; try assumption;
+ unfold N in |- *; apply le_trans with (max N0 N1);
+ [ apply le_max_r | apply le_max_l ]
+ | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right;
+ apply Rle_ge; left; apply (cond_pos (vn n)) ].
+rewrite StepFun_P39; rewrite Rabs_Ropp;
+ apply Rle_lt_trans with
+ (RiemannInt_SF
+ (mkStepFun
+ (StepFun_P32
+ (mkStepFun
+ (StepFun_P6
+ (pre
+ (mkStepFun
+ (StepFun_P28 (-1) (phi_sequence vn pr2 n)
+ (phi_sequence un pr1 n))))))))).
+apply StepFun_P34; try auto with real.
+apply Rle_lt_trans with
+ (RiemannInt_SF
+ (mkStepFun (StepFun_P6 (pre (mkStepFun (StepFun_P28 1 psi_vn psi_un)))))).
+apply StepFun_P37.
+auto with real.
+intros; simpl in |- *; rewrite Rmult_1_l;
+ apply Rle_trans with
+ (Rabs (phi_sequence vn pr2 n x - f x) +
+ Rabs (f x - phi_sequence un pr1 n x)).
+replace (phi_sequence vn pr2 n x + -1 * phi_sequence un pr1 n x) with
+ (phi_sequence vn pr2 n x - f x + (f x - phi_sequence un pr1 n x));
+ [ apply Rabs_triang | ring ].
+assert (H10 : Rmin a b = b).
+unfold Rmin in |- *; case (Rle_dec a b); intro;
+ [ elim n0; assumption | reflexivity ].
+assert (H11 : Rmax a b = a).
+unfold Rmax in |- *; case (Rle_dec a b); intro;
+ [ elim n0; assumption | reflexivity ].
+apply Rplus_le_compat.
+rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; elim H5; intros; apply H8.
+rewrite H10; rewrite H11; elim H7; intros; split; left; assumption.
+elim H6; intros; apply H8.
+rewrite H10; rewrite H11; elim H7; intros; split; left; assumption.
+rewrite <-
+ (Ropp_involutive
+ (RiemannInt_SF
+ (mkStepFun
+ (StepFun_P6 (pre (mkStepFun (StepFun_P28 1 psi_vn psi_un)))))))
+ ; rewrite <- StepFun_P39; rewrite StepFun_P30; rewrite Rmult_1_l;
+ rewrite double; rewrite Ropp_plus_distr; apply Rplus_lt_compat.
+apply Rlt_trans with (pos (vn n)).
+elim H5; intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF psi_vn)).
+rewrite <- Rabs_Ropp; apply RRle_abs.
+assumption.
+replace (pos (vn n)) with (Rabs (vn n - 0));
+ [ apply H0; unfold ge in |- *; apply le_trans with N; try assumption;
+ unfold N in |- *; apply le_trans with (max N0 N1);
+ [ apply le_max_r | apply le_max_l ]
+ | unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0;
+ rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge;
+ left; apply (cond_pos (vn n)) ].
+apply Rlt_trans with (pos (un n)).
+elim H6; intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF psi_un)).
+rewrite <- Rabs_Ropp; apply RRle_abs; assumption.
+assumption.
+replace (pos (un n)) with (Rabs (un n - 0));
+ [ apply H; unfold ge in |- *; apply le_trans with N; try assumption;
+ unfold N in |- *; apply le_trans with (max N0 N1);
+ apply le_max_l
+ | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right;
+ apply Rle_ge; left; apply (cond_pos (un n)) ].
+apply H1; unfold ge in |- *; apply le_trans with N; try assumption;
+ unfold N in |- *; apply le_max_r.
+apply Rmult_eq_reg_l with 3;
+ [ unfold Rdiv in |- *; rewrite Rmult_plus_distr_l;
+ do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc;
+ rewrite <- Rinv_l_sym; [ ring | discrR ]
+ | discrR ].
Qed.
-Lemma RinvN_pos : (n:nat) ``0</((INR n)+1)``.
-Intro; Apply Rlt_Rinv; Apply ge0_plus_gt0_is_gt0; [Apply pos_INR | Apply Rlt_R0_R1].
+Lemma RinvN_pos : forall n:nat, 0 < / (INR n + 1).
+intro; apply Rinv_0_lt_compat; apply Rplus_le_lt_0_compat;
+ [ apply pos_INR | apply Rlt_0_1 ].
Qed.
-Definition RinvN : nat->posreal := [N:nat](mkposreal ? (RinvN_pos N)).
+Definition RinvN (N:nat) : posreal := mkposreal _ (RinvN_pos N).
-Lemma RinvN_cv : (Un_cv RinvN R0).
-Unfold Un_cv; Intros; Assert H0 := (archimed ``/eps``); Elim H0; Clear H0; Intros; Assert H2 : `0<=(up (Rinv eps))`.
-Apply le_IZR; Left; Apply Rlt_trans with ``/eps``; [Apply Rlt_Rinv; Assumption | Assumption].
-Elim (IZN ? H2); Intros; Exists x; Intros; Unfold R_dist; Simpl; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Assert H5 : ``0<(INR n)+1``.
-Apply ge0_plus_gt0_is_gt0; [Apply pos_INR | Apply Rlt_R0_R1].
-Rewrite Rabsolu_right; [Idtac | Left; Change ``0</((INR n)+1)``; Apply Rlt_Rinv; Assumption]; Apply Rle_lt_trans with ``/((INR x)+1)``.
-Apply Rle_Rinv.
-Apply ge0_plus_gt0_is_gt0; [Apply pos_INR | Apply Rlt_R0_R1].
-Assumption.
-Do 2 Rewrite <- (Rplus_sym R1); Apply Rle_compatibility; Apply le_INR; Apply H4.
-Rewrite <- (Rinv_Rinv eps).
-Apply Rinv_lt.
-Apply Rmult_lt_pos.
-Apply Rlt_Rinv; Assumption.
-Apply ge0_plus_gt0_is_gt0; [Apply pos_INR | Apply Rlt_R0_R1].
-Apply Rlt_trans with (INR x); [Rewrite INR_IZR_INZ; Rewrite <- H3; Apply H0 | Pattern 1 (INR x); Rewrite <- Rplus_Or; Apply Rlt_compatibility; Apply Rlt_R0_R1].
-Red; Intro; Rewrite H6 in H; Elim (Rlt_antirefl ? H).
+Lemma RinvN_cv : Un_cv RinvN 0.
+unfold Un_cv in |- *; intros; assert (H0 := archimed (/ eps)); elim H0;
+ clear H0; intros; assert (H2 : (0 <= up (/ eps))%Z).
+apply le_IZR; left; apply Rlt_trans with (/ eps);
+ [ apply Rinv_0_lt_compat; assumption | assumption ].
+elim (IZN _ H2); intros; exists x; intros; unfold R_dist in |- *;
+ simpl in |- *; unfold Rminus in |- *; rewrite Ropp_0;
+ rewrite Rplus_0_r; assert (H5 : 0 < INR n + 1).
+apply Rplus_le_lt_0_compat; [ apply pos_INR | apply Rlt_0_1 ].
+rewrite Rabs_right;
+ [ idtac
+ | left; change (0 < / (INR n + 1)) in |- *; apply Rinv_0_lt_compat;
+ assumption ]; apply Rle_lt_trans with (/ (INR x + 1)).
+apply Rle_Rinv.
+apply Rplus_le_lt_0_compat; [ apply pos_INR | apply Rlt_0_1 ].
+assumption.
+do 2 rewrite <- (Rplus_comm 1); apply Rplus_le_compat_l; apply le_INR;
+ apply H4.
+rewrite <- (Rinv_involutive eps).
+apply Rinv_lt_contravar.
+apply Rmult_lt_0_compat.
+apply Rinv_0_lt_compat; assumption.
+apply Rplus_le_lt_0_compat; [ apply pos_INR | apply Rlt_0_1 ].
+apply Rlt_trans with (INR x);
+ [ rewrite INR_IZR_INZ; rewrite <- H3; apply H0
+ | pattern (INR x) at 1 in |- *; rewrite <- Rplus_0_r;
+ apply Rplus_lt_compat_l; apply Rlt_0_1 ].
+red in |- *; intro; rewrite H6 in H; elim (Rlt_irrefl _ H).
Qed.
(**********)
-Definition RiemannInt [f:R->R;a,b:R;pr:(Riemann_integrable f a b)] : R := Cases
-(RiemannInt_exists pr 5!RinvN RinvN_cv) of (existTT a' b') => a' end.
-
-Lemma RiemannInt_P5 : (f:R->R;a,b:R;pr1:(Riemann_integrable f a b);pr2:(Riemann_integrable f a b)) (RiemannInt pr1)==(RiemannInt pr2).
-Intros; Unfold RiemannInt; Case (RiemannInt_exists pr1 5!RinvN RinvN_cv); Case (RiemannInt_exists pr2 5!RinvN RinvN_cv); Intros; EApply UL_sequence; [Apply u0 | Apply RiemannInt_P4 with pr2 RinvN; Apply RinvN_cv Orelse Assumption].
+Definition RiemannInt (f:R -> R) (a b:R) (pr:Riemann_integrable f a b) : R :=
+ match RiemannInt_exists pr RinvN RinvN_cv with
+ | existT a' b' => a'
+ end.
+
+Lemma RiemannInt_P5 :
+ forall (f:R -> R) (a b:R) (pr1 pr2:Riemann_integrable f a b),
+ RiemannInt pr1 = RiemannInt pr2.
+intros; unfold RiemannInt in |- *;
+ case (RiemannInt_exists pr1 RinvN RinvN_cv);
+ case (RiemannInt_exists pr2 RinvN RinvN_cv); intros;
+ eapply UL_sequence;
+ [ apply u0
+ | apply RiemannInt_P4 with pr2 RinvN; apply RinvN_cv || assumption ].
Qed.
(**************************************)
(* C°([a,b]) is included in L1([a,b]) *)
(**************************************)
-Lemma maxN : (a,b:R;del:posreal) ``a<b`` -> (sigTT ? [n:nat]``a+(INR n)*del<b``/\``b<=a+(INR (S n))*del``).
-Intros; Pose I := [n:nat]``a+(INR n)*del < b``; Assert H0 : (EX n:nat | (I n)).
-Exists O; Unfold I; Rewrite Rmult_Ol; Rewrite Rplus_Or; Assumption.
-Cut (Nbound I).
-Intro; Assert H2 := (Nzorn H0 H1); Elim H2; Intros; Exists x; Elim p; Intros; Split.
-Apply H3.
-Case (total_order_T ``a+(INR (S x))*del`` b); Intro.
-Elim s; Intro.
-Assert H5 := (H4 (S x) a0); Elim (le_Sn_n ? H5).
-Right; Symmetry; Assumption.
-Left; Apply r.
-Assert H1 : ``0<=(b-a)/del``.
-Unfold Rdiv; Apply Rmult_le_pos; [Apply Rle_sym2; Apply Rge_minus; Apply Rle_sym1; Left; Apply H | Left; Apply Rlt_Rinv; Apply (cond_pos del)].
-Elim (archimed ``(b-a)/del``); Intros; Assert H4 : `0<=(up (Rdiv (Rminus b a) del))`.
-Apply le_IZR; Simpl; Left; Apply Rle_lt_trans with ``(b-a)/del``; Assumption.
-Assert H5 := (IZN ? H4); Elim H5; Clear H5; Intros N H5; Unfold Nbound; Exists N; Intros; Unfold I in H6; Apply INR_le; Rewrite H5 in H2; Rewrite <- INR_IZR_INZ in H2; Left; Apply Rle_lt_trans with ``(b-a)/del``; Try Assumption; Apply Rle_monotony_contra with (pos del); [Apply (cond_pos del) | Unfold Rdiv; Rewrite <- (Rmult_sym ``/del``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite Rmult_sym; Apply Rle_anti_compatibility with a; Replace ``a+(b-a)`` with b; [Left; Assumption | Ring] | Assert H7 := (cond_pos del); Red; Intro; Rewrite H8 in H7; Elim (Rlt_antirefl ? H7)]].
+Lemma maxN :
+ forall (a b:R) (del:posreal),
+ a < b ->
+ sigT (fun n:nat => a + INR n * del < b /\ b <= a + INR (S n) * del).
+intros; pose (I := fun n:nat => a + INR n * del < b);
+ assert (H0 : exists n : nat | I n).
+exists 0%nat; unfold I in |- *; rewrite Rmult_0_l; rewrite Rplus_0_r;
+ assumption.
+cut (Nbound I).
+intro; assert (H2 := Nzorn H0 H1); elim H2; intros; exists x; elim p; intros;
+ split.
+apply H3.
+case (total_order_T (a + INR (S x) * del) b); intro.
+elim s; intro.
+assert (H5 := H4 (S x) a0); elim (le_Sn_n _ H5).
+right; symmetry in |- *; assumption.
+left; apply r.
+assert (H1 : 0 <= (b - a) / del).
+unfold Rdiv in |- *; apply Rmult_le_pos;
+ [ apply Rge_le; apply Rge_minus; apply Rle_ge; left; apply H
+ | left; apply Rinv_0_lt_compat; apply (cond_pos del) ].
+elim (archimed ((b - a) / del)); intros;
+ assert (H4 : (0 <= up ((b - a) / del))%Z).
+apply le_IZR; simpl in |- *; left; apply Rle_lt_trans with ((b - a) / del);
+ assumption.
+assert (H5 := IZN _ H4); elim H5; clear H5; intros N H5;
+ unfold Nbound in |- *; exists N; intros; unfold I in H6;
+ apply INR_le; rewrite H5 in H2; rewrite <- INR_IZR_INZ in H2;
+ left; apply Rle_lt_trans with ((b - a) / del); try assumption;
+ apply Rmult_le_reg_l with (pos del);
+ [ apply (cond_pos del)
+ | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ del));
+ rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym;
+ [ rewrite Rmult_1_l; rewrite Rmult_comm; apply Rplus_le_reg_l with a;
+ replace (a + (b - a)) with b; [ left; assumption | ring ]
+ | assert (H7 := cond_pos del); red in |- *; intro; rewrite H8 in H7;
+ elim (Rlt_irrefl _ H7) ] ].
Qed.
-Fixpoint SubEquiN [N:nat] : R->R->posreal->Rlist :=
-[x:R][y:R][del:posreal] Cases N of
-| O => (cons y nil)
-| (S p) => (cons x (SubEquiN p ``x+del`` y del))
-end.
-
-Definition max_N [a,b:R;del:posreal;h:``a<b``] : nat := Cases (maxN del h) of (existTT N H0) => N end.
-
-Definition SubEqui [a,b:R;del:posreal;h:``a<b``] :Rlist := (SubEquiN (S (max_N del h)) a b del).
-
-Lemma Heine_cor1 : (f:R->R;a,b:R) ``a<b`` -> ((x:R)``a<=x<=b``->(continuity_pt f x)) -> (eps:posreal) (sigTT ? [delta:posreal]``delta<=b-a``/\(x,y:R)``a<=x<=b``->``a<=y<=b``->``(Rabsolu (x-y)) < delta``->``(Rabsolu ((f x)-(f y))) < eps``).
-Intro f; Intros; Pose E := [l:R]``0<l<=b-a``/\(x,y:R)``a <= x <= b``->``a <= y <= b``->``(Rabsolu (x-y)) < l``->``(Rabsolu ((f x)-(f y))) < eps``; Assert H1 : (bound E).
-Unfold bound; Exists ``b-a``; Unfold is_upper_bound; Intros; Unfold E in H1; Elim H1; Clear H1; Intros H1 _; Elim H1; Intros; Assumption.
-Assert H2 : (EXT x:R | (E x)).
-Assert H2 := (Heine f [x:R]``a<=x<=b`` (compact_P3 a b) H0 eps); Elim H2; Intros; Exists (Rmin x ``b-a``); Unfold E; Split; [Split; [Unfold Rmin; Case (total_order_Rle x ``b-a``); Intro; [Apply (cond_pos x) | Apply Rlt_Rminus; Assumption] | Apply Rmin_r] | Intros; Apply H3; Try Assumption; Apply Rlt_le_trans with (Rmin x ``b-a``); [Assumption | Apply Rmin_l]].
-Assert H3 := (complet E H1 H2); Elim H3; Intros; Cut ``0<x<=b-a``.
-Intro; Elim H4; Clear H4; Intros; Apply existTT with (mkposreal ? H4); Split.
-Apply H5.
-Unfold is_lub in p; Elim p; Intros; Unfold is_upper_bound in H6; Pose D := ``(Rabsolu (x0-y))``; Elim (classic (EXT y:R | ``D<y``/\(E y))); Intro.
-Elim H11; Intros; Elim H12; Clear H12; Intros; Unfold E in H13; Elim H13; Intros; Apply H15; Assumption.
-Assert H12 := (not_ex_all_not ? [y:R]``D < y``/\(E y) H11); Assert H13 : (is_upper_bound E D).
-Unfold is_upper_bound; Intros; Assert H14 := (H12 x1); Elim (not_and_or ``D<x1`` (E x1) H14); Intro.
-Case (total_order_Rle x1 D); Intro.
-Assumption.
-Elim H15; Auto with real.
-Elim H15; Assumption.
-Assert H14 := (H7 ? H13); Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H14 H10)).
-Unfold is_lub in p; Unfold is_upper_bound in p; Elim p; Clear p; Intros; Split.
-Elim H2; Intros; Assert H7 := (H4 ? H6); Unfold E in H6; Elim H6; Clear H6; Intros H6 _; Elim H6; Intros; Apply Rlt_le_trans with x0; Assumption.
-Apply H5; Intros; Unfold E in H6; Elim H6; Clear H6; Intros H6 _; Elim H6; Intros; Assumption.
+Fixpoint SubEquiN (N:nat) (x y:R) (del:posreal) {struct N} : Rlist :=
+ match N with
+ | O => cons y nil
+ | S p => cons x (SubEquiN p (x + del) y del)
+ end.
+
+Definition max_N (a b:R) (del:posreal) (h:a < b) : nat :=
+ match maxN del h with
+ | existT N H0 => N
+ end.
+
+Definition SubEqui (a b:R) (del:posreal) (h:a < b) : Rlist :=
+ SubEquiN (S (max_N del h)) a b del.
+
+Lemma Heine_cor1 :
+ forall (f:R -> R) (a b:R),
+ a < b ->
+ (forall x:R, a <= x <= b -> continuity_pt f x) ->
+ forall eps:posreal,
+ sigT
+ (fun delta:posreal =>
+ delta <= b - a /\
+ (forall x y:R,
+ a <= x <= b ->
+ a <= y <= b -> Rabs (x - y) < delta -> Rabs (f x - f y) < eps)).
+intro f; intros;
+ pose
+ (E :=
+ fun l:R =>
+ 0 < l <= b - a /\
+ (forall x y:R,
+ a <= x <= b ->
+ a <= y <= b -> Rabs (x - y) < l -> Rabs (f x - f y) < eps));
+ assert (H1 : bound E).
+unfold bound in |- *; exists (b - a); unfold is_upper_bound in |- *; intros;
+ unfold E in H1; elim H1; clear H1; intros H1 _; elim H1;
+ intros; assumption.
+assert (H2 : exists x : R | E x).
+assert (H2 := Heine f (fun x:R => a <= x <= b) (compact_P3 a b) H0 eps);
+ elim H2; intros; exists (Rmin x (b - a)); unfold E in |- *;
+ split;
+ [ split;
+ [ unfold Rmin in |- *; case (Rle_dec x (b - a)); intro;
+ [ apply (cond_pos x) | apply Rlt_Rminus; assumption ]
+ | apply Rmin_r ]
+ | intros; apply H3; try assumption; apply Rlt_le_trans with (Rmin x (b - a));
+ [ assumption | apply Rmin_l ] ].
+assert (H3 := completeness E H1 H2); elim H3; intros; cut (0 < x <= b - a).
+intro; elim H4; clear H4; intros; apply existT with (mkposreal _ H4); split.
+apply H5.
+unfold is_lub in p; elim p; intros; unfold is_upper_bound in H6;
+ pose (D := Rabs (x0 - y)); elim (classic ( exists y : R | D < y /\ E y));
+ intro.
+elim H11; intros; elim H12; clear H12; intros; unfold E in H13; elim H13;
+ intros; apply H15; assumption.
+assert (H12 := not_ex_all_not _ (fun y:R => D < y /\ E y) H11);
+ assert (H13 : is_upper_bound E D).
+unfold is_upper_bound in |- *; intros; assert (H14 := H12 x1);
+ elim (not_and_or (D < x1) (E x1) H14); intro.
+case (Rle_dec x1 D); intro.
+assumption.
+elim H15; auto with real.
+elim H15; assumption.
+assert (H14 := H7 _ H13); elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H14 H10)).
+unfold is_lub in p; unfold is_upper_bound in p; elim p; clear p; intros;
+ split.
+elim H2; intros; assert (H7 := H4 _ H6); unfold E in H6; elim H6; clear H6;
+ intros H6 _; elim H6; intros; apply Rlt_le_trans with x0;
+ assumption.
+apply H5; intros; unfold E in H6; elim H6; clear H6; intros H6 _; elim H6;
+ intros; assumption.
Qed.
-Lemma Heine_cor2 : (f:(R->R); a,b:R) ((x:R)``a <= x <= b``->(continuity_pt f x))->(eps:posreal)(sigTT posreal [delta:posreal]((x,y:R)``a <= x <= b``->``a <= y <= b``->``(Rabsolu (x-y)) < delta``->``(Rabsolu ((f x)-(f y))) < eps``)).
-Intro f; Intros; Case (total_order_T a b); Intro.
-Elim s; Intro.
-Assert H0 := (Heine_cor1 a0 H eps); Elim H0; Intros; Apply existTT with x; Elim p; Intros; Apply H2; Assumption.
-Apply existTT with (mkposreal ? Rlt_R0_R1); Intros; Assert H3 : x==y; [Elim H0; Elim H1; Intros; Rewrite b0 in H3; Rewrite b0 in H5; Apply Rle_antisym; Apply Rle_trans with b; Assumption | Rewrite H3; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply (cond_pos eps)].
-Apply existTT with (mkposreal ? Rlt_R0_R1); Intros; Elim H0; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? (Rle_trans ? ? ? H3 H4) r)).
+Lemma Heine_cor2 :
+ forall (f:R -> R) (a b:R),
+ (forall x:R, a <= x <= b -> continuity_pt f x) ->
+ forall eps:posreal,
+ sigT
+ (fun delta:posreal =>
+ forall x y:R,
+ a <= x <= b ->
+ a <= y <= b -> Rabs (x - y) < delta -> Rabs (f x - f y) < eps).
+intro f; intros; case (total_order_T a b); intro.
+elim s; intro.
+assert (H0 := Heine_cor1 a0 H eps); elim H0; intros; apply existT with x;
+ elim p; intros; apply H2; assumption.
+apply existT with (mkposreal _ Rlt_0_1); intros; assert (H3 : x = y);
+ [ elim H0; elim H1; intros; rewrite b0 in H3; rewrite b0 in H5;
+ apply Rle_antisym; apply Rle_trans with b; assumption
+ | rewrite H3; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+ apply (cond_pos eps) ].
+apply existT with (mkposreal _ Rlt_0_1); intros; elim H0; intros;
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ (Rle_trans _ _ _ H3 H4) r)).
Qed.
-Lemma SubEqui_P1 : (a,b:R;del:posreal;h:``a<b``) (pos_Rl (SubEqui del h) O)==a.
-Intros; Unfold SubEqui; Case (maxN del h); Intros; Reflexivity.
+Lemma SubEqui_P1 :
+ forall (a b:R) (del:posreal) (h:a < b), pos_Rl (SubEqui del h) 0 = a.
+intros; unfold SubEqui in |- *; case (maxN del h); intros; reflexivity.
Qed.
-Lemma SubEqui_P2 : (a,b:R;del:posreal;h:``a<b``) (pos_Rl (SubEqui del h) (pred (Rlength (SubEqui del h))))==b.
-Intros; Unfold SubEqui; Case (maxN del h); Intros; Clear a0; Cut (x:nat)(a:R)(del:posreal)(pos_Rl (SubEquiN (S x) a b del) (pred (Rlength (SubEquiN (S x) a b del)))) == b; [Intro; Apply H | Induction x0; [Intros; Reflexivity | Intros; Change (pos_Rl (SubEquiN (S n) ``a0+del0`` b del0) (pred (Rlength (SubEquiN (S n) ``a0+del0`` b del0))))==b; Apply H]].
+Lemma SubEqui_P2 :
+ forall (a b:R) (del:posreal) (h:a < b),
+ pos_Rl (SubEqui del h) (pred (Rlength (SubEqui del h))) = b.
+intros; unfold SubEqui in |- *; case (maxN del h); intros; clear a0;
+ cut
+ (forall (x:nat) (a:R) (del:posreal),
+ pos_Rl (SubEquiN (S x) a b del)
+ (pred (Rlength (SubEquiN (S x) a b del))) = b);
+ [ intro; apply H
+ | simple induction x0;
+ [ intros; reflexivity
+ | intros;
+ change
+ (pos_Rl (SubEquiN (S n) (a0 + del0) b del0)
+ (pred (Rlength (SubEquiN (S n) (a0 + del0) b del0))) = b)
+ in |- *; apply H ] ].
Qed.
-Lemma SubEqui_P3 : (N:nat;a,b:R;del:posreal) (Rlength (SubEquiN N a b del))=(S N).
-Induction N; Intros; [Reflexivity | Simpl; Rewrite H; Reflexivity].
+Lemma SubEqui_P3 :
+ forall (N:nat) (a b:R) (del:posreal), Rlength (SubEquiN N a b del) = S N.
+simple induction N; intros;
+ [ reflexivity | simpl in |- *; rewrite H; reflexivity ].
Qed.
-Lemma SubEqui_P4 : (N:nat;a,b:R;del:posreal;i:nat) (lt i (S N)) -> (pos_Rl (SubEquiN (S N) a b del) i)==``a+(INR i)*del``.
-Induction N; [Intros; Inversion H; [Simpl; Ring | Elim (le_Sn_O ? H1)] | Intros; Induction i; [Simpl; Ring | Change (pos_Rl (SubEquiN (S n) ``a+del`` b del) i)==``a+(INR (S i))*del``; Rewrite H; [Rewrite S_INR; Ring | Apply lt_S_n; Apply H0]]].
+Lemma SubEqui_P4 :
+ forall (N:nat) (a b:R) (del:posreal) (i:nat),
+ (i < S N)%nat -> pos_Rl (SubEquiN (S N) a b del) i = a + INR i * del.
+simple induction N;
+ [ intros; inversion H; [ simpl in |- *; ring | elim (le_Sn_O _ H1) ]
+ | intros; induction i as [| i Hreci];
+ [ simpl in |- *; ring
+ | change
+ (pos_Rl (SubEquiN (S n) (a + del) b del) i = a + INR (S i) * del)
+ in |- *; rewrite H; [ rewrite S_INR; ring | apply lt_S_n; apply H0 ] ] ].
Qed.
-Lemma SubEqui_P5 : (a,b:R;del:posreal;h:``a<b``) (Rlength (SubEqui del h))=(S (S (max_N del h))).
-Intros; Unfold SubEqui; Apply SubEqui_P3.
+Lemma SubEqui_P5 :
+ forall (a b:R) (del:posreal) (h:a < b),
+ Rlength (SubEqui del h) = S (S (max_N del h)).
+intros; unfold SubEqui in |- *; apply SubEqui_P3.
Qed.
-Lemma SubEqui_P6 : (a,b:R;del:posreal;h:``a<b``;i:nat) (lt i (S (max_N del h))) -> (pos_Rl (SubEqui del h) i)==``a+(INR i)*del``.
-Intros; Unfold SubEqui; Apply SubEqui_P4; Assumption.
+Lemma SubEqui_P6 :
+ forall (a b:R) (del:posreal) (h:a < b) (i:nat),
+ (i < S (max_N del h))%nat -> pos_Rl (SubEqui del h) i = a + INR i * del.
+intros; unfold SubEqui in |- *; apply SubEqui_P4; assumption.
Qed.
-Lemma SubEqui_P7 : (a,b:R;del:posreal;h:``a<b``) (ordered_Rlist (SubEqui del h)).
-Intros; Unfold ordered_Rlist; Intros; Rewrite SubEqui_P5 in H; Simpl in H; Inversion H.
-Rewrite (SubEqui_P6 3!del 4!h 5!(max_N del h)).
-Replace (S (max_N del h)) with (pred (Rlength (SubEqui del h))).
-Rewrite SubEqui_P2; Unfold max_N; Case (maxN del h); Intros; Left; Elim a0; Intros; Assumption.
-Rewrite SubEqui_P5; Reflexivity.
-Apply lt_n_Sn.
-Repeat Rewrite SubEqui_P6.
-3:Assumption.
-2:Apply le_lt_n_Sm; Assumption.
-Apply Rle_compatibility; Rewrite S_INR; Rewrite Rmult_Rplus_distrl; Pattern 1 ``(INR i)*del``; Rewrite <- Rplus_Or; Apply Rle_compatibility; Rewrite Rmult_1l; Left; Apply (cond_pos del).
+Lemma SubEqui_P7 :
+ forall (a b:R) (del:posreal) (h:a < b), ordered_Rlist (SubEqui del h).
+intros; unfold ordered_Rlist in |- *; intros; rewrite SubEqui_P5 in H;
+ simpl in H; inversion H.
+rewrite (SubEqui_P6 del h (i:=(max_N del h))).
+replace (S (max_N del h)) with (pred (Rlength (SubEqui del h))).
+rewrite SubEqui_P2; unfold max_N in |- *; case (maxN del h); intros; left;
+ elim a0; intros; assumption.
+rewrite SubEqui_P5; reflexivity.
+apply lt_n_Sn.
+repeat rewrite SubEqui_P6.
+3: assumption.
+2: apply le_lt_n_Sm; assumption.
+apply Rplus_le_compat_l; rewrite S_INR; rewrite Rmult_plus_distr_r;
+ pattern (INR i * del) at 1 in |- *; rewrite <- Rplus_0_r;
+ apply Rplus_le_compat_l; rewrite Rmult_1_l; left;
+ apply (cond_pos del).
Qed.
-Lemma SubEqui_P8 : (a,b:R;del:posreal;h:``a<b``;i:nat) (lt i (Rlength (SubEqui del h))) -> ``a<=(pos_Rl (SubEqui del h) i)<=b``.
-Intros; Split.
-Pattern 1 a; Rewrite <- (SubEqui_P1 del h); Apply RList_P5.
-Apply SubEqui_P7.
-Elim (RList_P3 (SubEqui del h) (pos_Rl (SubEqui del h) i)); Intros; Apply H1; Exists i; Split; [Reflexivity | Assumption].
-Pattern 2 b; Rewrite <- (SubEqui_P2 del h); Apply RList_P7; [Apply SubEqui_P7 | Elim (RList_P3 (SubEqui del h) (pos_Rl (SubEqui del h) i)); Intros; Apply H1; Exists i; Split; [Reflexivity | Assumption]].
+Lemma SubEqui_P8 :
+ forall (a b:R) (del:posreal) (h:a < b) (i:nat),
+ (i < Rlength (SubEqui del h))%nat -> a <= pos_Rl (SubEqui del h) i <= b.
+intros; split.
+pattern a at 1 in |- *; rewrite <- (SubEqui_P1 del h); apply RList_P5.
+apply SubEqui_P7.
+elim (RList_P3 (SubEqui del h) (pos_Rl (SubEqui del h) i)); intros; apply H1;
+ exists i; split; [ reflexivity | assumption ].
+pattern b at 2 in |- *; rewrite <- (SubEqui_P2 del h); apply RList_P7;
+ [ apply SubEqui_P7
+ | elim (RList_P3 (SubEqui del h) (pos_Rl (SubEqui del h) i)); intros;
+ apply H1; exists i; split; [ reflexivity | assumption ] ].
Qed.
-Lemma SubEqui_P9 : (a,b:R;del:posreal;f:R->R;h:``a<b``) (sigTT ? [g:(StepFun a b)](g b)==(f b)/\(i:nat)(lt i (pred (Rlength (SubEqui del h))))->(constant_D_eq g (co_interval (pos_Rl (SubEqui del h) i) (pos_Rl (SubEqui del h) (S i))) (f (pos_Rl (SubEqui del h) i)))).
-Intros; Apply StepFun_P38; [Apply SubEqui_P7 | Apply SubEqui_P1 | Apply SubEqui_P2].
+Lemma SubEqui_P9 :
+ forall (a b:R) (del:posreal) (f:R -> R) (h:a < b),
+ sigT
+ (fun g:StepFun a b =>
+ g b = f b /\
+ (forall i:nat,
+ (i < pred (Rlength (SubEqui del h)))%nat ->
+ constant_D_eq g
+ (co_interval (pos_Rl (SubEqui del h) i)
+ (pos_Rl (SubEqui del h) (S i)))
+ (f (pos_Rl (SubEqui del h) i)))).
+intros; apply StepFun_P38;
+ [ apply SubEqui_P7 | apply SubEqui_P1 | apply SubEqui_P2 ].
Qed.
-Lemma RiemannInt_P6 : (f:R->R;a,b:R) ``a<b`` -> ((x:R)``a<=x<=b``->(continuity_pt f x)) -> (Riemann_integrable f a b).
-Intros; Unfold Riemann_integrable; Intro; Assert H1 : ``0<eps/(2*(b-a))``.
-Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos eps) | Apply Rlt_Rinv; Apply Rmult_lt_pos; [Sup0 | Apply Rlt_Rminus; Assumption]].
-Assert H2 : (Rmin a b)==a.
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Left; Assumption].
-Assert H3 : (Rmax a b)==b.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Left; Assumption].
-Elim (Heine_cor2 H0 (mkposreal ? H1)); Intros del H4; Elim (SubEqui_P9 del f H); Intros phi [H5 H6]; Split with phi; Split with (mkStepFun (StepFun_P4 a b ``eps/(2*(b-a))``)); Split.
-2:Rewrite StepFun_P18; Unfold Rdiv; Rewrite Rinv_Rmult.
-2:Do 2 Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-2:Rewrite Rmult_1r; Rewrite Rabsolu_right.
-2:Apply Rlt_monotony_contra with ``2``.
-2:Sup0.
-2:Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
-2:Rewrite Rmult_1l; Pattern 1 (pos eps); Rewrite <- Rplus_Or; Rewrite double; Apply Rlt_compatibility; Apply (cond_pos eps).
-2:DiscrR.
-2:Apply Rle_sym1; Left; Apply Rmult_lt_pos.
-2:Apply (cond_pos eps).
-2:Apply Rlt_Rinv; Sup0.
-2:Apply Rminus_eq_contra; Red; Intro; Clear H6; Rewrite H7 in H; Elim (Rlt_antirefl ? H).
-2:DiscrR.
-2:Apply Rminus_eq_contra; Red; Intro; Clear H6; Rewrite H7 in H; Elim (Rlt_antirefl ? H).
-Intros; Rewrite H2 in H7; Rewrite H3 in H7; Simpl; Unfold fct_cte; Cut (t:R)``a<=t<=b``->t==b\/(EX i:nat | (lt i (pred (Rlength (SubEqui del H))))/\(co_interval (pos_Rl (SubEqui del H) i) (pos_Rl (SubEqui del H) (S i)) t)).
-Intro; Elim (H8 ? H7); Intro.
-Rewrite H9; Rewrite H5; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Left; Assumption.
-Elim H9; Clear H9; Intros I [H9 H10]; Assert H11 := (H6 I H9 t H10); Rewrite H11; Left; Apply H4.
-Assumption.
-Apply SubEqui_P8; Apply lt_trans with (pred (Rlength (SubEqui del H))).
-Assumption.
-Apply lt_pred_n_n; Apply neq_O_lt; Red; Intro; Rewrite <- H12 in H9; Elim (lt_n_O ? H9).
-Unfold co_interval in H10; Elim H10; Clear H10; Intros; Rewrite Rabsolu_right.
-Rewrite SubEqui_P5 in H9; Simpl in H9; Inversion H9.
-Apply Rlt_anti_compatibility with (pos_Rl (SubEqui del H) (max_N del H)).
-Replace ``(pos_Rl (SubEqui del H) (max_N del H))+(t-(pos_Rl (SubEqui del H) (max_N del H)))`` with t; [Idtac | Ring]; Apply Rlt_le_trans with b.
-Rewrite H14 in H12; Assert H13 : (S (max_N del H))=(pred (Rlength (SubEqui del H))).
-Rewrite SubEqui_P5; Reflexivity.
-Rewrite H13 in H12; Rewrite SubEqui_P2 in H12; Apply H12.
-Rewrite SubEqui_P6.
-2:Apply lt_n_Sn.
-Unfold max_N; Case (maxN del H); Intros; Elim a0; Clear a0; Intros _ H13; Replace ``a+(INR x)*del+del`` with ``a+(INR (S x))*del``; [Assumption | Rewrite S_INR; Ring].
-Apply Rlt_anti_compatibility with (pos_Rl (SubEqui del H) I); Replace ``(pos_Rl (SubEqui del H) I)+(t-(pos_Rl (SubEqui del H) I))`` with t; [Idtac | Ring]; Replace ``(pos_Rl (SubEqui del H) I)+del`` with (pos_Rl (SubEqui del H) (S I)).
-Assumption.
-Repeat Rewrite SubEqui_P6.
-Rewrite S_INR; Ring.
-Assumption.
-Apply le_lt_n_Sm; Assumption.
-Apply Rge_minus; Apply Rle_sym1; Assumption.
-Intros; Clear H0 H1 H4 phi H5 H6 t H7; Case (Req_EM t0 b); Intro.
-Left; Assumption.
-Right; Pose I := [j:nat]``a+(INR j)*del<=t0``; Assert H1 : (EX n:nat | (I n)).
-Exists O; Unfold I; Rewrite Rmult_Ol; Rewrite Rplus_Or; Elim H8; Intros; Assumption.
-Assert H4 : (Nbound I).
-Unfold Nbound; Exists (S (max_N del H)); Intros; Unfold max_N; Case (maxN del H); Intros; Elim a0; Clear a0; Intros _ H5; Apply INR_le; Apply Rle_monotony_contra with (pos del).
-Apply (cond_pos del).
-Apply Rle_anti_compatibility with a; Do 2 Rewrite (Rmult_sym del); Apply Rle_trans with t0; Unfold I in H4; Try Assumption; Apply Rle_trans with b; Try Assumption; Elim H8; Intros; Assumption.
-Elim (Nzorn H1 H4); Intros N [H5 H6]; Assert H7 : (lt N (S (max_N del H))).
-Unfold max_N; Case (maxN del H); Intros; Apply INR_lt; Apply Rlt_monotony_contra with (pos del).
-Apply (cond_pos del).
-Apply Rlt_anti_compatibility with a; Do 2 Rewrite (Rmult_sym del); Apply Rle_lt_trans with t0; Unfold I in H5; Try Assumption; Elim a0; Intros; Apply Rlt_le_trans with b; Try Assumption; Elim H8; Intros.
-Elim H11; Intro.
-Assumption.
-Elim H0; Assumption.
-Exists N; Split.
-Rewrite SubEqui_P5; Simpl; Assumption.
-Unfold co_interval; Split.
-Rewrite SubEqui_P6.
-Apply H5.
-Assumption.
-Inversion H7.
-Replace (S (max_N del H)) with (pred (Rlength (SubEqui del H))).
-Rewrite (SubEqui_P2 del H); Elim H8; Intros.
-Elim H11; Intro.
-Assumption.
-Elim H0; Assumption.
-Rewrite SubEqui_P5; Reflexivity.
-Rewrite SubEqui_P6.
-Case (total_order_Rle ``a+(INR (S N))*del`` t0); Intro.
-Assert H11 := (H6 (S N) r); Elim (le_Sn_n ? H11).
-Auto with real.
-Apply le_lt_n_Sm; Assumption.
+Lemma RiemannInt_P6 :
+ forall (f:R -> R) (a b:R),
+ a < b ->
+ (forall x:R, a <= x <= b -> continuity_pt f x) -> Riemann_integrable f a b.
+intros; unfold Riemann_integrable in |- *; intro;
+ assert (H1 : 0 < eps / (2 * (b - a))).
+unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ apply (cond_pos eps)
+ | apply Rinv_0_lt_compat; apply Rmult_lt_0_compat;
+ [ prove_sup0 | apply Rlt_Rminus; assumption ] ].
+assert (H2 : Rmin a b = a).
+unfold Rmin in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n; left; assumption ].
+assert (H3 : Rmax a b = b).
+unfold Rmax in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n; left; assumption ].
+elim (Heine_cor2 H0 (mkposreal _ H1)); intros del H4;
+ elim (SubEqui_P9 del f H); intros phi [H5 H6]; split with phi;
+ split with (mkStepFun (StepFun_P4 a b (eps / (2 * (b - a)))));
+ split.
+2: rewrite StepFun_P18; unfold Rdiv in |- *; rewrite Rinv_mult_distr.
+2: do 2 rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+2: rewrite Rmult_1_r; rewrite Rabs_right.
+2: apply Rmult_lt_reg_l with 2.
+2: prove_sup0.
+2: rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+ rewrite <- Rinv_r_sym.
+2: rewrite Rmult_1_l; pattern (pos eps) at 1 in |- *; rewrite <- Rplus_0_r;
+ rewrite double; apply Rplus_lt_compat_l; apply (cond_pos eps).
+2: discrR.
+2: apply Rle_ge; left; apply Rmult_lt_0_compat.
+2: apply (cond_pos eps).
+2: apply Rinv_0_lt_compat; prove_sup0.
+2: apply Rminus_eq_contra; red in |- *; intro; clear H6; rewrite H7 in H;
+ elim (Rlt_irrefl _ H).
+2: discrR.
+2: apply Rminus_eq_contra; red in |- *; intro; clear H6; rewrite H7 in H;
+ elim (Rlt_irrefl _ H).
+intros; rewrite H2 in H7; rewrite H3 in H7; simpl in |- *;
+ unfold fct_cte in |- *;
+ cut
+ (forall t:R,
+ a <= t <= b ->
+ t = b \/
+ ( exists i : nat
+ | (i < pred (Rlength (SubEqui del H)))%nat /\
+ co_interval (pos_Rl (SubEqui del H) i) (pos_Rl (SubEqui del H) (S i))
+ t)).
+intro; elim (H8 _ H7); intro.
+rewrite H9; rewrite H5; unfold Rminus in |- *; rewrite Rplus_opp_r;
+ rewrite Rabs_R0; left; assumption.
+elim H9; clear H9; intros I [H9 H10]; assert (H11 := H6 I H9 t H10);
+ rewrite H11; left; apply H4.
+assumption.
+apply SubEqui_P8; apply lt_trans with (pred (Rlength (SubEqui del H))).
+assumption.
+apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H9;
+ elim (lt_n_O _ H9).
+unfold co_interval in H10; elim H10; clear H10; intros; rewrite Rabs_right.
+rewrite SubEqui_P5 in H9; simpl in H9; inversion H9.
+apply Rplus_lt_reg_r with (pos_Rl (SubEqui del H) (max_N del H)).
+replace
+ (pos_Rl (SubEqui del H) (max_N del H) +
+ (t - pos_Rl (SubEqui del H) (max_N del H))) with t;
+ [ idtac | ring ]; apply Rlt_le_trans with b.
+rewrite H14 in H12;
+ assert (H13 : S (max_N del H) = pred (Rlength (SubEqui del H))).
+rewrite SubEqui_P5; reflexivity.
+rewrite H13 in H12; rewrite SubEqui_P2 in H12; apply H12.
+rewrite SubEqui_P6.
+2: apply lt_n_Sn.
+unfold max_N in |- *; case (maxN del H); intros; elim a0; clear a0;
+ intros _ H13; replace (a + INR x * del + del) with (a + INR (S x) * del);
+ [ assumption | rewrite S_INR; ring ].
+apply Rplus_lt_reg_r with (pos_Rl (SubEqui del H) I);
+ replace (pos_Rl (SubEqui del H) I + (t - pos_Rl (SubEqui del H) I)) with t;
+ [ idtac | ring ];
+ replace (pos_Rl (SubEqui del H) I + del) with (pos_Rl (SubEqui del H) (S I)).
+assumption.
+repeat rewrite SubEqui_P6.
+rewrite S_INR; ring.
+assumption.
+apply le_lt_n_Sm; assumption.
+apply Rge_minus; apply Rle_ge; assumption.
+intros; clear H0 H1 H4 phi H5 H6 t H7; case (Req_dec t0 b); intro.
+left; assumption.
+right; pose (I := fun j:nat => a + INR j * del <= t0);
+ assert (H1 : exists n : nat | I n).
+exists 0%nat; unfold I in |- *; rewrite Rmult_0_l; rewrite Rplus_0_r; elim H8;
+ intros; assumption.
+assert (H4 : Nbound I).
+unfold Nbound in |- *; exists (S (max_N del H)); intros; unfold max_N in |- *;
+ case (maxN del H); intros; elim a0; clear a0; intros _ H5;
+ apply INR_le; apply Rmult_le_reg_l with (pos del).
+apply (cond_pos del).
+apply Rplus_le_reg_l with a; do 2 rewrite (Rmult_comm del);
+ apply Rle_trans with t0; unfold I in H4; try assumption;
+ apply Rle_trans with b; try assumption; elim H8; intros;
+ assumption.
+elim (Nzorn H1 H4); intros N [H5 H6]; assert (H7 : (N < S (max_N del H))%nat).
+unfold max_N in |- *; case (maxN del H); intros; apply INR_lt;
+ apply Rmult_lt_reg_l with (pos del).
+apply (cond_pos del).
+apply Rplus_lt_reg_r with a; do 2 rewrite (Rmult_comm del);
+ apply Rle_lt_trans with t0; unfold I in H5; try assumption;
+ elim a0; intros; apply Rlt_le_trans with b; try assumption;
+ elim H8; intros.
+elim H11; intro.
+assumption.
+elim H0; assumption.
+exists N; split.
+rewrite SubEqui_P5; simpl in |- *; assumption.
+unfold co_interval in |- *; split.
+rewrite SubEqui_P6.
+apply H5.
+assumption.
+inversion H7.
+replace (S (max_N del H)) with (pred (Rlength (SubEqui del H))).
+rewrite (SubEqui_P2 del H); elim H8; intros.
+elim H11; intro.
+assumption.
+elim H0; assumption.
+rewrite SubEqui_P5; reflexivity.
+rewrite SubEqui_P6.
+case (Rle_dec (a + INR (S N) * del) t0); intro.
+assert (H11 := H6 (S N) r); elim (le_Sn_n _ H11).
+auto with real.
+apply le_lt_n_Sm; assumption.
Qed.
-Lemma RiemannInt_P7 : (f:R->R;a:R) (Riemann_integrable f a a).
-Unfold Riemann_integrable; Intro f; Intros; Split with (mkStepFun (StepFun_P4 a a (f a))); Split with (mkStepFun (StepFun_P4 a a R0)); Split.
-Intros; Simpl; Unfold fct_cte; Replace t with a.
-Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Right; Reflexivity.
-Generalize H; Unfold Rmin Rmax; Case (total_order_Rle a a); Intros; Elim H0; Intros; Apply Rle_antisym; Assumption.
-Rewrite StepFun_P18; Rewrite Rmult_Ol; Rewrite Rabsolu_R0; Apply (cond_pos eps).
+Lemma RiemannInt_P7 : forall (f:R -> R) (a:R), Riemann_integrable f a a.
+unfold Riemann_integrable in |- *; intro f; intros;
+ split with (mkStepFun (StepFun_P4 a a (f a)));
+ split with (mkStepFun (StepFun_P4 a a 0)); split.
+intros; simpl in |- *; unfold fct_cte in |- *; replace t with a.
+unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; right;
+ reflexivity.
+generalize H; unfold Rmin, Rmax in |- *; case (Rle_dec a a); intros; elim H0;
+ intros; apply Rle_antisym; assumption.
+rewrite StepFun_P18; rewrite Rmult_0_l; rewrite Rabs_R0; apply (cond_pos eps).
Qed.
-Lemma continuity_implies_RiemannInt : (f:R->R;a,b:R) ``a<=b`` -> ((x:R)``a<=x<=b``->(continuity_pt f x)) -> (Riemann_integrable f a b).
-Intros; Case (total_order_T a b); Intro; [Elim s; Intro; [Apply RiemannInt_P6; Assumption | Rewrite b0; Apply RiemannInt_P7] | Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r))].
+Lemma continuity_implies_RiemannInt :
+ forall (f:R -> R) (a b:R),
+ a <= b ->
+ (forall x:R, a <= x <= b -> continuity_pt f x) -> Riemann_integrable f a b.
+intros; case (total_order_T a b); intro;
+ [ elim s; intro;
+ [ apply RiemannInt_P6; assumption | rewrite b0; apply RiemannInt_P7 ]
+ | elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)) ].
Qed.
-Lemma RiemannInt_P8 : (f:R->R;a,b:R;pr1:(Riemann_integrable f a b);pr2:(Riemann_integrable f b a)) ``(RiemannInt pr1)==-(RiemannInt pr2)``.
-Intro f; Intros; EApply UL_sequence.
-Unfold RiemannInt; Case (RiemannInt_exists pr1 5!RinvN RinvN_cv); Intros; Apply u.
-Unfold RiemannInt; Case (RiemannInt_exists pr2 5!RinvN RinvN_cv); Intros; Cut (EXT psi1:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((f t)-([(phi_sequence RinvN pr1 n)] t)))<= (psi1 n t)``)/\``(Rabsolu (RiemannInt_SF (psi1 n))) < (RinvN n)``).
-Cut (EXT psi2:nat->(StepFun b a) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((f t)-([(phi_sequence RinvN pr2 n)] t)))<= (psi2 n t)``)/\``(Rabsolu (RiemannInt_SF (psi2 n))) < (RinvN n)``).
-Intros; Elim H; Clear H; Intros psi2 H; Elim H0; Clear H0; Intros psi1 H0; Assert H1 := RinvN_cv; Unfold Un_cv; Intros; Assert H3 : ``0<eps/3``.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
-Unfold Un_cv in H1; Elim (H1 ? H3); Clear H1; Intros N0 H1; Unfold R_dist in H1; Simpl in H1; Assert H4 : (n:nat)(ge n N0)->``(RinvN n)<eps/3``.
-Intros; Assert H5 := (H1 ? H4); Replace (pos (RinvN n)) with ``(Rabsolu (/((INR n)+1)-0))``; [Assumption | Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right; Left; Apply (cond_pos (RinvN n))].
-Clear H1; Unfold Un_cv in u; Elim (u ? H3); Clear u; Intros N1 H1; Exists (max N0 N1); Intros; Unfold R_dist; Apply Rle_lt_trans with ``(Rabsolu ((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+(RiemannInt_SF [(phi_sequence RinvN pr2 n)])))+(Rabsolu ((RiemannInt_SF [(phi_sequence RinvN pr2 n)])-x))``.
-Rewrite <- (Rabsolu_Ropp ``(RiemannInt_SF [(phi_sequence RinvN pr2 n)])-x``); Replace ``(RiemannInt_SF [(phi_sequence RinvN pr1 n)])- -x`` with ``((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+(RiemannInt_SF [(phi_sequence RinvN pr2 n)]))+ -((RiemannInt_SF [(phi_sequence RinvN pr2 n)])-x)``; [Apply Rabsolu_triang | Ring].
-Replace eps with ``2*eps/3+eps/3``.
-Apply Rplus_lt.
-Rewrite (StepFun_P39 (phi_sequence RinvN pr2 n)); Replace ``(RiemannInt_SF [(phi_sequence RinvN pr1 n)])+ -(RiemannInt_SF (mkStepFun (StepFun_P6 (pre [(phi_sequence RinvN pr2 n)]))))`` with ``(RiemannInt_SF [(phi_sequence RinvN pr1 n)])+(-1)*(RiemannInt_SF (mkStepFun (StepFun_P6 (pre [(phi_sequence RinvN pr2 n)]))))``; [Idtac | Ring]; Rewrite <- StepFun_P30.
-Case (total_order_Rle a b); Intro.
-Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 ``-1`` (phi_sequence RinvN pr1 n) (mkStepFun (StepFun_P6 (pre (phi_sequence RinvN pr2 n))))))))).
-Apply StepFun_P34; Assumption.
-Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P28 ``1`` (psi1 n) (mkStepFun (StepFun_P6 (pre (psi2 n))))))).
-Apply StepFun_P37; Try Assumption.
-Intros; Simpl; Rewrite Rmult_1l; Apply Rle_trans with ``(Rabsolu (([(phi_sequence RinvN pr1 n)] x0)-(f x0)))+(Rabsolu ((f x0)-([(phi_sequence RinvN pr2 n)] x0)))``.
-Replace ``([(phi_sequence RinvN pr1 n)] x0)+ -1*([(phi_sequence RinvN pr2 n)] x0)`` with ``(([(phi_sequence RinvN pr1 n)] x0)-(f x0))+((f x0)-([(phi_sequence RinvN pr2 n)] x0))``; [Apply Rabsolu_triang | Ring].
-Assert H7 : (Rmin a b)==a.
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption].
-Assert H8 : (Rmax a b)==b.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption].
-Apply Rplus_le.
-Elim (H0 n); Intros; Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H9; Rewrite H7; Rewrite H8.
-Elim H6; Intros; Split; Left; Assumption.
-Elim (H n); Intros; Apply H9; Rewrite H7; Rewrite H8.
-Elim H6; Intros; Split; Left; Assumption.
-Rewrite StepFun_P30; Rewrite Rmult_1l; Rewrite double; Apply Rplus_lt.
-Elim (H0 n); Intros; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi1 n))); [Apply Rle_Rabsolu | Apply Rlt_trans with (pos (RinvN n)); [Assumption | Apply H4; Unfold ge; Apply le_trans with (max N0 N1); [Apply le_max_l | Assumption]]].
-Elim (H n); Intros; Rewrite <- (Ropp_Ropp (RiemannInt_SF (mkStepFun (StepFun_P6 (pre (psi2 n)))))); Rewrite <- StepFun_P39; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi2 n))); [Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu | Apply Rlt_trans with (pos (RinvN n)); [Assumption | Apply H4; Unfold ge; Apply le_trans with (max N0 N1); [Apply le_max_l | Assumption]]].
-Assert Hyp : ``b<=a``.
-Auto with real.
-Rewrite StepFun_P39; Rewrite Rabsolu_Ropp; Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P6 (StepFun_P28 ``-1`` (phi_sequence RinvN pr1 n) (mkStepFun (StepFun_P6 (pre (phi_sequence RinvN pr2 n)))))))))).
-Apply StepFun_P34; Assumption.
-Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P28 ``1`` (mkStepFun (StepFun_P6 (pre (psi1 n)))) (psi2 n)))).
-Apply StepFun_P37; Try Assumption.
-Intros; Simpl; Rewrite Rmult_1l; Apply Rle_trans with ``(Rabsolu (([(phi_sequence RinvN pr1 n)] x0)-(f x0)))+(Rabsolu ((f x0)-([(phi_sequence RinvN pr2 n)] x0)))``.
-Replace ``([(phi_sequence RinvN pr1 n)] x0)+ -1*([(phi_sequence RinvN pr2 n)] x0)`` with ``(([(phi_sequence RinvN pr1 n)] x0)-(f x0))+((f x0)-([(phi_sequence RinvN pr2 n)] x0))``; [Apply Rabsolu_triang | Ring].
-Assert H7 : (Rmin a b)==b.
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Elim n0; Assumption | Reflexivity].
-Assert H8 : (Rmax a b)==a.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Elim n0; Assumption | Reflexivity].
-Apply Rplus_le.
-Elim (H0 n); Intros; Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H9; Rewrite H7; Rewrite H8.
-Elim H6; Intros; Split; Left; Assumption.
-Elim (H n); Intros; Apply H9; Rewrite H7; Rewrite H8; Elim H6; Intros; Split; Left; Assumption.
-Rewrite StepFun_P30; Rewrite Rmult_1l; Rewrite double; Apply Rplus_lt.
-Elim (H0 n); Intros; Rewrite <- (Ropp_Ropp (RiemannInt_SF (mkStepFun (StepFun_P6 (pre (psi1 n)))))); Rewrite <- StepFun_P39; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi1 n))); [Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu | Apply Rlt_trans with (pos (RinvN n)); [Assumption | Apply H4; Unfold ge; Apply le_trans with (max N0 N1); [Apply le_max_l | Assumption]]].
-Elim (H n); Intros; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi2 n))); [Apply Rle_Rabsolu | Apply Rlt_trans with (pos (RinvN n)); [Assumption | Apply H4; Unfold ge; Apply le_trans with (max N0 N1); [Apply le_max_l | Assumption]]].
-Unfold R_dist in H1; Apply H1; Unfold ge; Apply le_trans with (max N0 N1); [Apply le_max_r | Assumption].
-Apply r_Rmult_mult with ``3``; [Unfold Rdiv; Rewrite Rmult_Rplus_distr; Do 2 Rewrite (Rmult_sym ``3``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Ring | DiscrR] | DiscrR].
-Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr2 n)); Intro; Rewrite Rmin_sym; Rewrite RmaxSym; Apply (projT2 ? ? (phi_sequence_prop RinvN pr2 n)).
-Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr1 n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr1 n)).
+Lemma RiemannInt_P8 :
+ forall (f:R -> R) (a b:R) (pr1:Riemann_integrable f a b)
+ (pr2:Riemann_integrable f b a), RiemannInt pr1 = - RiemannInt pr2.
+intro f; intros; eapply UL_sequence.
+unfold RiemannInt in |- *; case (RiemannInt_exists pr1 RinvN RinvN_cv);
+ intros; apply u.
+unfold RiemannInt in |- *; case (RiemannInt_exists pr2 RinvN RinvN_cv);
+ intros;
+ cut
+ ( exists psi1 : nat -> StepFun a b
+ | (forall n:nat,
+ (forall t:R,
+ Rmin a b <= t /\ t <= Rmax a b ->
+ Rabs (f t - phi_sequence RinvN pr1 n t) <= psi1 n t) /\
+ Rabs (RiemannInt_SF (psi1 n)) < RinvN n)).
+cut
+ ( exists psi2 : nat -> StepFun b a
+ | (forall n:nat,
+ (forall t:R,
+ Rmin a b <= t /\ t <= Rmax a b ->
+ Rabs (f t - phi_sequence RinvN pr2 n t) <= psi2 n t) /\
+ Rabs (RiemannInt_SF (psi2 n)) < RinvN n)).
+intros; elim H; clear H; intros psi2 H; elim H0; clear H0; intros psi1 H0;
+ assert (H1 := RinvN_cv); unfold Un_cv in |- *; intros;
+ assert (H3 : 0 < eps / 3).
+unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
+unfold Un_cv in H1; elim (H1 _ H3); clear H1; intros N0 H1;
+ unfold R_dist in H1; simpl in H1;
+ assert (H4 : forall n:nat, (n >= N0)%nat -> RinvN n < eps / 3).
+intros; assert (H5 := H1 _ H4);
+ replace (pos (RinvN n)) with (Rabs (/ (INR n + 1) - 0));
+ [ assumption
+ | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right;
+ left; apply (cond_pos (RinvN n)) ].
+clear H1; unfold Un_cv in u; elim (u _ H3); clear u; intros N1 H1;
+ exists (max N0 N1); intros; unfold R_dist in |- *;
+ apply Rle_lt_trans with
+ (Rabs
+ (RiemannInt_SF (phi_sequence RinvN pr1 n) +
+ RiemannInt_SF (phi_sequence RinvN pr2 n)) +
+ Rabs (RiemannInt_SF (phi_sequence RinvN pr2 n) - x)).
+rewrite <- (Rabs_Ropp (RiemannInt_SF (phi_sequence RinvN pr2 n) - x));
+ replace (RiemannInt_SF (phi_sequence RinvN pr1 n) - - x) with
+ (RiemannInt_SF (phi_sequence RinvN pr1 n) +
+ RiemannInt_SF (phi_sequence RinvN pr2 n) +
+ - (RiemannInt_SF (phi_sequence RinvN pr2 n) - x));
+ [ apply Rabs_triang | ring ].
+replace eps with (2 * (eps / 3) + eps / 3).
+apply Rplus_lt_compat.
+rewrite (StepFun_P39 (phi_sequence RinvN pr2 n));
+ replace
+ (RiemannInt_SF (phi_sequence RinvN pr1 n) +
+ - RiemannInt_SF (mkStepFun (StepFun_P6 (pre (phi_sequence RinvN pr2 n)))))
+ with
+ (RiemannInt_SF (phi_sequence RinvN pr1 n) +
+ -1 *
+ RiemannInt_SF (mkStepFun (StepFun_P6 (pre (phi_sequence RinvN pr2 n)))));
+ [ idtac | ring ]; rewrite <- StepFun_P30.
+case (Rle_dec a b); intro.
+apply Rle_lt_trans with
+ (RiemannInt_SF
+ (mkStepFun
+ (StepFun_P32
+ (mkStepFun
+ (StepFun_P28 (-1) (phi_sequence RinvN pr1 n)
+ (mkStepFun (StepFun_P6 (pre (phi_sequence RinvN pr2 n))))))))).
+apply StepFun_P34; assumption.
+apply Rle_lt_trans with
+ (RiemannInt_SF
+ (mkStepFun
+ (StepFun_P28 1 (psi1 n) (mkStepFun (StepFun_P6 (pre (psi2 n))))))).
+apply StepFun_P37; try assumption.
+intros; simpl in |- *; rewrite Rmult_1_l;
+ apply Rle_trans with
+ (Rabs (phi_sequence RinvN pr1 n x0 - f x0) +
+ Rabs (f x0 - phi_sequence RinvN pr2 n x0)).
+replace (phi_sequence RinvN pr1 n x0 + -1 * phi_sequence RinvN pr2 n x0) with
+ (phi_sequence RinvN pr1 n x0 - f x0 + (f x0 - phi_sequence RinvN pr2 n x0));
+ [ apply Rabs_triang | ring ].
+assert (H7 : Rmin a b = a).
+unfold Rmin in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n0; assumption ].
+assert (H8 : Rmax a b = b).
+unfold Rmax in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n0; assumption ].
+apply Rplus_le_compat.
+elim (H0 n); intros; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H9;
+ rewrite H7; rewrite H8.
+elim H6; intros; split; left; assumption.
+elim (H n); intros; apply H9; rewrite H7; rewrite H8.
+elim H6; intros; split; left; assumption.
+rewrite StepFun_P30; rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat.
+elim (H0 n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n)));
+ [ apply RRle_abs
+ | apply Rlt_trans with (pos (RinvN n));
+ [ assumption
+ | apply H4; unfold ge in |- *; apply le_trans with (max N0 N1);
+ [ apply le_max_l | assumption ] ] ].
+elim (H n); intros;
+ rewrite <-
+ (Ropp_involutive (RiemannInt_SF (mkStepFun (StepFun_P6 (pre (psi2 n))))))
+ ; rewrite <- StepFun_P39;
+ apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n)));
+ [ rewrite <- Rabs_Ropp; apply RRle_abs
+ | apply Rlt_trans with (pos (RinvN n));
+ [ assumption
+ | apply H4; unfold ge in |- *; apply le_trans with (max N0 N1);
+ [ apply le_max_l | assumption ] ] ].
+assert (Hyp : b <= a).
+auto with real.
+rewrite StepFun_P39; rewrite Rabs_Ropp;
+ apply Rle_lt_trans with
+ (RiemannInt_SF
+ (mkStepFun
+ (StepFun_P32
+ (mkStepFun
+ (StepFun_P6
+ (StepFun_P28 (-1) (phi_sequence RinvN pr1 n)
+ (mkStepFun (StepFun_P6 (pre (phi_sequence RinvN pr2 n)))))))))).
+apply StepFun_P34; assumption.
+apply Rle_lt_trans with
+ (RiemannInt_SF
+ (mkStepFun
+ (StepFun_P28 1 (mkStepFun (StepFun_P6 (pre (psi1 n)))) (psi2 n)))).
+apply StepFun_P37; try assumption.
+intros; simpl in |- *; rewrite Rmult_1_l;
+ apply Rle_trans with
+ (Rabs (phi_sequence RinvN pr1 n x0 - f x0) +
+ Rabs (f x0 - phi_sequence RinvN pr2 n x0)).
+replace (phi_sequence RinvN pr1 n x0 + -1 * phi_sequence RinvN pr2 n x0) with
+ (phi_sequence RinvN pr1 n x0 - f x0 + (f x0 - phi_sequence RinvN pr2 n x0));
+ [ apply Rabs_triang | ring ].
+assert (H7 : Rmin a b = b).
+unfold Rmin in |- *; case (Rle_dec a b); intro;
+ [ elim n0; assumption | reflexivity ].
+assert (H8 : Rmax a b = a).
+unfold Rmax in |- *; case (Rle_dec a b); intro;
+ [ elim n0; assumption | reflexivity ].
+apply Rplus_le_compat.
+elim (H0 n); intros; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H9;
+ rewrite H7; rewrite H8.
+elim H6; intros; split; left; assumption.
+elim (H n); intros; apply H9; rewrite H7; rewrite H8; elim H6; intros; split;
+ left; assumption.
+rewrite StepFun_P30; rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat.
+elim (H0 n); intros;
+ rewrite <-
+ (Ropp_involutive (RiemannInt_SF (mkStepFun (StepFun_P6 (pre (psi1 n))))))
+ ; rewrite <- StepFun_P39;
+ apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n)));
+ [ rewrite <- Rabs_Ropp; apply RRle_abs
+ | apply Rlt_trans with (pos (RinvN n));
+ [ assumption
+ | apply H4; unfold ge in |- *; apply le_trans with (max N0 N1);
+ [ apply le_max_l | assumption ] ] ].
+elim (H n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n)));
+ [ apply RRle_abs
+ | apply Rlt_trans with (pos (RinvN n));
+ [ assumption
+ | apply H4; unfold ge in |- *; apply le_trans with (max N0 N1);
+ [ apply le_max_l | assumption ] ] ].
+unfold R_dist in H1; apply H1; unfold ge in |- *;
+ apply le_trans with (max N0 N1); [ apply le_max_r | assumption ].
+apply Rmult_eq_reg_l with 3;
+ [ unfold Rdiv in |- *; rewrite Rmult_plus_distr_l;
+ do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc;
+ rewrite <- Rinv_l_sym; [ ring | discrR ]
+ | discrR ].
+split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr2 n)); intro;
+ rewrite Rmin_comm; rewrite RmaxSym;
+ apply (projT2 (phi_sequence_prop RinvN pr2 n)).
+split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr1 n)); intro;
+ apply (projT2 (phi_sequence_prop RinvN pr1 n)).
Qed.
-Lemma RiemannInt_P9 : (f:R->R;a:R;pr:(Riemann_integrable f a a)) ``(RiemannInt pr)==0``.
-Intros; Assert H := (RiemannInt_P8 pr pr); Apply r_Rmult_mult with ``2``; [Rewrite Rmult_Or; Rewrite double; Pattern 2 (RiemannInt pr); Rewrite H; Apply Rplus_Ropp_r | DiscrR].
+Lemma RiemannInt_P9 :
+ forall (f:R -> R) (a:R) (pr:Riemann_integrable f a a), RiemannInt pr = 0.
+intros; assert (H := RiemannInt_P8 pr pr); apply Rmult_eq_reg_l with 2;
+ [ rewrite Rmult_0_r; rewrite double; pattern (RiemannInt pr) at 2 in |- *;
+ rewrite H; apply Rplus_opp_r
+ | discrR ].
Qed.
-Lemma Req_EM_T :(r1,r2:R) (sumboolT (r1==r2) ``r1<>r2``).
-Intros; Elim (total_order_T r1 r2);Intros; [Elim a;Intro; [Right; Red; Intro; Rewrite H in a0; Elim (Rlt_antirefl ``r2`` a0) | Left;Assumption] | Right; Red; Intro; Rewrite H in b; Elim (Rlt_antirefl ``r2`` b)].
+Lemma Req_EM_T : forall r1 r2:R, {r1 = r2} + {r1 <> r2}.
+intros; elim (total_order_T r1 r2); intros;
+ [ elim a; intro;
+ [ right; red in |- *; intro; rewrite H in a0; elim (Rlt_irrefl r2 a0)
+ | left; assumption ]
+ | right; red in |- *; intro; rewrite H in b; elim (Rlt_irrefl r2 b) ].
Qed.
(* L1([a,b]) is a vectorial space *)
-Lemma RiemannInt_P10 : (f,g:R->R;a,b,l:R) (Riemann_integrable f a b) -> (Riemann_integrable g a b) -> (Riemann_integrable [x:R]``(f x)+l*(g x)`` a b).
-Unfold Riemann_integrable; Intros f g; Intros; Case (Req_EM_T l R0); Intro.
-Elim (X eps); Intros; Split with x; Elim p; Intros; Split with x0; Elim p0; Intros; Split; Try Assumption; Rewrite e; Intros; Rewrite Rmult_Ol; Rewrite Rplus_Or; Apply H; Assumption.
-Assert H : ``0<eps/2``.
-Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos eps) | Apply Rlt_Rinv; Sup0].
-Assert H0 : ``0<eps/(2*(Rabsolu l))``.
-Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos eps) | Apply Rlt_Rinv; Apply Rmult_lt_pos; [Sup0 | Apply Rabsolu_pos_lt; Assumption]].
-Elim (X (mkposreal ? H)); Intros; Elim (X0 (mkposreal ? H0)); Intros; Split with (mkStepFun (StepFun_P28 l x x0)); Elim p0; Elim p; Intros; Split with (mkStepFun (StepFun_P28 (Rabsolu l) x1 x2)); Elim p1; Elim p2; Clear p1 p2 p0 p X X0; Intros; Split.
-Intros; Simpl; Apply Rle_trans with ``(Rabsolu ((f t)-(x t)))+(Rabsolu (l*((g t)-(x0 t))))``.
-Replace ``(f t)+l*(g t)-((x t)+l*(x0 t))`` with ``((f t)-(x t))+ l*((g t)-(x0 t))``; [Apply Rabsolu_triang | Ring].
-Apply Rplus_le; [Apply H3; Assumption | Rewrite Rabsolu_mult; Apply Rle_monotony; [Apply Rabsolu_pos | Apply H1; Assumption]].
-Rewrite StepFun_P30; Apply Rle_lt_trans with ``(Rabsolu (RiemannInt_SF x1))+(Rabsolu ((Rabsolu l)*(RiemannInt_SF x2)))``.
-Apply Rabsolu_triang.
-Rewrite (double_var eps); Apply Rplus_lt.
-Apply H4.
-Rewrite Rabsolu_mult; Rewrite Rabsolu_Rabsolu; Apply Rlt_monotony_contra with ``/(Rabsolu l)``.
-Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption.
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym; [Rewrite Rmult_1l; Replace ``/(Rabsolu l)*eps/2`` with ``eps/(2*(Rabsolu l))``; [Apply H2 | Unfold Rdiv; Rewrite Rinv_Rmult; [Ring | DiscrR | Apply Rabsolu_no_R0; Assumption]] | Apply Rabsolu_no_R0; Assumption].
+Lemma RiemannInt_P10 :
+ forall (f g:R -> R) (a b l:R),
+ Riemann_integrable f a b ->
+ Riemann_integrable g a b ->
+ Riemann_integrable (fun x:R => f x + l * g x) a b.
+unfold Riemann_integrable in |- *; intros f g; intros; case (Req_EM_T l 0);
+ intro.
+elim (X eps); intros; split with x; elim p; intros; split with x0; elim p0;
+ intros; split; try assumption; rewrite e; intros;
+ rewrite Rmult_0_l; rewrite Rplus_0_r; apply H; assumption.
+assert (H : 0 < eps / 2).
+unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ apply (cond_pos eps) | apply Rinv_0_lt_compat; prove_sup0 ].
+assert (H0 : 0 < eps / (2 * Rabs l)).
+unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ apply (cond_pos eps)
+ | apply Rinv_0_lt_compat; apply Rmult_lt_0_compat;
+ [ prove_sup0 | apply Rabs_pos_lt; assumption ] ].
+elim (X (mkposreal _ H)); intros; elim (X0 (mkposreal _ H0)); intros;
+ split with (mkStepFun (StepFun_P28 l x x0)); elim p0;
+ elim p; intros; split with (mkStepFun (StepFun_P28 (Rabs l) x1 x2));
+ elim p1; elim p2; clear p1 p2 p0 p X X0; intros; split.
+intros; simpl in |- *;
+ apply Rle_trans with (Rabs (f t - x t) + Rabs (l * (g t - x0 t))).
+replace (f t + l * g t - (x t + l * x0 t)) with
+ (f t - x t + l * (g t - x0 t)); [ apply Rabs_triang | ring ].
+apply Rplus_le_compat;
+ [ apply H3; assumption
+ | rewrite Rabs_mult; apply Rmult_le_compat_l;
+ [ apply Rabs_pos | apply H1; assumption ] ].
+rewrite StepFun_P30;
+ apply Rle_lt_trans with
+ (Rabs (RiemannInt_SF x1) + Rabs (Rabs l * RiemannInt_SF x2)).
+apply Rabs_triang.
+rewrite (double_var eps); apply Rplus_lt_compat.
+apply H4.
+rewrite Rabs_mult; rewrite Rabs_Rabsolu; apply Rmult_lt_reg_l with (/ Rabs l).
+apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption.
+rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym;
+ [ rewrite Rmult_1_l;
+ replace (/ Rabs l * (eps / 2)) with (eps / (2 * Rabs l));
+ [ apply H2
+ | unfold Rdiv in |- *; rewrite Rinv_mult_distr;
+ [ ring | discrR | apply Rabs_no_R0; assumption ] ]
+ | apply Rabs_no_R0; assumption ].
Qed.
-Lemma RiemannInt_P11 : (f:R->R;a,b,l:R;un:nat->posreal;phi1,phi2,psi1,psi2:nat->(StepFun a b)) (Un_cv un R0) -> ((n:nat)((t:R)``(Rmin a b)<=t<=(Rmax a b)``->``(Rabsolu ((f t)-(phi1 n t)))<=(psi1 n t)``)/\``(Rabsolu (RiemannInt_SF (psi1 n)))<(un n)``) -> ((n:nat)((t:R)``(Rmin a b)<=t<=(Rmax a b)``->``(Rabsolu ((f t)-(phi2 n t)))<=(psi2 n t)``)/\``(Rabsolu (RiemannInt_SF (psi2 n)))<(un n)``) -> (Un_cv [N:nat](RiemannInt_SF (phi1 N)) l) -> (Un_cv [N:nat](RiemannInt_SF (phi2 N)) l).
-Unfold Un_cv; Intro f; Intros; Intros.
-Case (total_order_Rle a b); Intro Hyp.
-Assert H4 : ``0<eps/3``.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
-Elim (H ? H4); Clear H; Intros N0 H.
-Elim (H2 ? H4); Clear H2; Intros N1 H2.
-Pose N := (max N0 N1); Exists N; Intros; Unfold R_dist.
-Apply Rle_lt_trans with ``(Rabsolu ((RiemannInt_SF (phi2 n))-(RiemannInt_SF (phi1 n))))+(Rabsolu ((RiemannInt_SF (phi1 n))-l))``.
-Replace ``(RiemannInt_SF (phi2 n))-l`` with ``((RiemannInt_SF (phi2 n))-(RiemannInt_SF (phi1 n)))+((RiemannInt_SF (phi1 n))-l)``; [Apply Rabsolu_triang | Ring].
-Replace ``eps`` with ``2*eps/3+eps/3``.
-Apply Rplus_lt.
-Replace ``(RiemannInt_SF (phi2 n))-(RiemannInt_SF (phi1 n))`` with ``(RiemannInt_SF (phi2 n))+(-1)*(RiemannInt_SF (phi1 n))``; [Idtac | Ring].
-Rewrite <- StepFun_P30.
-Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 ``-1`` (phi2 n) (phi1 n)))))).
-Apply StepFun_P34; Assumption.
-Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P28 R1 (psi1 n) (psi2 n)))).
-Apply StepFun_P37; Try Assumption; Intros; Simpl; Rewrite Rmult_1l.
-Apply Rle_trans with ``(Rabsolu ((phi2 n x)-(f x)))+(Rabsolu ((f x)-(phi1 n x)))``.
-Replace ``(phi2 n x)+-1*(phi1 n x)`` with ``((phi2 n x)-(f x))+((f x)-(phi1 n x))``; [Apply Rabsolu_triang | Ring].
-Rewrite (Rplus_sym (psi1 n x)); Apply Rplus_le.
-Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Elim (H1 n); Intros; Apply H7.
-Assert H10 : (Rmin a b)==a.
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption].
-Assert H11 : (Rmax a b)==b.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption].
-Rewrite H10; Rewrite H11; Elim H6; Intros; Split; Left; Assumption.
-Elim (H0 n); Intros; Apply H7; Assert H10 : (Rmin a b)==a.
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption].
-Assert H11 : (Rmax a b)==b.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption].
-Rewrite H10; Rewrite H11; Elim H6; Intros; Split; Left; Assumption.
-Rewrite StepFun_P30; Rewrite Rmult_1l; Rewrite double; Apply Rplus_lt.
-Apply Rlt_trans with (pos (un n)).
-Elim (H0 n); Intros; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi1 n))).
-Apply Rle_Rabsolu.
-Assumption.
-Replace (pos (un n)) with (R_dist (un n) R0).
-Apply H; Unfold ge; Apply le_trans with N; Try Assumption.
-Unfold N; Apply le_max_l.
-Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right.
-Apply Rle_sym1; Left; Apply (cond_pos (un n)).
-Apply Rlt_trans with (pos (un n)).
-Elim (H1 n); Intros; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi2 n))).
-Apply Rle_Rabsolu; Assumption.
-Assumption.
-Replace (pos (un n)) with (R_dist (un n) R0).
-Apply H; Unfold ge; Apply le_trans with N; Try Assumption; Unfold N; Apply le_max_l.
-Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right; Apply Rle_sym1; Left; Apply (cond_pos (un n)).
-Unfold R_dist in H2; Apply H2; Unfold ge; Apply le_trans with N; Try Assumption; Unfold N; Apply le_max_r.
-Apply r_Rmult_mult with ``3``; [Unfold Rdiv; Rewrite Rmult_Rplus_distr; Do 2 Rewrite (Rmult_sym ``3``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Ring | DiscrR] | DiscrR].
-Assert H4 : ``0<eps/3``.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
-Elim (H ? H4); Clear H; Intros N0 H.
-Elim (H2 ? H4); Clear H2; Intros N1 H2.
-Pose N := (max N0 N1); Exists N; Intros; Unfold R_dist.
-Apply Rle_lt_trans with ``(Rabsolu ((RiemannInt_SF (phi2 n))-(RiemannInt_SF (phi1 n))))+(Rabsolu ((RiemannInt_SF (phi1 n))-l))``.
-Replace ``(RiemannInt_SF (phi2 n))-l`` with ``((RiemannInt_SF (phi2 n))-(RiemannInt_SF (phi1 n)))+((RiemannInt_SF (phi1 n))-l)``; [Apply Rabsolu_triang | Ring].
-Assert Hyp_b : ``b<=a``.
-Auto with real.
-Replace ``eps`` with ``2*eps/3+eps/3``.
-Apply Rplus_lt.
-Replace ``(RiemannInt_SF (phi2 n))-(RiemannInt_SF (phi1 n))`` with ``(RiemannInt_SF (phi2 n))+(-1)*(RiemannInt_SF (phi1 n))``; [Idtac | Ring].
-Rewrite <- StepFun_P30.
-Rewrite StepFun_P39.
-Rewrite Rabsolu_Ropp.
-Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P6 (pre (mkStepFun (StepFun_P28 ``-1`` (phi2 n) (phi1 n))))))))).
-Apply StepFun_P34; Try Assumption.
-Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P6 (pre (mkStepFun (StepFun_P28 R1 (psi1 n) (psi2 n))))))).
-Apply StepFun_P37; Try Assumption.
-Intros; Simpl; Rewrite Rmult_1l.
-Apply Rle_trans with ``(Rabsolu ((phi2 n x)-(f x)))+(Rabsolu ((f x)-(phi1 n x)))``.
-Replace ``(phi2 n x)+-1*(phi1 n x)`` with ``((phi2 n x)-(f x))+((f x)-(phi1 n x))``; [Apply Rabsolu_triang | Ring].
-Rewrite (Rplus_sym (psi1 n x)); Apply Rplus_le.
-Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Elim (H1 n); Intros; Apply H7.
-Assert H10 : (Rmin a b)==b.
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Elim Hyp; Assumption | Reflexivity].
-Assert H11 : (Rmax a b)==a.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Elim Hyp; Assumption | Reflexivity].
-Rewrite H10; Rewrite H11; Elim H6; Intros; Split; Left; Assumption.
-Elim (H0 n); Intros; Apply H7; Assert H10 : (Rmin a b)==b.
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Elim Hyp; Assumption | Reflexivity].
-Assert H11 : (Rmax a b)==a.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Elim Hyp; Assumption | Reflexivity].
-Rewrite H10; Rewrite H11; Elim H6; Intros; Split; Left; Assumption.
-Rewrite <- (Ropp_Ropp (RiemannInt_SF
- (mkStepFun
- (StepFun_P6 (pre (mkStepFun (StepFun_P28 R1 (psi1 n) (psi2 n)))))))).
-Rewrite <- StepFun_P39.
-Rewrite StepFun_P30.
-Rewrite Rmult_1l; Rewrite double.
-Rewrite Ropp_distr1; Apply Rplus_lt.
-Apply Rlt_trans with (pos (un n)).
-Elim (H0 n); Intros; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi1 n))).
-Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu.
-Assumption.
-Replace (pos (un n)) with (R_dist (un n) R0).
-Apply H; Unfold ge; Apply le_trans with N; Try Assumption.
-Unfold N; Apply le_max_l.
-Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right.
-Apply Rle_sym1; Left; Apply (cond_pos (un n)).
-Apply Rlt_trans with (pos (un n)).
-Elim (H1 n); Intros; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi2 n))).
-Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu; Assumption.
-Assumption.
-Replace (pos (un n)) with (R_dist (un n) R0).
-Apply H; Unfold ge; Apply le_trans with N; Try Assumption; Unfold N; Apply le_max_l.
-Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right; Apply Rle_sym1; Left; Apply (cond_pos (un n)).
-Unfold R_dist in H2; Apply H2; Unfold ge; Apply le_trans with N; Try Assumption; Unfold N; Apply le_max_r.
-Apply r_Rmult_mult with ``3``; [Unfold Rdiv; Rewrite Rmult_Rplus_distr; Do 2 Rewrite (Rmult_sym ``3``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Ring | DiscrR] | DiscrR].
+Lemma RiemannInt_P11 :
+ forall (f:R -> R) (a b l:R) (un:nat -> posreal)
+ (phi1 phi2 psi1 psi2:nat -> StepFun a b),
+ Un_cv un 0 ->
+ (forall n:nat,
+ (forall t:R,
+ Rmin a b <= t <= Rmax a b -> Rabs (f t - phi1 n t) <= psi1 n t) /\
+ Rabs (RiemannInt_SF (psi1 n)) < un n) ->
+ (forall n:nat,
+ (forall t:R,
+ Rmin a b <= t <= Rmax a b -> Rabs (f t - phi2 n t) <= psi2 n t) /\
+ Rabs (RiemannInt_SF (psi2 n)) < un n) ->
+ Un_cv (fun N:nat => RiemannInt_SF (phi1 N)) l ->
+ Un_cv (fun N:nat => RiemannInt_SF (phi2 N)) l.
+unfold Un_cv in |- *; intro f; intros; intros.
+case (Rle_dec a b); intro Hyp.
+assert (H4 : 0 < eps / 3).
+unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
+elim (H _ H4); clear H; intros N0 H.
+elim (H2 _ H4); clear H2; intros N1 H2.
+pose (N := max N0 N1); exists N; intros; unfold R_dist in |- *.
+apply Rle_lt_trans with
+ (Rabs (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n)) +
+ Rabs (RiemannInt_SF (phi1 n) - l)).
+replace (RiemannInt_SF (phi2 n) - l) with
+ (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n) +
+ (RiemannInt_SF (phi1 n) - l)); [ apply Rabs_triang | ring ].
+replace eps with (2 * (eps / 3) + eps / 3).
+apply Rplus_lt_compat.
+replace (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n)) with
+ (RiemannInt_SF (phi2 n) + -1 * RiemannInt_SF (phi1 n));
+ [ idtac | ring ].
+rewrite <- StepFun_P30.
+apply Rle_lt_trans with
+ (RiemannInt_SF
+ (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (phi2 n) (phi1 n)))))).
+apply StepFun_P34; assumption.
+apply Rle_lt_trans with
+ (RiemannInt_SF (mkStepFun (StepFun_P28 1 (psi1 n) (psi2 n)))).
+apply StepFun_P37; try assumption; intros; simpl in |- *; rewrite Rmult_1_l.
+apply Rle_trans with (Rabs (phi2 n x - f x) + Rabs (f x - phi1 n x)).
+replace (phi2 n x + -1 * phi1 n x) with (phi2 n x - f x + (f x - phi1 n x));
+ [ apply Rabs_triang | ring ].
+rewrite (Rplus_comm (psi1 n x)); apply Rplus_le_compat.
+rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; elim (H1 n); intros; apply H7.
+assert (H10 : Rmin a b = a).
+unfold Rmin in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n0; assumption ].
+assert (H11 : Rmax a b = b).
+unfold Rmax in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n0; assumption ].
+rewrite H10; rewrite H11; elim H6; intros; split; left; assumption.
+elim (H0 n); intros; apply H7; assert (H10 : Rmin a b = a).
+unfold Rmin in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n0; assumption ].
+assert (H11 : Rmax a b = b).
+unfold Rmax in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n0; assumption ].
+rewrite H10; rewrite H11; elim H6; intros; split; left; assumption.
+rewrite StepFun_P30; rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat.
+apply Rlt_trans with (pos (un n)).
+elim (H0 n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n))).
+apply RRle_abs.
+assumption.
+replace (pos (un n)) with (R_dist (un n) 0).
+apply H; unfold ge in |- *; apply le_trans with N; try assumption.
+unfold N in |- *; apply le_max_l.
+unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0;
+ rewrite Rplus_0_r; apply Rabs_right.
+apply Rle_ge; left; apply (cond_pos (un n)).
+apply Rlt_trans with (pos (un n)).
+elim (H1 n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n))).
+apply RRle_abs; assumption.
+assumption.
+replace (pos (un n)) with (R_dist (un n) 0).
+apply H; unfold ge in |- *; apply le_trans with N; try assumption;
+ unfold N in |- *; apply le_max_l.
+unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0;
+ rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge;
+ left; apply (cond_pos (un n)).
+unfold R_dist in H2; apply H2; unfold ge in |- *; apply le_trans with N;
+ try assumption; unfold N in |- *; apply le_max_r.
+apply Rmult_eq_reg_l with 3;
+ [ unfold Rdiv in |- *; rewrite Rmult_plus_distr_l;
+ do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc;
+ rewrite <- Rinv_l_sym; [ ring | discrR ]
+ | discrR ].
+assert (H4 : 0 < eps / 3).
+unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
+elim (H _ H4); clear H; intros N0 H.
+elim (H2 _ H4); clear H2; intros N1 H2.
+pose (N := max N0 N1); exists N; intros; unfold R_dist in |- *.
+apply Rle_lt_trans with
+ (Rabs (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n)) +
+ Rabs (RiemannInt_SF (phi1 n) - l)).
+replace (RiemannInt_SF (phi2 n) - l) with
+ (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n) +
+ (RiemannInt_SF (phi1 n) - l)); [ apply Rabs_triang | ring ].
+assert (Hyp_b : b <= a).
+auto with real.
+replace eps with (2 * (eps / 3) + eps / 3).
+apply Rplus_lt_compat.
+replace (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n)) with
+ (RiemannInt_SF (phi2 n) + -1 * RiemannInt_SF (phi1 n));
+ [ idtac | ring ].
+rewrite <- StepFun_P30.
+rewrite StepFun_P39.
+rewrite Rabs_Ropp.
+apply Rle_lt_trans with
+ (RiemannInt_SF
+ (mkStepFun
+ (StepFun_P32
+ (mkStepFun
+ (StepFun_P6
+ (pre (mkStepFun (StepFun_P28 (-1) (phi2 n) (phi1 n))))))))).
+apply StepFun_P34; try assumption.
+apply Rle_lt_trans with
+ (RiemannInt_SF
+ (mkStepFun
+ (StepFun_P6 (pre (mkStepFun (StepFun_P28 1 (psi1 n) (psi2 n))))))).
+apply StepFun_P37; try assumption.
+intros; simpl in |- *; rewrite Rmult_1_l.
+apply Rle_trans with (Rabs (phi2 n x - f x) + Rabs (f x - phi1 n x)).
+replace (phi2 n x + -1 * phi1 n x) with (phi2 n x - f x + (f x - phi1 n x));
+ [ apply Rabs_triang | ring ].
+rewrite (Rplus_comm (psi1 n x)); apply Rplus_le_compat.
+rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; elim (H1 n); intros; apply H7.
+assert (H10 : Rmin a b = b).
+unfold Rmin in |- *; case (Rle_dec a b); intro;
+ [ elim Hyp; assumption | reflexivity ].
+assert (H11 : Rmax a b = a).
+unfold Rmax in |- *; case (Rle_dec a b); intro;
+ [ elim Hyp; assumption | reflexivity ].
+rewrite H10; rewrite H11; elim H6; intros; split; left; assumption.
+elim (H0 n); intros; apply H7; assert (H10 : Rmin a b = b).
+unfold Rmin in |- *; case (Rle_dec a b); intro;
+ [ elim Hyp; assumption | reflexivity ].
+assert (H11 : Rmax a b = a).
+unfold Rmax in |- *; case (Rle_dec a b); intro;
+ [ elim Hyp; assumption | reflexivity ].
+rewrite H10; rewrite H11; elim H6; intros; split; left; assumption.
+rewrite <-
+ (Ropp_involutive
+ (RiemannInt_SF
+ (mkStepFun
+ (StepFun_P6 (pre (mkStepFun (StepFun_P28 1 (psi1 n) (psi2 n))))))))
+ .
+rewrite <- StepFun_P39.
+rewrite StepFun_P30.
+rewrite Rmult_1_l; rewrite double.
+rewrite Ropp_plus_distr; apply Rplus_lt_compat.
+apply Rlt_trans with (pos (un n)).
+elim (H0 n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n))).
+rewrite <- Rabs_Ropp; apply RRle_abs.
+assumption.
+replace (pos (un n)) with (R_dist (un n) 0).
+apply H; unfold ge in |- *; apply le_trans with N; try assumption.
+unfold N in |- *; apply le_max_l.
+unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0;
+ rewrite Rplus_0_r; apply Rabs_right.
+apply Rle_ge; left; apply (cond_pos (un n)).
+apply Rlt_trans with (pos (un n)).
+elim (H1 n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n))).
+rewrite <- Rabs_Ropp; apply RRle_abs; assumption.
+assumption.
+replace (pos (un n)) with (R_dist (un n) 0).
+apply H; unfold ge in |- *; apply le_trans with N; try assumption;
+ unfold N in |- *; apply le_max_l.
+unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0;
+ rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge;
+ left; apply (cond_pos (un n)).
+unfold R_dist in H2; apply H2; unfold ge in |- *; apply le_trans with N;
+ try assumption; unfold N in |- *; apply le_max_r.
+apply Rmult_eq_reg_l with 3;
+ [ unfold Rdiv in |- *; rewrite Rmult_plus_distr_l;
+ do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc;
+ rewrite <- Rinv_l_sym; [ ring | discrR ]
+ | discrR ].
Qed.
-Lemma RiemannInt_P12 : (f,g:R->R;a,b,l:R;pr1:(Riemann_integrable f a b);pr2:(Riemann_integrable g a b);pr3:(Riemann_integrable [x:R]``(f x)+l*(g x)`` a b)) ``a<=b`` -> ``(RiemannInt pr3)==(RiemannInt pr1)+l*(RiemannInt pr2)``.
-Intro f; Intros; Case (Req_EM l R0); Intro.
-Pattern 2 l; Rewrite H0; Rewrite Rmult_Ol; Rewrite Rplus_Or; Unfold RiemannInt; Case (RiemannInt_exists pr3 5!RinvN RinvN_cv); Case (RiemannInt_exists pr1 5!RinvN RinvN_cv); Intros; EApply UL_sequence; [Apply u0 | Pose psi1 := [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr1 n)); Pose psi2 := [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr3 n)); Apply RiemannInt_P11 with f RinvN (phi_sequence RinvN pr1) psi1 psi2; [Apply RinvN_cv | Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr1 n)) | Intro; Assert H1 : ((t:R) ``(Rmin a b) <= t``/\``t <= (Rmax a b)`` -> (Rle (Rabsolu (Rminus ``(f t)+l*(g t)`` (phi_sequence RinvN pr3 n t))) (psi2 n t))) /\ ``(Rabsolu (RiemannInt_SF (psi2 n))) < (RinvN n)``; [Apply (projT2 ? ? (phi_sequence_prop RinvN pr3 n)) | Elim H1; Intros; Split; Try Assumption; Intros; Replace (f t) with ``(f t)+l*(g t)``; [Apply H2; Assumption | Rewrite H0; Ring]] | Assumption]].
-EApply UL_sequence.
-Unfold RiemannInt; Case (RiemannInt_exists pr3 5!RinvN RinvN_cv); Intros; Apply u.
-Unfold Un_cv; Intros; Unfold RiemannInt; Case (RiemannInt_exists pr1 5!RinvN RinvN_cv); Case (RiemannInt_exists pr2 5!RinvN RinvN_cv); Unfold Un_cv; Intros; Assert H2 : ``0<eps/5``.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
-Elim (u0 ? H2); Clear u0; Intros N0 H3; Assert H4 := RinvN_cv; Unfold Un_cv in H4; Elim (H4 ? H2); Clear H4 H2; Intros N1 H4; Assert H5 : ``0<eps/(5*(Rabsolu l))``.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Apply Rmult_lt_pos; [Sup0 | Apply Rabsolu_pos_lt; Assumption]].
-Elim (u ? H5); Clear u; Intros N2 H6; Assert H7 := RinvN_cv; Unfold Un_cv in H7; Elim (H7 ? H5); Clear H7 H5; Intros N3 H5; Unfold R_dist in H3 H4 H5 H6; Pose N := (max (max N0 N1) (max N2 N3)).
-Assert H7 : (n:nat) (ge n N1)->``(RinvN n)< eps/5``.
-Intros; Replace (pos (RinvN n)) with ``(Rabsolu ((RinvN n)-0))``; [Unfold RinvN; Apply H4; Assumption | Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right; Left; Apply (cond_pos (RinvN n))].
-Clear H4; Assert H4 := H7; Clear H7; Assert H7 : (n:nat) (ge n N3)->``(RinvN n)< eps/(5*(Rabsolu l))``.
-Intros; Replace (pos (RinvN n)) with ``(Rabsolu ((RinvN n)-0))``; [Unfold RinvN; Apply H5; Assumption | Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right; Left; Apply (cond_pos (RinvN n))].
-Clear H5; Assert H5 := H7; Clear H7; Exists N; Intros; Unfold R_dist.
-Apply Rle_lt_trans with ``(Rabsolu ((RiemannInt_SF [(phi_sequence RinvN pr3 n)])-((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+l*(RiemannInt_SF [(phi_sequence RinvN pr2 n)]))))+(Rabsolu ((RiemannInt_SF [(phi_sequence RinvN pr1 n)])-x0))+(Rabsolu l)*(Rabsolu ((RiemannInt_SF [(phi_sequence RinvN pr2 n)])-x))``.
-Apply Rle_trans with ``(Rabsolu ((RiemannInt_SF [(phi_sequence RinvN pr3 n)])-((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+l*(RiemannInt_SF [(phi_sequence RinvN pr2 n)]))))+(Rabsolu (((RiemannInt_SF [(phi_sequence RinvN pr1 n)])-x0)+l*((RiemannInt_SF [(phi_sequence RinvN pr2 n)])-x)))``.
-Replace ``(RiemannInt_SF [(phi_sequence RinvN pr3 n)])-(x0+l*x)`` with ``(((RiemannInt_SF [(phi_sequence RinvN pr3 n)])-((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+l*(RiemannInt_SF [(phi_sequence RinvN pr2 n)]))))+(((RiemannInt_SF [(phi_sequence RinvN pr1 n)])-x0)+l*((RiemannInt_SF [(phi_sequence RinvN pr2 n)])-x))``; [Apply Rabsolu_triang | Ring].
-Rewrite Rplus_assoc; Apply Rle_compatibility; Rewrite <- Rabsolu_mult; Replace ``(RiemannInt_SF [(phi_sequence RinvN pr1 n)])-x0+l*((RiemannInt_SF [(phi_sequence RinvN pr2 n)])-x)`` with ``((RiemannInt_SF [(phi_sequence RinvN pr1 n)])-x0)+(l*((RiemannInt_SF [(phi_sequence RinvN pr2 n)])-x))``; [Apply Rabsolu_triang | Ring].
-Replace eps with ``3*eps/5+eps/5+eps/5``.
-Repeat Apply Rplus_lt.
-Assert H7 : (EXT psi1:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((f t)-([(phi_sequence RinvN pr1 n)] t)))<= (psi1 n t)``)/\``(Rabsolu (RiemannInt_SF (psi1 n))) < (RinvN n)``).
-Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr1 n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr1 n0)).
-Assert H8 : (EXT psi2:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((g t)-([(phi_sequence RinvN pr2 n)] t)))<= (psi2 n t)``)/\``(Rabsolu (RiemannInt_SF (psi2 n))) < (RinvN n)``).
-Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr2 n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr2 n0)).
-Assert H9 : (EXT psi3:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu (((f t)+l*(g t))-([(phi_sequence RinvN pr3 n)] t)))<= (psi3 n t)``)/\``(Rabsolu (RiemannInt_SF (psi3 n))) < (RinvN n)``).
-Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr3 n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr3 n0)).
-Elim H7; Clear H7; Intros psi1 H7; Elim H8; Clear H8; Intros psi2 H8; Elim H9; Clear H9; Intros psi3 H9; Replace ``(RiemannInt_SF [(phi_sequence RinvN pr3 n)])-((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+l*(RiemannInt_SF [(phi_sequence RinvN pr2 n)]))`` with ``(RiemannInt_SF [(phi_sequence RinvN pr3 n)])+(-1)*((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+l*(RiemannInt_SF [(phi_sequence RinvN pr2 n)]))``; [Idtac | Ring]; Do 2 Rewrite <- StepFun_P30; Assert H10 : (Rmin a b)==a.
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption].
-Assert H11 : (Rmax a b)==b.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption].
-Rewrite H10 in H7; Rewrite H10 in H8; Rewrite H10 in H9; Rewrite H11 in H7; Rewrite H11 in H8; Rewrite H11 in H9; Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 ``-1`` (phi_sequence RinvN pr3 n) (mkStepFun (StepFun_P28 l (phi_sequence RinvN pr1 n) (phi_sequence RinvN pr2 n)))))))).
-Apply StepFun_P34; Assumption.
-Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P28 R1 (psi3 n) (mkStepFun (StepFun_P28 (Rabsolu l) (psi1 n) (psi2 n)))))).
-Apply StepFun_P37; Try Assumption.
-Intros; Simpl; Rewrite Rmult_1l.
-Apply Rle_trans with ``(Rabsolu (([(phi_sequence RinvN pr3 n)] x1)-((f x1)+l*(g x1))))+(Rabsolu (((f x1)+l*(g x1))+ -1*(([(phi_sequence RinvN pr1 n)] x1)+l*([(phi_sequence RinvN pr2 n)] x1))))``.
-Replace ``([(phi_sequence RinvN pr3 n)] x1)+ -1*(([(phi_sequence RinvN pr1 n)] x1)+l*([(phi_sequence RinvN pr2 n)] x1))`` with ``(([(phi_sequence RinvN pr3 n)] x1)-((f x1)+l*(g x1)))+(((f x1)+l*(g x1))+ -1*(([(phi_sequence RinvN pr1 n)] x1)+l*([(phi_sequence RinvN pr2 n)] x1)))``; [Apply Rabsolu_triang | Ring].
-Rewrite Rplus_assoc; Apply Rplus_le.
-Elim (H9 n); Intros; Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H13.
-Elim H12; Intros; Split; Left; Assumption.
-Apply Rle_trans with ``(Rabsolu ((f x1)-([(phi_sequence RinvN pr1 n)] x1)))+(Rabsolu l)*(Rabsolu ((g x1)-([(phi_sequence RinvN pr2 n)] x1)))``.
-Rewrite <- Rabsolu_mult; Replace ``((f x1)+(l*(g x1)+ -1*(([(phi_sequence RinvN pr1 n)] x1)+l*([(phi_sequence RinvN pr2 n)] x1))))`` with ``((f x1)-([(phi_sequence RinvN pr1 n)] x1))+l*((g x1)-([(phi_sequence RinvN pr2 n)] x1))``; [Apply Rabsolu_triang | Ring].
-Apply Rplus_le.
-Elim (H7 n); Intros; Apply H13.
-Elim H12; Intros; Split; Left; Assumption.
-Apply Rle_monotony; [Apply Rabsolu_pos | Elim (H8 n); Intros; Apply H13; Elim H12; Intros; Split; Left; Assumption].
-Do 2 Rewrite StepFun_P30; Rewrite Rmult_1l; Replace ``3*eps/5`` with ``eps/5+(eps/5+eps/5)``; [Repeat Apply Rplus_lt | Ring].
-Apply Rlt_trans with (pos (RinvN n)); [Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi3 n))); [Apply Rle_Rabsolu | Elim (H9 n); Intros; Assumption] | Apply H4; Unfold ge; Apply le_trans with N; [Apply le_trans with (max N0 N1); [Apply le_max_r | Unfold N; Apply le_max_l] | Assumption]].
-Apply Rlt_trans with (pos (RinvN n)); [Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi1 n))); [Apply Rle_Rabsolu | Elim (H7 n); Intros; Assumption] | Apply H4; Unfold ge; Apply le_trans with N; [Apply le_trans with (max N0 N1); [Apply le_max_r | Unfold N; Apply le_max_l] | Assumption]].
-Apply Rlt_monotony_contra with ``/(Rabsolu l)``.
-Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption.
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l; Replace ``/(Rabsolu l)*eps/5`` with ``eps/(5*(Rabsolu l))``.
-Apply Rlt_trans with (pos (RinvN n)); [Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi2 n))); [Apply Rle_Rabsolu | Elim (H8 n); Intros; Assumption] | Apply H5; Unfold ge; Apply le_trans with N; [Apply le_trans with (max N2 N3); [Apply le_max_r | Unfold N; Apply le_max_r] | Assumption]].
-Unfold Rdiv; Rewrite Rinv_Rmult; [Ring | DiscrR | Apply Rabsolu_no_R0; Assumption].
-Apply Rabsolu_no_R0; Assumption.
-Apply H3; Unfold ge; Apply le_trans with (max N0 N1); [Apply le_max_l | Apply le_trans with N; [Unfold N; Apply le_max_l | Assumption]].
-Apply Rlt_monotony_contra with ``/(Rabsolu l)``.
-Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption.
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l; Replace ``/(Rabsolu l)*eps/5`` with ``eps/(5*(Rabsolu l))``.
-Apply H6; Unfold ge; Apply le_trans with (max N2 N3); [Apply le_max_l | Apply le_trans with N; [Unfold N; Apply le_max_r | Assumption]].
-Unfold Rdiv; Rewrite Rinv_Rmult; [Ring | DiscrR | Apply Rabsolu_no_R0; Assumption].
-Apply Rabsolu_no_R0; Assumption.
-Apply r_Rmult_mult with ``5``; [Unfold Rdiv; Do 2 Rewrite Rmult_Rplus_distr; Do 3 Rewrite (Rmult_sym ``5``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Ring | DiscrR] | DiscrR].
+Lemma RiemannInt_P12 :
+ forall (f g:R -> R) (a b l:R) (pr1:Riemann_integrable f a b)
+ (pr2:Riemann_integrable g a b)
+ (pr3:Riemann_integrable (fun x:R => f x + l * g x) a b),
+ a <= b -> RiemannInt pr3 = RiemannInt pr1 + l * RiemannInt pr2.
+intro f; intros; case (Req_dec l 0); intro.
+pattern l at 2 in |- *; rewrite H0; rewrite Rmult_0_l; rewrite Rplus_0_r;
+ unfold RiemannInt in |- *; case (RiemannInt_exists pr3 RinvN RinvN_cv);
+ case (RiemannInt_exists pr1 RinvN RinvN_cv); intros;
+ eapply UL_sequence;
+ [ apply u0
+ | pose (psi1 := fun n:nat => projT1 (phi_sequence_prop RinvN pr1 n));
+ pose (psi2 := fun n:nat => projT1 (phi_sequence_prop RinvN pr3 n));
+ apply RiemannInt_P11 with f RinvN (phi_sequence RinvN pr1) psi1 psi2;
+ [ apply RinvN_cv
+ | intro; apply (projT2 (phi_sequence_prop RinvN pr1 n))
+ | intro;
+ assert
+ (H1 :
+ (forall t:R,
+ Rmin a b <= t /\ t <= Rmax a b ->
+ Rabs (f t + l * g t - phi_sequence RinvN pr3 n t) <= psi2 n t) /\
+ Rabs (RiemannInt_SF (psi2 n)) < RinvN n);
+ [ apply (projT2 (phi_sequence_prop RinvN pr3 n))
+ | elim H1; intros; split; try assumption; intros;
+ replace (f t) with (f t + l * g t);
+ [ apply H2; assumption | rewrite H0; ring ] ]
+ | assumption ] ].
+eapply UL_sequence.
+unfold RiemannInt in |- *; case (RiemannInt_exists pr3 RinvN RinvN_cv);
+ intros; apply u.
+unfold Un_cv in |- *; intros; unfold RiemannInt in |- *;
+ case (RiemannInt_exists pr1 RinvN RinvN_cv);
+ case (RiemannInt_exists pr2 RinvN RinvN_cv); unfold Un_cv in |- *;
+ intros; assert (H2 : 0 < eps / 5).
+unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
+elim (u0 _ H2); clear u0; intros N0 H3; assert (H4 := RinvN_cv);
+ unfold Un_cv in H4; elim (H4 _ H2); clear H4 H2; intros N1 H4;
+ assert (H5 : 0 < eps / (5 * Rabs l)).
+unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ assumption
+ | apply Rinv_0_lt_compat; apply Rmult_lt_0_compat;
+ [ prove_sup0 | apply Rabs_pos_lt; assumption ] ].
+elim (u _ H5); clear u; intros N2 H6; assert (H7 := RinvN_cv);
+ unfold Un_cv in H7; elim (H7 _ H5); clear H7 H5; intros N3 H5;
+ unfold R_dist in H3, H4, H5, H6; pose (N := max (max N0 N1) (max N2 N3)).
+assert (H7 : forall n:nat, (n >= N1)%nat -> RinvN n < eps / 5).
+intros; replace (pos (RinvN n)) with (Rabs (RinvN n - 0));
+ [ unfold RinvN in |- *; apply H4; assumption
+ | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right;
+ left; apply (cond_pos (RinvN n)) ].
+clear H4; assert (H4 := H7); clear H7;
+ assert (H7 : forall n:nat, (n >= N3)%nat -> RinvN n < eps / (5 * Rabs l)).
+intros; replace (pos (RinvN n)) with (Rabs (RinvN n - 0));
+ [ unfold RinvN in |- *; apply H5; assumption
+ | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right;
+ left; apply (cond_pos (RinvN n)) ].
+clear H5; assert (H5 := H7); clear H7; exists N; intros;
+ unfold R_dist in |- *.
+apply Rle_lt_trans with
+ (Rabs
+ (RiemannInt_SF (phi_sequence RinvN pr3 n) -
+ (RiemannInt_SF (phi_sequence RinvN pr1 n) +
+ l * RiemannInt_SF (phi_sequence RinvN pr2 n))) +
+ Rabs (RiemannInt_SF (phi_sequence RinvN pr1 n) - x0) +
+ Rabs l * Rabs (RiemannInt_SF (phi_sequence RinvN pr2 n) - x)).
+apply Rle_trans with
+ (Rabs
+ (RiemannInt_SF (phi_sequence RinvN pr3 n) -
+ (RiemannInt_SF (phi_sequence RinvN pr1 n) +
+ l * RiemannInt_SF (phi_sequence RinvN pr2 n))) +
+ Rabs
+ (RiemannInt_SF (phi_sequence RinvN pr1 n) - x0 +
+ l * (RiemannInt_SF (phi_sequence RinvN pr2 n) - x))).
+replace (RiemannInt_SF (phi_sequence RinvN pr3 n) - (x0 + l * x)) with
+ (RiemannInt_SF (phi_sequence RinvN pr3 n) -
+ (RiemannInt_SF (phi_sequence RinvN pr1 n) +
+ l * RiemannInt_SF (phi_sequence RinvN pr2 n)) +
+ (RiemannInt_SF (phi_sequence RinvN pr1 n) - x0 +
+ l * (RiemannInt_SF (phi_sequence RinvN pr2 n) - x)));
+ [ apply Rabs_triang | ring ].
+rewrite Rplus_assoc; apply Rplus_le_compat_l; rewrite <- Rabs_mult;
+ replace
+ (RiemannInt_SF (phi_sequence RinvN pr1 n) - x0 +
+ l * (RiemannInt_SF (phi_sequence RinvN pr2 n) - x)) with
+ (RiemannInt_SF (phi_sequence RinvN pr1 n) - x0 +
+ l * (RiemannInt_SF (phi_sequence RinvN pr2 n) - x));
+ [ apply Rabs_triang | ring ].
+replace eps with (3 * (eps / 5) + eps / 5 + eps / 5).
+repeat apply Rplus_lt_compat.
+assert
+ (H7 :
+ exists psi1 : nat -> StepFun a b
+ | (forall n:nat,
+ (forall t:R,
+ Rmin a b <= t /\ t <= Rmax a b ->
+ Rabs (f t - phi_sequence RinvN pr1 n t) <= psi1 n t) /\
+ Rabs (RiemannInt_SF (psi1 n)) < RinvN n)).
+split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr1 n)); intro;
+ apply (projT2 (phi_sequence_prop RinvN pr1 n0)).
+assert
+ (H8 :
+ exists psi2 : nat -> StepFun a b
+ | (forall n:nat,
+ (forall t:R,
+ Rmin a b <= t /\ t <= Rmax a b ->
+ Rabs (g t - phi_sequence RinvN pr2 n t) <= psi2 n t) /\
+ Rabs (RiemannInt_SF (psi2 n)) < RinvN n)).
+split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr2 n)); intro;
+ apply (projT2 (phi_sequence_prop RinvN pr2 n0)).
+assert
+ (H9 :
+ exists psi3 : nat -> StepFun a b
+ | (forall n:nat,
+ (forall t:R,
+ Rmin a b <= t /\ t <= Rmax a b ->
+ Rabs (f t + l * g t - phi_sequence RinvN pr3 n t) <= psi3 n t) /\
+ Rabs (RiemannInt_SF (psi3 n)) < RinvN n)).
+split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr3 n)); intro;
+ apply (projT2 (phi_sequence_prop RinvN pr3 n0)).
+elim H7; clear H7; intros psi1 H7; elim H8; clear H8; intros psi2 H8; elim H9;
+ clear H9; intros psi3 H9;
+ replace
+ (RiemannInt_SF (phi_sequence RinvN pr3 n) -
+ (RiemannInt_SF (phi_sequence RinvN pr1 n) +
+ l * RiemannInt_SF (phi_sequence RinvN pr2 n))) with
+ (RiemannInt_SF (phi_sequence RinvN pr3 n) +
+ -1 *
+ (RiemannInt_SF (phi_sequence RinvN pr1 n) +
+ l * RiemannInt_SF (phi_sequence RinvN pr2 n)));
+ [ idtac | ring ]; do 2 rewrite <- StepFun_P30; assert (H10 : Rmin a b = a).
+unfold Rmin in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n0; assumption ].
+assert (H11 : Rmax a b = b).
+unfold Rmax in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n0; assumption ].
+rewrite H10 in H7; rewrite H10 in H8; rewrite H10 in H9; rewrite H11 in H7;
+ rewrite H11 in H8; rewrite H11 in H9;
+ apply Rle_lt_trans with
+ (RiemannInt_SF
+ (mkStepFun
+ (StepFun_P32
+ (mkStepFun
+ (StepFun_P28 (-1) (phi_sequence RinvN pr3 n)
+ (mkStepFun
+ (StepFun_P28 l (phi_sequence RinvN pr1 n)
+ (phi_sequence RinvN pr2 n)))))))).
+apply StepFun_P34; assumption.
+apply Rle_lt_trans with
+ (RiemannInt_SF
+ (mkStepFun
+ (StepFun_P28 1 (psi3 n)
+ (mkStepFun (StepFun_P28 (Rabs l) (psi1 n) (psi2 n)))))).
+apply StepFun_P37; try assumption.
+intros; simpl in |- *; rewrite Rmult_1_l.
+apply Rle_trans with
+ (Rabs (phi_sequence RinvN pr3 n x1 - (f x1 + l * g x1)) +
+ Rabs
+ (f x1 + l * g x1 +
+ -1 * (phi_sequence RinvN pr1 n x1 + l * phi_sequence RinvN pr2 n x1))).
+replace
+ (phi_sequence RinvN pr3 n x1 +
+ -1 * (phi_sequence RinvN pr1 n x1 + l * phi_sequence RinvN pr2 n x1)) with
+ (phi_sequence RinvN pr3 n x1 - (f x1 + l * g x1) +
+ (f x1 + l * g x1 +
+ -1 * (phi_sequence RinvN pr1 n x1 + l * phi_sequence RinvN pr2 n x1)));
+ [ apply Rabs_triang | ring ].
+rewrite Rplus_assoc; apply Rplus_le_compat.
+elim (H9 n); intros; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr;
+ apply H13.
+elim H12; intros; split; left; assumption.
+apply Rle_trans with
+ (Rabs (f x1 - phi_sequence RinvN pr1 n x1) +
+ Rabs l * Rabs (g x1 - phi_sequence RinvN pr2 n x1)).
+rewrite <- Rabs_mult;
+ replace
+ (f x1 +
+ (l * g x1 +
+ -1 * (phi_sequence RinvN pr1 n x1 + l * phi_sequence RinvN pr2 n x1)))
+ with
+ (f x1 - phi_sequence RinvN pr1 n x1 +
+ l * (g x1 - phi_sequence RinvN pr2 n x1)); [ apply Rabs_triang | ring ].
+apply Rplus_le_compat.
+elim (H7 n); intros; apply H13.
+elim H12; intros; split; left; assumption.
+apply Rmult_le_compat_l;
+ [ apply Rabs_pos
+ | elim (H8 n); intros; apply H13; elim H12; intros; split; left; assumption ].
+do 2 rewrite StepFun_P30; rewrite Rmult_1_l;
+ replace (3 * (eps / 5)) with (eps / 5 + (eps / 5 + eps / 5));
+ [ repeat apply Rplus_lt_compat | ring ].
+apply Rlt_trans with (pos (RinvN n));
+ [ apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi3 n)));
+ [ apply RRle_abs | elim (H9 n); intros; assumption ]
+ | apply H4; unfold ge in |- *; apply le_trans with N;
+ [ apply le_trans with (max N0 N1);
+ [ apply le_max_r | unfold N in |- *; apply le_max_l ]
+ | assumption ] ].
+apply Rlt_trans with (pos (RinvN n));
+ [ apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n)));
+ [ apply RRle_abs | elim (H7 n); intros; assumption ]
+ | apply H4; unfold ge in |- *; apply le_trans with N;
+ [ apply le_trans with (max N0 N1);
+ [ apply le_max_r | unfold N in |- *; apply le_max_l ]
+ | assumption ] ].
+apply Rmult_lt_reg_l with (/ Rabs l).
+apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption.
+rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
+rewrite Rmult_1_l; replace (/ Rabs l * (eps / 5)) with (eps / (5 * Rabs l)).
+apply Rlt_trans with (pos (RinvN n));
+ [ apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n)));
+ [ apply RRle_abs | elim (H8 n); intros; assumption ]
+ | apply H5; unfold ge in |- *; apply le_trans with N;
+ [ apply le_trans with (max N2 N3);
+ [ apply le_max_r | unfold N in |- *; apply le_max_r ]
+ | assumption ] ].
+unfold Rdiv in |- *; rewrite Rinv_mult_distr;
+ [ ring | discrR | apply Rabs_no_R0; assumption ].
+apply Rabs_no_R0; assumption.
+apply H3; unfold ge in |- *; apply le_trans with (max N0 N1);
+ [ apply le_max_l
+ | apply le_trans with N; [ unfold N in |- *; apply le_max_l | assumption ] ].
+apply Rmult_lt_reg_l with (/ Rabs l).
+apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption.
+rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
+rewrite Rmult_1_l; replace (/ Rabs l * (eps / 5)) with (eps / (5 * Rabs l)).
+apply H6; unfold ge in |- *; apply le_trans with (max N2 N3);
+ [ apply le_max_l
+ | apply le_trans with N; [ unfold N in |- *; apply le_max_r | assumption ] ].
+unfold Rdiv in |- *; rewrite Rinv_mult_distr;
+ [ ring | discrR | apply Rabs_no_R0; assumption ].
+apply Rabs_no_R0; assumption.
+apply Rmult_eq_reg_l with 5;
+ [ unfold Rdiv in |- *; do 2 rewrite Rmult_plus_distr_l;
+ do 3 rewrite (Rmult_comm 5); repeat rewrite Rmult_assoc;
+ rewrite <- Rinv_l_sym; [ ring | discrR ]
+ | discrR ].
Qed.
-Lemma RiemannInt_P13 : (f,g:R->R;a,b,l:R;pr1:(Riemann_integrable f a b);pr2:(Riemann_integrable g a b);pr3:(Riemann_integrable [x:R]``(f x)+l*(g x)`` a b)) ``(RiemannInt pr3)==(RiemannInt pr1)+l*(RiemannInt pr2)``.
-Intros; Case (total_order_Rle a b); Intro; [Apply RiemannInt_P12; Assumption | Assert H : ``b<=a``; [Auto with real | Replace (RiemannInt pr3) with (Ropp (RiemannInt (RiemannInt_P1 pr3))); [Idtac | Symmetry; Apply RiemannInt_P8]; Replace (RiemannInt pr2) with (Ropp (RiemannInt (RiemannInt_P1 pr2))); [Idtac | Symmetry; Apply RiemannInt_P8]; Replace (RiemannInt pr1) with (Ropp (RiemannInt (RiemannInt_P1 pr1))); [Idtac | Symmetry; Apply RiemannInt_P8]; Rewrite (RiemannInt_P12 (RiemannInt_P1 pr1) (RiemannInt_P1 pr2) (RiemannInt_P1 pr3) H); Ring]].
+Lemma RiemannInt_P13 :
+ forall (f g:R -> R) (a b l:R) (pr1:Riemann_integrable f a b)
+ (pr2:Riemann_integrable g a b)
+ (pr3:Riemann_integrable (fun x:R => f x + l * g x) a b),
+ RiemannInt pr3 = RiemannInt pr1 + l * RiemannInt pr2.
+intros; case (Rle_dec a b); intro;
+ [ apply RiemannInt_P12; assumption
+ | assert (H : b <= a);
+ [ auto with real
+ | replace (RiemannInt pr3) with (- RiemannInt (RiemannInt_P1 pr3));
+ [ idtac | symmetry in |- *; apply RiemannInt_P8 ];
+ replace (RiemannInt pr2) with (- RiemannInt (RiemannInt_P1 pr2));
+ [ idtac | symmetry in |- *; apply RiemannInt_P8 ];
+ replace (RiemannInt pr1) with (- RiemannInt (RiemannInt_P1 pr1));
+ [ idtac | symmetry in |- *; apply RiemannInt_P8 ];
+ rewrite
+ (RiemannInt_P12 (RiemannInt_P1 pr1) (RiemannInt_P1 pr2)
+ (RiemannInt_P1 pr3) H); ring ] ].
Qed.
-Lemma RiemannInt_P14 : (a,b,c:R) (Riemann_integrable (fct_cte c) a b).
-Unfold Riemann_integrable; Intros; Split with (mkStepFun (StepFun_P4 a b c)); Split with (mkStepFun (StepFun_P4 a b R0)); Split; [Intros; Simpl; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Unfold fct_cte; Right; Reflexivity | Rewrite StepFun_P18; Rewrite Rmult_Ol; Rewrite Rabsolu_R0; Apply (cond_pos eps)].
+Lemma RiemannInt_P14 : forall a b c:R, Riemann_integrable (fct_cte c) a b.
+unfold Riemann_integrable in |- *; intros;
+ split with (mkStepFun (StepFun_P4 a b c));
+ split with (mkStepFun (StepFun_P4 a b 0)); split;
+ [ intros; simpl in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r;
+ rewrite Rabs_R0; unfold fct_cte in |- *; right;
+ reflexivity
+ | rewrite StepFun_P18; rewrite Rmult_0_l; rewrite Rabs_R0;
+ apply (cond_pos eps) ].
Qed.
-Lemma RiemannInt_P15 : (a,b,c:R;pr:(Riemann_integrable (fct_cte c) a b)) ``(RiemannInt pr)==c*(b-a)``.
-Intros; Unfold RiemannInt; Case (RiemannInt_exists 1!(fct_cte c) 2!a 3!b pr 5!RinvN RinvN_cv); Intros; EApply UL_sequence.
-Apply u.
-Pose phi1 := [N:nat](phi_sequence RinvN 2!(fct_cte c) 3!a 4!b pr N); Change (Un_cv [N:nat](RiemannInt_SF (phi1 N)) ``c*(b-a)``); Pose f := (fct_cte c); Assert H1 : (EXT psi1:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((f t)-([(phi_sequence RinvN pr n)] t)))<= (psi1 n t)``)/\``(Rabsolu (RiemannInt_SF (psi1 n))) < (RinvN n)``).
-Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr n)).
-Elim H1; Clear H1; Intros psi1 H1; Pose phi2 := [n:nat](mkStepFun (StepFun_P4 a b c)); Pose psi2 := [n:nat](mkStepFun (StepFun_P4 a b R0)); Apply RiemannInt_P11 with f RinvN phi2 psi2 psi1; Try Assumption.
-Apply RinvN_cv.
-Intro; Split.
-Intros; Unfold f; Simpl; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Unfold fct_cte; Right; Reflexivity.
-Unfold psi2; Rewrite StepFun_P18; Rewrite Rmult_Ol; Rewrite Rabsolu_R0; Apply (cond_pos (RinvN n)).
-Unfold Un_cv; Intros; Split with O; Intros; Unfold R_dist; Unfold phi2; Rewrite StepFun_P18; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply H.
+Lemma RiemannInt_P15 :
+ forall (a b c:R) (pr:Riemann_integrable (fct_cte c) a b),
+ RiemannInt pr = c * (b - a).
+intros; unfold RiemannInt in |- *; case (RiemannInt_exists pr RinvN RinvN_cv);
+ intros; eapply UL_sequence.
+apply u.
+pose (phi1 := fun N:nat => phi_sequence RinvN pr N);
+ change (Un_cv (fun N:nat => RiemannInt_SF (phi1 N)) (c * (b - a))) in |- *;
+ pose (f := fct_cte c);
+ assert
+ (H1 :
+ exists psi1 : nat -> StepFun a b
+ | (forall n:nat,
+ (forall t:R,
+ Rmin a b <= t /\ t <= Rmax a b ->
+ Rabs (f t - phi_sequence RinvN pr n t) <= psi1 n t) /\
+ Rabs (RiemannInt_SF (psi1 n)) < RinvN n)).
+split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr n)); intro;
+ apply (projT2 (phi_sequence_prop RinvN pr n)).
+elim H1; clear H1; intros psi1 H1;
+ pose (phi2 := fun n:nat => mkStepFun (StepFun_P4 a b c));
+ pose (psi2 := fun n:nat => mkStepFun (StepFun_P4 a b 0));
+ apply RiemannInt_P11 with f RinvN phi2 psi2 psi1;
+ try assumption.
+apply RinvN_cv.
+intro; split.
+intros; unfold f in |- *; simpl in |- *; unfold Rminus in |- *;
+ rewrite Rplus_opp_r; rewrite Rabs_R0; unfold fct_cte in |- *;
+ right; reflexivity.
+unfold psi2 in |- *; rewrite StepFun_P18; rewrite Rmult_0_l; rewrite Rabs_R0;
+ apply (cond_pos (RinvN n)).
+unfold Un_cv in |- *; intros; split with 0%nat; intros; unfold R_dist in |- *;
+ unfold phi2 in |- *; rewrite StepFun_P18; unfold Rminus in |- *;
+ rewrite Rplus_opp_r; rewrite Rabs_R0; apply H.
Qed.
-Lemma RiemannInt_P16 : (f:R->R;a,b:R) (Riemann_integrable f a b) -> (Riemann_integrable [x:R](Rabsolu (f x)) a b).
-Unfold Riemann_integrable; Intro f; Intros; Elim (X eps); Clear X; Intros phi [psi [H H0]]; Split with (mkStepFun (StepFun_P32 phi)); Split with psi; Split; Try Assumption; Intros; Simpl; Apply Rle_trans with ``(Rabsolu ((f t)-(phi t)))``; [Apply Rabsolu_triang_inv2 | Apply H; Assumption].
+Lemma RiemannInt_P16 :
+ forall (f:R -> R) (a b:R),
+ Riemann_integrable f a b -> Riemann_integrable (fun x:R => Rabs (f x)) a b.
+unfold Riemann_integrable in |- *; intro f; intros; elim (X eps); clear X;
+ intros phi [psi [H H0]]; split with (mkStepFun (StepFun_P32 phi));
+ split with psi; split; try assumption; intros; simpl in |- *;
+ apply Rle_trans with (Rabs (f t - phi t));
+ [ apply Rabs_triang_inv2 | apply H; assumption ].
Qed.
-Lemma Rle_cv_lim : (Un,Vn:nat->R;l1,l2:R) ((n:nat)``(Un n)<=(Vn n)``) -> (Un_cv Un l1) -> (Un_cv Vn l2) -> ``l1<=l2``.
-Intros; Case (total_order_Rle l1 l2); Intro.
-Assumption.
-Assert H2 : ``l2<l1``.
-Auto with real.
-Clear n; Assert H3 : ``0<(l1-l2)/2``.
-Unfold Rdiv; Apply Rmult_lt_pos; [Apply Rlt_Rminus; Assumption | Apply Rlt_Rinv; Sup0].
-Elim (H1 ? H3); Elim (H0 ? H3); Clear H0 H1; Unfold R_dist; Intros; Pose N := (max x x0); Cut ``(Vn N)<(Un N)``.
-Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? (H N) H4)).
-Apply Rlt_trans with ``(l1+l2)/2``.
-Apply Rlt_anti_compatibility with ``-l2``; Replace ``-l2+(l1+l2)/2`` with ``(l1-l2)/2``.
-Rewrite Rplus_sym; Apply Rle_lt_trans with ``(Rabsolu ((Vn N)-l2))``.
-Apply Rle_Rabsolu.
-Apply H1; Unfold ge; Unfold N; Apply le_max_r.
-Apply r_Rmult_mult with ``2``; [Unfold Rdiv; Do 2 Rewrite -> (Rmult_sym ``2``); Rewrite (Rmult_Rplus_distrl ``-l2`` ``(l1+l2)*/2`` ``2``); Repeat Rewrite -> Rmult_assoc; Rewrite <- Rinv_l_sym; [ Ring | DiscrR ] | DiscrR].
-Apply Ropp_Rlt; Apply Rlt_anti_compatibility with l1; Replace ``l1+ -((l1+l2)/2)`` with ``(l1-l2)/2``.
-Apply Rle_lt_trans with ``(Rabsolu ((Un N)-l1))``.
-Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply Rle_Rabsolu.
-Apply H0; Unfold ge; Unfold N; Apply le_max_l.
-Apply r_Rmult_mult with ``2``; [Unfold Rdiv; Do 2 Rewrite -> (Rmult_sym ``2``); Rewrite (Rmult_Rplus_distrl ``l1`` ``-((l1+l2)*/2)`` ``2``); Rewrite <- Ropp_mul1; Repeat Rewrite -> Rmult_assoc; Rewrite <- Rinv_l_sym; [ Ring | DiscrR ] | DiscrR].
+Lemma Rle_cv_lim :
+ forall (Un Vn:nat -> R) (l1 l2:R),
+ (forall n:nat, Un n <= Vn n) -> Un_cv Un l1 -> Un_cv Vn l2 -> l1 <= l2.
+intros; case (Rle_dec l1 l2); intro.
+assumption.
+assert (H2 : l2 < l1).
+auto with real.
+clear n; assert (H3 : 0 < (l1 - l2) / 2).
+unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ apply Rlt_Rminus; assumption | apply Rinv_0_lt_compat; prove_sup0 ].
+elim (H1 _ H3); elim (H0 _ H3); clear H0 H1; unfold R_dist in |- *; intros;
+ pose (N := max x x0); cut (Vn N < Un N).
+intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ (H N) H4)).
+apply Rlt_trans with ((l1 + l2) / 2).
+apply Rplus_lt_reg_r with (- l2);
+ replace (- l2 + (l1 + l2) / 2) with ((l1 - l2) / 2).
+rewrite Rplus_comm; apply Rle_lt_trans with (Rabs (Vn N - l2)).
+apply RRle_abs.
+apply H1; unfold ge in |- *; unfold N in |- *; apply le_max_r.
+apply Rmult_eq_reg_l with 2;
+ [ unfold Rdiv in |- *; do 2 rewrite (Rmult_comm 2);
+ rewrite (Rmult_plus_distr_r (- l2) ((l1 + l2) * / 2) 2);
+ repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym;
+ [ ring | discrR ]
+ | discrR ].
+apply Ropp_lt_cancel; apply Rplus_lt_reg_r with l1;
+ replace (l1 + - ((l1 + l2) / 2)) with ((l1 - l2) / 2).
+apply Rle_lt_trans with (Rabs (Un N - l1)).
+rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply RRle_abs.
+apply H0; unfold ge in |- *; unfold N in |- *; apply le_max_l.
+apply Rmult_eq_reg_l with 2;
+ [ unfold Rdiv in |- *; do 2 rewrite (Rmult_comm 2);
+ rewrite (Rmult_plus_distr_r l1 (- ((l1 + l2) * / 2)) 2);
+ rewrite <- Ropp_mult_distr_l_reverse; repeat rewrite Rmult_assoc;
+ rewrite <- Rinv_l_sym; [ ring | discrR ]
+ | discrR ].
Qed.
-Lemma RiemannInt_P17 : (f:R->R;a,b:R;pr1:(Riemann_integrable f a b);pr2:(Riemann_integrable [x:R](Rabsolu (f x)) a b)) ``a<=b`` -> ``(Rabsolu (RiemannInt pr1))<=(RiemannInt pr2)``.
-Intro f; Intros; Unfold RiemannInt; Case (RiemannInt_exists 1!f 2!a 3!b pr1 5!RinvN RinvN_cv); Case (RiemannInt_exists 1!([x0:R](Rabsolu (f x0))) 2!a 3!b pr2 5!RinvN RinvN_cv); Intros; Pose phi1 := (phi_sequence RinvN pr1); Pose phi2 := [N:nat](mkStepFun (StepFun_P32 (phi1 N))); Apply Rle_cv_lim with [N:nat](Rabsolu (RiemannInt_SF (phi1 N))) [N:nat](RiemannInt_SF (phi2 N)).
-Intro; Unfold phi2; Apply StepFun_P34; Assumption.
-Fold phi1 in u0; Apply (continuity_seq Rabsolu [N:nat](RiemannInt_SF (phi1 N)) x0); Try Assumption.
-Apply continuity_Rabsolu.
-Pose phi3 := (phi_sequence RinvN pr2); Assert H0 : (EXT psi3:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((Rabsolu (f t))-((phi3 n) t)))<= (psi3 n t)``)/\``(Rabsolu (RiemannInt_SF (psi3 n))) < (RinvN n)``).
-Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr2 n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr2 n)).
-Assert H1 : (EXT psi2:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((Rabsolu (f t))-((phi2 n) t)))<= (psi2 n t)``)/\``(Rabsolu (RiemannInt_SF (psi2 n))) < (RinvN n)``).
-Assert H1 : (EXT psi2:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((f t)-((phi1 n) t)))<= (psi2 n t)``)/\``(Rabsolu (RiemannInt_SF (psi2 n))) < (RinvN n)``).
-Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr1 n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr1 n)).
-Elim H1; Clear H1; Intros psi2 H1; Split with psi2; Intros; Elim (H1 n); Clear H1; Intros; Split; Try Assumption.
-Intros; Unfold phi2; Simpl; Apply Rle_trans with ``(Rabsolu ((f t)-((phi1 n) t)))``.
-Apply Rabsolu_triang_inv2.
-Apply H1; Assumption.
-Elim H0; Clear H0; Intros psi3 H0; Elim H1; Clear H1; Intros psi2 H1; Apply RiemannInt_P11 with [x:R](Rabsolu (f x)) RinvN phi3 psi3 psi2; Try Assumption; Apply RinvN_cv.
+Lemma RiemannInt_P17 :
+ forall (f:R -> R) (a b:R) (pr1:Riemann_integrable f a b)
+ (pr2:Riemann_integrable (fun x:R => Rabs (f x)) a b),
+ a <= b -> Rabs (RiemannInt pr1) <= RiemannInt pr2.
+intro f; intros; unfold RiemannInt in |- *;
+ case (RiemannInt_exists pr1 RinvN RinvN_cv);
+ case (RiemannInt_exists pr2 RinvN RinvN_cv); intros;
+ pose (phi1 := phi_sequence RinvN pr1);
+ pose (phi2 := fun N:nat => mkStepFun (StepFun_P32 (phi1 N)));
+ apply Rle_cv_lim with
+ (fun N:nat => Rabs (RiemannInt_SF (phi1 N)))
+ (fun N:nat => RiemannInt_SF (phi2 N)).
+intro; unfold phi2 in |- *; apply StepFun_P34; assumption.
+fold phi1 in u0;
+ apply (continuity_seq Rabs (fun N:nat => RiemannInt_SF (phi1 N)) x0);
+ try assumption.
+apply Rcontinuity_abs.
+pose (phi3 := phi_sequence RinvN pr2);
+ assert
+ (H0 :
+ exists psi3 : nat -> StepFun a b
+ | (forall n:nat,
+ (forall t:R,
+ Rmin a b <= t /\ t <= Rmax a b ->
+ Rabs (Rabs (f t) - phi3 n t) <= psi3 n t) /\
+ Rabs (RiemannInt_SF (psi3 n)) < RinvN n)).
+split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr2 n)); intro;
+ apply (projT2 (phi_sequence_prop RinvN pr2 n)).
+assert
+ (H1 :
+ exists psi2 : nat -> StepFun a b
+ | (forall n:nat,
+ (forall t:R,
+ Rmin a b <= t /\ t <= Rmax a b ->
+ Rabs (Rabs (f t) - phi2 n t) <= psi2 n t) /\
+ Rabs (RiemannInt_SF (psi2 n)) < RinvN n)).
+assert
+ (H1 :
+ exists psi2 : nat -> StepFun a b
+ | (forall n:nat,
+ (forall t:R,
+ Rmin a b <= t /\ t <= Rmax a b -> Rabs (f t - phi1 n t) <= psi2 n t) /\
+ Rabs (RiemannInt_SF (psi2 n)) < RinvN n)).
+split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr1 n)); intro;
+ apply (projT2 (phi_sequence_prop RinvN pr1 n)).
+elim H1; clear H1; intros psi2 H1; split with psi2; intros; elim (H1 n);
+ clear H1; intros; split; try assumption.
+intros; unfold phi2 in |- *; simpl in |- *;
+ apply Rle_trans with (Rabs (f t - phi1 n t)).
+apply Rabs_triang_inv2.
+apply H1; assumption.
+elim H0; clear H0; intros psi3 H0; elim H1; clear H1; intros psi2 H1;
+ apply RiemannInt_P11 with (fun x:R => Rabs (f x)) RinvN phi3 psi3 psi2;
+ try assumption; apply RinvN_cv.
Qed.
-Lemma RiemannInt_P18 : (f,g:R->R;a,b:R;pr1:(Riemann_integrable f a b);pr2:(Riemann_integrable g a b)) ``a<=b`` -> ((x:R)``a<x<b``->``(f x)==(g x)``) -> ``(RiemannInt pr1)==(RiemannInt pr2)``.
-Intro f; Intros; Unfold RiemannInt; Case (RiemannInt_exists 1!f 2!a 3!b pr1 5!RinvN RinvN_cv); Case (RiemannInt_exists 1!g 2!a 3!b pr2 5!RinvN RinvN_cv); Intros; EApply UL_sequence.
-Apply u0.
-Pose phi1 := [N:nat](phi_sequence RinvN 2!f 3!a 4!b pr1 N); Change (Un_cv [N:nat](RiemannInt_SF (phi1 N)) x); Assert H1 : (EXT psi1:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((f t)-((phi1 n) t)))<= (psi1 n t)``)/\``(Rabsolu (RiemannInt_SF (psi1 n))) < (RinvN n)``).
-Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr1 n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr1 n)).
-Elim H1; Clear H1; Intros psi1 H1; Pose phi2 := [N:nat](phi_sequence RinvN 2!g 3!a 4!b pr2 N).
-Pose phi2_aux := [N:nat][x:R](Cases (Req_EM_T x a) of
- | (leftT _) => (f a)
- | (rightT _) => (Cases (Req_EM_T x b) of
- | (leftT _) => (f b)
- | (rightT _) => (phi2 N x) end) end).
-Cut (N:nat)(IsStepFun (phi2_aux N) a b).
-Intro; Pose phi2_m := [N:nat](mkStepFun (X N)).
-Assert H2 : (EXT psi2:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((g t)-((phi2 n) t)))<= (psi2 n t)``)/\``(Rabsolu (RiemannInt_SF (psi2 n))) < (RinvN n)``).
-Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr2 n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr2 n)).
-Elim H2; Clear H2; Intros psi2 H2; Apply RiemannInt_P11 with f RinvN phi2_m psi2 psi1; Try Assumption.
-Apply RinvN_cv.
-Intro; Elim (H2 n); Intros; Split; Try Assumption.
-Intros; Unfold phi2_m; Simpl; Unfold phi2_aux; Case (Req_EM_T t a); Case (Req_EM_T t b); Intros.
-Rewrite e0; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply Rle_trans with ``(Rabsolu ((g t)-((phi2 n) t)))``.
-Apply Rabsolu_pos.
-Pattern 3 a; Rewrite <- e0; Apply H3; Assumption.
-Rewrite e; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply Rle_trans with ``(Rabsolu ((g t)-((phi2 n) t)))``.
-Apply Rabsolu_pos.
-Pattern 3 a; Rewrite <- e; Apply H3; Assumption.
-Rewrite e; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply Rle_trans with ``(Rabsolu ((g t)-((phi2 n) t)))``.
-Apply Rabsolu_pos.
-Pattern 3 b; Rewrite <- e; Apply H3; Assumption.
-Replace (f t) with (g t).
-Apply H3; Assumption.
-Symmetry; Apply H0; Elim H5; Clear H5; Intros.
-Assert H7 : (Rmin a b)==a.
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n2; Assumption].
-Assert H8 : (Rmax a b)==b.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n2; Assumption].
-Rewrite H7 in H5; Rewrite H8 in H6; Split.
-Elim H5; Intro; [Assumption | Elim n1; Symmetry; Assumption].
-Elim H6; Intro; [Assumption | Elim n0; Assumption].
-Cut (N:nat)(RiemannInt_SF (phi2_m N))==(RiemannInt_SF (phi2 N)).
-Intro; Unfold Un_cv; Intros; Elim (u ? H4); Intros; Exists x1; Intros; Rewrite (H3 n); Apply H5; Assumption.
-Intro; Apply Rle_antisym.
-Apply StepFun_P37; Try Assumption.
-Intros; Unfold phi2_m; Simpl; Unfold phi2_aux; Case (Req_EM_T x1 a); Case (Req_EM_T x1 b); Intros.
-Elim H3; Intros; Rewrite e0 in H4; Elim (Rlt_antirefl ? H4).
-Elim H3; Intros; Rewrite e in H4; Elim (Rlt_antirefl ? H4).
-Elim H3; Intros; Rewrite e in H5; Elim (Rlt_antirefl ? H5).
-Right; Reflexivity.
-Apply StepFun_P37; Try Assumption.
-Intros; Unfold phi2_m; Simpl; Unfold phi2_aux; Case (Req_EM_T x1 a); Case (Req_EM_T x1 b); Intros.
-Elim H3; Intros; Rewrite e0 in H4; Elim (Rlt_antirefl ? H4).
-Elim H3; Intros; Rewrite e in H4; Elim (Rlt_antirefl ? H4).
-Elim H3; Intros; Rewrite e in H5; Elim (Rlt_antirefl ? H5).
-Right; Reflexivity.
-Intro; Assert H2 := (pre (phi2 N)); Unfold IsStepFun in H2; Unfold is_subdivision in H2; Elim H2; Clear H2; Intros l [lf H2]; Split with l; Split with lf; Unfold adapted_couple in H2; Decompose [and] H2; Clear H2; Unfold adapted_couple; Repeat Split; Try Assumption.
-Intros; Assert H9 := (H8 i H2); Unfold constant_D_eq open_interval in H9; Unfold constant_D_eq open_interval; Intros; Rewrite <- (H9 x1 H7); Assert H10 : ``a<=(pos_Rl l i)``.
-Replace a with (Rmin a b).
-Rewrite <- H5; Elim (RList_P6 l); Intros; Apply H10.
-Assumption.
-Apply le_O_n.
-Apply lt_trans with (pred (Rlength l)); [Assumption | Apply lt_pred_n_n].
-Apply neq_O_lt; Intro; Rewrite <- H12 in H6; Discriminate.
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Assert H11 : ``(pos_Rl l (S i))<=b``.
-Replace b with (Rmax a b).
-Rewrite <- H4; Elim (RList_P6 l); Intros; Apply H11.
-Assumption.
-Apply lt_le_S; Assumption.
-Apply lt_pred_n_n; Apply neq_O_lt; Intro; Rewrite <- H13 in H6; Discriminate.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Elim H7; Clear H7; Intros; Unfold phi2_aux; Case (Req_EM_T x1 a); Case (Req_EM_T x1 b); Intros.
-Rewrite e in H12; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H11 H12)).
-Rewrite e in H7; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H10 H7)).
-Rewrite e in H12; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H11 H12)).
-Reflexivity.
+Lemma RiemannInt_P18 :
+ forall (f g:R -> R) (a b:R) (pr1:Riemann_integrable f a b)
+ (pr2:Riemann_integrable g a b),
+ a <= b ->
+ (forall x:R, a < x < b -> f x = g x) -> RiemannInt pr1 = RiemannInt pr2.
+intro f; intros; unfold RiemannInt in |- *;
+ case (RiemannInt_exists pr1 RinvN RinvN_cv);
+ case (RiemannInt_exists pr2 RinvN RinvN_cv); intros;
+ eapply UL_sequence.
+apply u0.
+pose (phi1 := fun N:nat => phi_sequence RinvN pr1 N);
+ change (Un_cv (fun N:nat => RiemannInt_SF (phi1 N)) x) in |- *;
+ assert
+ (H1 :
+ exists psi1 : nat -> StepFun a b
+ | (forall n:nat,
+ (forall t:R,
+ Rmin a b <= t /\ t <= Rmax a b ->
+ Rabs (f t - phi1 n t) <= psi1 n t) /\
+ Rabs (RiemannInt_SF (psi1 n)) < RinvN n)).
+split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr1 n)); intro;
+ apply (projT2 (phi_sequence_prop RinvN pr1 n)).
+elim H1; clear H1; intros psi1 H1;
+ pose (phi2 := fun N:nat => phi_sequence RinvN pr2 N).
+pose
+ (phi2_aux :=
+ fun (N:nat) (x:R) =>
+ match Req_EM_T x a with
+ | left _ => f a
+ | right _ =>
+ match Req_EM_T x b with
+ | left _ => f b
+ | right _ => phi2 N x
+ end
+ end).
+cut (forall N:nat, IsStepFun (phi2_aux N) a b).
+intro; pose (phi2_m := fun N:nat => mkStepFun (X N)).
+assert
+ (H2 :
+ exists psi2 : nat -> StepFun a b
+ | (forall n:nat,
+ (forall t:R,
+ Rmin a b <= t /\ t <= Rmax a b -> Rabs (g t - phi2 n t) <= psi2 n t) /\
+ Rabs (RiemannInt_SF (psi2 n)) < RinvN n)).
+split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr2 n)); intro;
+ apply (projT2 (phi_sequence_prop RinvN pr2 n)).
+elim H2; clear H2; intros psi2 H2;
+ apply RiemannInt_P11 with f RinvN phi2_m psi2 psi1;
+ try assumption.
+apply RinvN_cv.
+intro; elim (H2 n); intros; split; try assumption.
+intros; unfold phi2_m in |- *; simpl in |- *; unfold phi2_aux in |- *;
+ case (Req_EM_T t a); case (Req_EM_T t b); intros.
+rewrite e0; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+ apply Rle_trans with (Rabs (g t - phi2 n t)).
+apply Rabs_pos.
+pattern a at 3 in |- *; rewrite <- e0; apply H3; assumption.
+rewrite e; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+ apply Rle_trans with (Rabs (g t - phi2 n t)).
+apply Rabs_pos.
+pattern a at 3 in |- *; rewrite <- e; apply H3; assumption.
+rewrite e; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+ apply Rle_trans with (Rabs (g t - phi2 n t)).
+apply Rabs_pos.
+pattern b at 3 in |- *; rewrite <- e; apply H3; assumption.
+replace (f t) with (g t).
+apply H3; assumption.
+symmetry in |- *; apply H0; elim H5; clear H5; intros.
+assert (H7 : Rmin a b = a).
+unfold Rmin in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n2; assumption ].
+assert (H8 : Rmax a b = b).
+unfold Rmax in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n2; assumption ].
+rewrite H7 in H5; rewrite H8 in H6; split.
+elim H5; intro; [ assumption | elim n1; symmetry in |- *; assumption ].
+elim H6; intro; [ assumption | elim n0; assumption ].
+cut (forall N:nat, RiemannInt_SF (phi2_m N) = RiemannInt_SF (phi2 N)).
+intro; unfold Un_cv in |- *; intros; elim (u _ H4); intros; exists x1; intros;
+ rewrite (H3 n); apply H5; assumption.
+intro; apply Rle_antisym.
+apply StepFun_P37; try assumption.
+intros; unfold phi2_m in |- *; simpl in |- *; unfold phi2_aux in |- *;
+ case (Req_EM_T x1 a); case (Req_EM_T x1 b); intros.
+elim H3; intros; rewrite e0 in H4; elim (Rlt_irrefl _ H4).
+elim H3; intros; rewrite e in H4; elim (Rlt_irrefl _ H4).
+elim H3; intros; rewrite e in H5; elim (Rlt_irrefl _ H5).
+right; reflexivity.
+apply StepFun_P37; try assumption.
+intros; unfold phi2_m in |- *; simpl in |- *; unfold phi2_aux in |- *;
+ case (Req_EM_T x1 a); case (Req_EM_T x1 b); intros.
+elim H3; intros; rewrite e0 in H4; elim (Rlt_irrefl _ H4).
+elim H3; intros; rewrite e in H4; elim (Rlt_irrefl _ H4).
+elim H3; intros; rewrite e in H5; elim (Rlt_irrefl _ H5).
+right; reflexivity.
+intro; assert (H2 := pre (phi2 N)); unfold IsStepFun in H2;
+ unfold is_subdivision in H2; elim H2; clear H2; intros l [lf H2];
+ split with l; split with lf; unfold adapted_couple in H2;
+ decompose [and] H2; clear H2; unfold adapted_couple in |- *;
+ repeat split; try assumption.
+intros; assert (H9 := H8 i H2); unfold constant_D_eq, open_interval in H9;
+ unfold constant_D_eq, open_interval in |- *; intros;
+ rewrite <- (H9 x1 H7); assert (H10 : a <= pos_Rl l i).
+replace a with (Rmin a b).
+rewrite <- H5; elim (RList_P6 l); intros; apply H10.
+assumption.
+apply le_O_n.
+apply lt_trans with (pred (Rlength l)); [ assumption | apply lt_pred_n_n ].
+apply neq_O_lt; intro; rewrite <- H12 in H6; discriminate.
+unfold Rmin in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n; assumption ].
+assert (H11 : pos_Rl l (S i) <= b).
+replace b with (Rmax a b).
+rewrite <- H4; elim (RList_P6 l); intros; apply H11.
+assumption.
+apply lt_le_S; assumption.
+apply lt_pred_n_n; apply neq_O_lt; intro; rewrite <- H13 in H6; discriminate.
+unfold Rmax in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n; assumption ].
+elim H7; clear H7; intros; unfold phi2_aux in |- *; case (Req_EM_T x1 a);
+ case (Req_EM_T x1 b); intros.
+rewrite e in H12; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H11 H12)).
+rewrite e in H7; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H10 H7)).
+rewrite e in H12; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H11 H12)).
+reflexivity.
Qed.
-Lemma RiemannInt_P19 : (f,g:R->R;a,b:R;pr1:(Riemann_integrable f a b);pr2:(Riemann_integrable g a b)) ``a<=b`` -> ((x:R)``a<x<b``->``(f x)<=(g x)``) -> ``(RiemannInt pr1)<=(RiemannInt pr2)``.
-Intro f; Intros; Apply Rle_anti_compatibility with ``-(RiemannInt pr1)``; Rewrite Rplus_Ropp_l; Rewrite Rplus_sym; Apply Rle_trans with (Rabsolu (RiemannInt (RiemannInt_P10 ``-1`` pr2 pr1))).
-Apply Rabsolu_pos.
-Replace ``(RiemannInt pr2)+ -(RiemannInt pr1)`` with (RiemannInt (RiemannInt_P16 (RiemannInt_P10 ``-1`` pr2 pr1))).
-Apply (RiemannInt_P17 (RiemannInt_P10 ``-1`` pr2 pr1) (RiemannInt_P16 (RiemannInt_P10 ``-1`` pr2 pr1))); Assumption.
-Replace ``(RiemannInt pr2)+-(RiemannInt pr1)`` with (RiemannInt (RiemannInt_P10 ``-1`` pr2 pr1)).
-Apply RiemannInt_P18; Try Assumption.
-Intros; Apply Rabsolu_right.
-Apply Rle_sym1; Apply Rle_anti_compatibility with (f x); Rewrite Rplus_Or; Replace ``(f x)+((g x)+ -1*(f x))`` with (g x); [Apply H0; Assumption | Ring].
-Rewrite (RiemannInt_P12 pr2 pr1 (RiemannInt_P10 ``-1`` pr2 pr1)); [Ring | Assumption].
+Lemma RiemannInt_P19 :
+ forall (f g:R -> R) (a b:R) (pr1:Riemann_integrable f a b)
+ (pr2:Riemann_integrable g a b),
+ a <= b ->
+ (forall x:R, a < x < b -> f x <= g x) -> RiemannInt pr1 <= RiemannInt pr2.
+intro f; intros; apply Rplus_le_reg_l with (- RiemannInt pr1);
+ rewrite Rplus_opp_l; rewrite Rplus_comm;
+ apply Rle_trans with (Rabs (RiemannInt (RiemannInt_P10 (-1) pr2 pr1))).
+apply Rabs_pos.
+replace (RiemannInt pr2 + - RiemannInt pr1) with
+ (RiemannInt (RiemannInt_P16 (RiemannInt_P10 (-1) pr2 pr1))).
+apply
+ (RiemannInt_P17 (RiemannInt_P10 (-1) pr2 pr1)
+ (RiemannInt_P16 (RiemannInt_P10 (-1) pr2 pr1)));
+ assumption.
+replace (RiemannInt pr2 + - RiemannInt pr1) with
+ (RiemannInt (RiemannInt_P10 (-1) pr2 pr1)).
+apply RiemannInt_P18; try assumption.
+intros; apply Rabs_right.
+apply Rle_ge; apply Rplus_le_reg_l with (f x); rewrite Rplus_0_r;
+ replace (f x + (g x + -1 * f x)) with (g x); [ apply H0; assumption | ring ].
+rewrite (RiemannInt_P12 pr2 pr1 (RiemannInt_P10 (-1) pr2 pr1));
+ [ ring | assumption ].
Qed.
-Lemma FTC_P1 : (f:R->R;a,b:R) ``a<=b`` -> ((x:R)``a<=x<=b``->(continuity_pt f x)) -> ((x:R)``a<=x``->``x<=b``->(Riemann_integrable f a x)).
-Intros; Apply continuity_implies_RiemannInt; [Assumption | Intros; Apply H0; Elim H3; Intros; Split; Assumption Orelse Apply Rle_trans with x; Assumption].
+Lemma FTC_P1 :
+ forall (f:R -> R) (a b:R),
+ a <= b ->
+ (forall x:R, a <= x <= b -> continuity_pt f x) ->
+ forall x:R, a <= x -> x <= b -> Riemann_integrable f a x.
+intros; apply continuity_implies_RiemannInt;
+ [ assumption
+ | intros; apply H0; elim H3; intros; split;
+ assumption || apply Rle_trans with x; assumption ].
Qed.
-V7only [Notation FTC_P2 := Rle_refl.].
-
-Definition primitive [f:R->R;a,b:R;h:``a<=b``;pr:((x:R)``a<=x``->``x<=b``->(Riemann_integrable f a x))] : R->R := [x:R] Cases (total_order_Rle a x) of
- | (leftT r) => Cases (total_order_Rle x b) of
- | (leftT r0) => (RiemannInt (pr x r r0))
- | (rightT _) => ``(f b)*(x-b)+(RiemannInt (pr b h (FTC_P2 b)))`` end
- | (rightT _) => ``(f a)*(x-a)`` end.
-
-Lemma RiemannInt_P20 : (f:R->R;a,b:R;h:``a<=b``;pr:((x:R)``a<=x``->``x<=b``->(Riemann_integrable f a x));pr0:(Riemann_integrable f a b)) ``(RiemannInt pr0)==(primitive h pr b)-(primitive h pr a)``.
-Intros; Replace (primitive h pr a) with R0.
-Replace (RiemannInt pr0) with (primitive h pr b).
-Ring.
-Unfold primitive; Case (total_order_Rle a b); Case (total_order_Rle b b); Intros; [Apply RiemannInt_P5 | Elim n; Right; Reflexivity | Elim n; Assumption | Elim n0; Assumption].
-Symmetry; Unfold primitive; Case (total_order_Rle a a); Case (total_order_Rle a b); Intros; [Apply RiemannInt_P9 | Elim n; Assumption | Elim n; Right; Reflexivity | Elim n0; Right; Reflexivity].
+
+Definition primitive (f:R -> R) (a b:R) (h:a <= b)
+ (pr:forall x:R, a <= x -> x <= b -> Riemann_integrable f a x)
+ (x:R) : R :=
+ match Rle_dec a x with
+ | left r =>
+ match Rle_dec x b with
+ | left r0 => RiemannInt (pr x r r0)
+ | right _ => f b * (x - b) + RiemannInt (pr b h (Rle_refl b))
+ end
+ | right _ => f a * (x - a)
+ end.
+
+Lemma RiemannInt_P20 :
+ forall (f:R -> R) (a b:R) (h:a <= b)
+ (pr:forall x:R, a <= x -> x <= b -> Riemann_integrable f a x)
+ (pr0:Riemann_integrable f a b),
+ RiemannInt pr0 = primitive h pr b - primitive h pr a.
+intros; replace (primitive h pr a) with 0.
+replace (RiemannInt pr0) with (primitive h pr b).
+ring.
+unfold primitive in |- *; case (Rle_dec a b); case (Rle_dec b b); intros;
+ [ apply RiemannInt_P5
+ | elim n; right; reflexivity
+ | elim n; assumption
+ | elim n0; assumption ].
+symmetry in |- *; unfold primitive in |- *; case (Rle_dec a a);
+ case (Rle_dec a b); intros;
+ [ apply RiemannInt_P9
+ | elim n; assumption
+ | elim n; right; reflexivity
+ | elim n0; right; reflexivity ].
Qed.
-Lemma RiemannInt_P21 : (f:R->R;a,b,c:R) ``a<=b``-> ``b<=c`` -> (Riemann_integrable f a b) -> (Riemann_integrable f b c) -> (Riemann_integrable f a c).
-Unfold Riemann_integrable; Intros f a b c Hyp1 Hyp2 X X0 eps.
-Assert H : ``0<eps/2``.
-Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos eps) | Apply Rlt_Rinv; Sup0].
-Elim (X (mkposreal ? H)); Clear X; Intros phi1 [psi1 H1]; Elim (X0 (mkposreal ? H)); Clear X0; Intros phi2 [psi2 H2].
-Pose phi3 := [x:R] Cases (total_order_Rle a x) of
- | (leftT _) => Cases (total_order_Rle x b) of
- | (leftT _) => (phi1 x)
- | (rightT _) => (phi2 x) end
- | (rightT _) => R0 end.
-Pose psi3 := [x:R] Cases (total_order_Rle a x) of
- | (leftT _) => Cases (total_order_Rle x b) of
- | (leftT _) => (psi1 x)
- | (rightT _) => (psi2 x) end
- | (rightT _) => R0 end.
-Cut (IsStepFun phi3 a c).
-Intro; Cut (IsStepFun psi3 a b).
-Intro; Cut (IsStepFun psi3 b c).
-Intro; Cut (IsStepFun psi3 a c).
-Intro; Split with (mkStepFun X); Split with (mkStepFun X2); Simpl; Split.
-Intros; Unfold phi3 psi3; Case (total_order_Rle t b); Case (total_order_Rle a t); Intros.
-Elim H1; Intros; Apply H3.
-Replace (Rmin a b) with a.
-Replace (Rmax a b) with b.
-Split; Assumption.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Elim n; Replace a with (Rmin a c).
-Elim H0; Intros; Assumption.
-Unfold Rmin; Case (total_order_Rle a c); Intro; [Reflexivity | Elim n0; Apply Rle_trans with b; Assumption].
-Elim H2; Intros; Apply H3.
-Replace (Rmax b c) with (Rmax a c).
-Elim H0; Intros; Split; Try Assumption.
-Replace (Rmin b c) with b.
-Auto with real.
-Unfold Rmin; Case (total_order_Rle b c); Intro; [Reflexivity | Elim n0; Assumption].
-Unfold Rmax; Case (total_order_Rle a c); Case (total_order_Rle b c); Intros; Try (Elim n0; Assumption Orelse Elim n0; Apply Rle_trans with b; Assumption).
-Reflexivity.
-Elim n; Replace a with (Rmin a c).
-Elim H0; Intros; Assumption.
-Unfold Rmin; Case (total_order_Rle a c); Intro; [Reflexivity | Elim n1; Apply Rle_trans with b; Assumption].
-Rewrite <- (StepFun_P43 X0 X1 X2).
-Apply Rle_lt_trans with ``(Rabsolu (RiemannInt_SF (mkStepFun X0)))+(Rabsolu (RiemannInt_SF (mkStepFun X1)))``.
-Apply Rabsolu_triang.
-Rewrite (double_var eps); Replace (RiemannInt_SF (mkStepFun X0)) with (RiemannInt_SF psi1).
-Replace (RiemannInt_SF (mkStepFun X1)) with (RiemannInt_SF psi2).
-Apply Rplus_lt.
-Elim H1; Intros; Assumption.
-Elim H2; Intros; Assumption.
-Apply Rle_antisym.
-Apply StepFun_P37; Try Assumption.
-Simpl; Intros; Unfold psi3; Elim H0; Clear H0; Intros; Case (total_order_Rle a x); Case (total_order_Rle x b); Intros; [Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r H0)) | Right; Reflexivity | Elim n; Apply Rle_trans with b; [Assumption | Left; Assumption] | Elim n0; Apply Rle_trans with b; [Assumption | Left; Assumption]].
-Apply StepFun_P37; Try Assumption.
-Simpl; Intros; Unfold psi3; Elim H0; Clear H0; Intros; Case (total_order_Rle a x); Case (total_order_Rle x b); Intros; [Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r H0)) | Right; Reflexivity | Elim n; Apply Rle_trans with b; [Assumption | Left; Assumption] | Elim n0; Apply Rle_trans with b; [Assumption | Left; Assumption]].
-Apply Rle_antisym.
-Apply StepFun_P37; Try Assumption.
-Simpl; Intros; Unfold psi3; Elim H0; Clear H0; Intros; Case (total_order_Rle a x); Case (total_order_Rle x b); Intros; [Right; Reflexivity | Elim n; Left; Assumption | Elim n; Left; Assumption | Elim n0; Left; Assumption].
-Apply StepFun_P37; Try Assumption.
-Simpl; Intros; Unfold psi3; Elim H0; Clear H0; Intros; Case (total_order_Rle a x); Case (total_order_Rle x b); Intros; [Right; Reflexivity | Elim n; Left; Assumption | Elim n; Left; Assumption | Elim n0; Left; Assumption].
-Apply StepFun_P46 with b; Assumption.
-Assert H3 := (pre psi2); Unfold IsStepFun in H3; Unfold is_subdivision in H3; Elim H3; Clear H3; Intros l1 [lf1 H3]; Split with l1; Split with lf1; Unfold adapted_couple in H3; Decompose [and] H3; Clear H3; Unfold adapted_couple; Repeat Split; Try Assumption.
-Intros; Assert H9 := (H8 i H3); Unfold constant_D_eq open_interval; Unfold constant_D_eq open_interval in H9; Intros; Rewrite <- (H9 x H7); Unfold psi3; Assert H10 : ``b<x``.
-Apply Rle_lt_trans with (pos_Rl l1 i).
-Replace b with (Rmin b c).
-Rewrite <- H5; Elim (RList_P6 l1); Intros; Apply H10; Try Assumption.
-Apply le_O_n.
-Apply lt_trans with (pred (Rlength l1)); Try Assumption; Apply lt_pred_n_n; Apply neq_O_lt; Red; Intro; Rewrite <- H12 in H6; Discriminate.
-Unfold Rmin; Case (total_order_Rle b c); Intro; [Reflexivity | Elim n; Assumption].
-Elim H7; Intros; Assumption.
-Case (total_order_Rle a x); Case (total_order_Rle x b); Intros; [Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r H10)) | Reflexivity | Elim n; Apply Rle_trans with b; [Assumption | Left; Assumption] | Elim n0; Apply Rle_trans with b; [Assumption | Left; Assumption]].
-Assert H3 := (pre psi1); Unfold IsStepFun in H3; Unfold is_subdivision in H3; Elim H3; Clear H3; Intros l1 [lf1 H3]; Split with l1; Split with lf1; Unfold adapted_couple in H3; Decompose [and] H3; Clear H3; Unfold adapted_couple; Repeat Split; Try Assumption.
-Intros; Assert H9 := (H8 i H3); Unfold constant_D_eq open_interval; Unfold constant_D_eq open_interval in H9; Intros; Rewrite <- (H9 x H7); Unfold psi3; Assert H10 : ``x<=b``.
-Apply Rle_trans with (pos_Rl l1 (S i)).
-Elim H7; Intros; Left; Assumption.
-Replace b with (Rmax a b).
-Rewrite <- H4; Elim (RList_P6 l1); Intros; Apply H10; Try Assumption.
-Apply lt_pred_n_n; Apply neq_O_lt; Red; Intro; Rewrite <- H12 in H6; Discriminate.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Assert H11 : ``a<=x``.
-Apply Rle_trans with (pos_Rl l1 i).
-Replace a with (Rmin a b).
-Rewrite <- H5; Elim (RList_P6 l1); Intros; Apply H11; Try Assumption.
-Apply le_O_n.
-Apply lt_trans with (pred (Rlength l1)); Try Assumption; Apply lt_pred_n_n; Apply neq_O_lt; Red; Intro; Rewrite <- H13 in H6; Discriminate.
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Left; Elim H7; Intros; Assumption.
-Case (total_order_Rle a x); Case (total_order_Rle x b); Intros; Reflexivity Orelse Elim n; Assumption.
-Apply StepFun_P46 with b.
-Assert H3 := (pre phi1); Unfold IsStepFun in H3; Unfold is_subdivision in H3; Elim H3; Clear H3; Intros l1 [lf1 H3]; Split with l1; Split with lf1; Unfold adapted_couple in H3; Decompose [and] H3; Clear H3; Unfold adapted_couple; Repeat Split; Try Assumption.
-Intros; Assert H9 := (H8 i H3); Unfold constant_D_eq open_interval; Unfold constant_D_eq open_interval in H9; Intros; Rewrite <- (H9 x H7); Unfold psi3; Assert H10 : ``x<=b``.
-Apply Rle_trans with (pos_Rl l1 (S i)).
-Elim H7; Intros; Left; Assumption.
-Replace b with (Rmax a b).
-Rewrite <- H4; Elim (RList_P6 l1); Intros; Apply H10; Try Assumption.
-Apply lt_pred_n_n; Apply neq_O_lt; Red; Intro; Rewrite <- H12 in H6; Discriminate.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Assert H11 : ``a<=x``.
-Apply Rle_trans with (pos_Rl l1 i).
-Replace a with (Rmin a b).
-Rewrite <- H5; Elim (RList_P6 l1); Intros; Apply H11; Try Assumption.
-Apply le_O_n.
-Apply lt_trans with (pred (Rlength l1)); Try Assumption; Apply lt_pred_n_n; Apply neq_O_lt; Red; Intro; Rewrite <- H13 in H6; Discriminate.
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Left; Elim H7; Intros; Assumption.
-Unfold phi3; Case (total_order_Rle a x); Case (total_order_Rle x b); Intros; Reflexivity Orelse Elim n; Assumption.
-Assert H3 := (pre phi2); Unfold IsStepFun in H3; Unfold is_subdivision in H3; Elim H3; Clear H3; Intros l1 [lf1 H3]; Split with l1; Split with lf1; Unfold adapted_couple in H3; Decompose [and] H3; Clear H3; Unfold adapted_couple; Repeat Split; Try Assumption.
-Intros; Assert H9 := (H8 i H3); Unfold constant_D_eq open_interval; Unfold constant_D_eq open_interval in H9; Intros; Rewrite <- (H9 x H7); Unfold psi3; Assert H10 : ``b<x``.
-Apply Rle_lt_trans with (pos_Rl l1 i).
-Replace b with (Rmin b c).
-Rewrite <- H5; Elim (RList_P6 l1); Intros; Apply H10; Try Assumption.
-Apply le_O_n.
-Apply lt_trans with (pred (Rlength l1)); Try Assumption; Apply lt_pred_n_n; Apply neq_O_lt; Red; Intro; Rewrite <- H12 in H6; Discriminate.
-Unfold Rmin; Case (total_order_Rle b c); Intro; [Reflexivity | Elim n; Assumption].
-Elim H7; Intros; Assumption.
-Unfold phi3; Case (total_order_Rle a x); Case (total_order_Rle x b); Intros; [Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r H10)) | Reflexivity | Elim n; Apply Rle_trans with b; [Assumption | Left; Assumption] | Elim n0; Apply Rle_trans with b; [Assumption | Left; Assumption]].
+Lemma RiemannInt_P21 :
+ forall (f:R -> R) (a b c:R),
+ a <= b ->
+ b <= c ->
+ Riemann_integrable f a b ->
+ Riemann_integrable f b c -> Riemann_integrable f a c.
+unfold Riemann_integrable in |- *; intros f a b c Hyp1 Hyp2 X X0 eps.
+assert (H : 0 < eps / 2).
+unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ apply (cond_pos eps) | apply Rinv_0_lt_compat; prove_sup0 ].
+elim (X (mkposreal _ H)); clear X; intros phi1 [psi1 H1];
+ elim (X0 (mkposreal _ H)); clear X0; intros phi2 [psi2 H2].
+pose
+ (phi3 :=
+ fun x:R =>
+ match Rle_dec a x with
+ | left _ =>
+ match Rle_dec x b with
+ | left _ => phi1 x
+ | right _ => phi2 x
+ end
+ | right _ => 0
+ end).
+pose
+ (psi3 :=
+ fun x:R =>
+ match Rle_dec a x with
+ | left _ =>
+ match Rle_dec x b with
+ | left _ => psi1 x
+ | right _ => psi2 x
+ end
+ | right _ => 0
+ end).
+cut (IsStepFun phi3 a c).
+intro; cut (IsStepFun psi3 a b).
+intro; cut (IsStepFun psi3 b c).
+intro; cut (IsStepFun psi3 a c).
+intro; split with (mkStepFun X); split with (mkStepFun X2); simpl in |- *;
+ split.
+intros; unfold phi3, psi3 in |- *; case (Rle_dec t b); case (Rle_dec a t);
+ intros.
+elim H1; intros; apply H3.
+replace (Rmin a b) with a.
+replace (Rmax a b) with b.
+split; assumption.
+unfold Rmax in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n; assumption ].
+unfold Rmin in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n; assumption ].
+elim n; replace a with (Rmin a c).
+elim H0; intros; assumption.
+unfold Rmin in |- *; case (Rle_dec a c); intro;
+ [ reflexivity | elim n0; apply Rle_trans with b; assumption ].
+elim H2; intros; apply H3.
+replace (Rmax b c) with (Rmax a c).
+elim H0; intros; split; try assumption.
+replace (Rmin b c) with b.
+auto with real.
+unfold Rmin in |- *; case (Rle_dec b c); intro;
+ [ reflexivity | elim n0; assumption ].
+unfold Rmax in |- *; case (Rle_dec a c); case (Rle_dec b c); intros;
+ try (elim n0; assumption || elim n0; apply Rle_trans with b; assumption).
+reflexivity.
+elim n; replace a with (Rmin a c).
+elim H0; intros; assumption.
+unfold Rmin in |- *; case (Rle_dec a c); intro;
+ [ reflexivity | elim n1; apply Rle_trans with b; assumption ].
+rewrite <- (StepFun_P43 X0 X1 X2).
+apply Rle_lt_trans with
+ (Rabs (RiemannInt_SF (mkStepFun X0)) + Rabs (RiemannInt_SF (mkStepFun X1))).
+apply Rabs_triang.
+rewrite (double_var eps);
+ replace (RiemannInt_SF (mkStepFun X0)) with (RiemannInt_SF psi1).
+replace (RiemannInt_SF (mkStepFun X1)) with (RiemannInt_SF psi2).
+apply Rplus_lt_compat.
+elim H1; intros; assumption.
+elim H2; intros; assumption.
+apply Rle_antisym.
+apply StepFun_P37; try assumption.
+simpl in |- *; intros; unfold psi3 in |- *; elim H0; clear H0; intros;
+ case (Rle_dec a x); case (Rle_dec x b); intros;
+ [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H0))
+ | right; reflexivity
+ | elim n; apply Rle_trans with b; [ assumption | left; assumption ]
+ | elim n0; apply Rle_trans with b; [ assumption | left; assumption ] ].
+apply StepFun_P37; try assumption.
+simpl in |- *; intros; unfold psi3 in |- *; elim H0; clear H0; intros;
+ case (Rle_dec a x); case (Rle_dec x b); intros;
+ [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H0))
+ | right; reflexivity
+ | elim n; apply Rle_trans with b; [ assumption | left; assumption ]
+ | elim n0; apply Rle_trans with b; [ assumption | left; assumption ] ].
+apply Rle_antisym.
+apply StepFun_P37; try assumption.
+simpl in |- *; intros; unfold psi3 in |- *; elim H0; clear H0; intros;
+ case (Rle_dec a x); case (Rle_dec x b); intros;
+ [ right; reflexivity
+ | elim n; left; assumption
+ | elim n; left; assumption
+ | elim n0; left; assumption ].
+apply StepFun_P37; try assumption.
+simpl in |- *; intros; unfold psi3 in |- *; elim H0; clear H0; intros;
+ case (Rle_dec a x); case (Rle_dec x b); intros;
+ [ right; reflexivity
+ | elim n; left; assumption
+ | elim n; left; assumption
+ | elim n0; left; assumption ].
+apply StepFun_P46 with b; assumption.
+assert (H3 := pre psi2); unfold IsStepFun in H3; unfold is_subdivision in H3;
+ elim H3; clear H3; intros l1 [lf1 H3]; split with l1;
+ split with lf1; unfold adapted_couple in H3; decompose [and] H3;
+ clear H3; unfold adapted_couple in |- *; repeat split;
+ try assumption.
+intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval in |- *;
+ unfold constant_D_eq, open_interval in H9; intros;
+ rewrite <- (H9 x H7); unfold psi3 in |- *; assert (H10 : b < x).
+apply Rle_lt_trans with (pos_Rl l1 i).
+replace b with (Rmin b c).
+rewrite <- H5; elim (RList_P6 l1); intros; apply H10; try assumption.
+apply le_O_n.
+apply lt_trans with (pred (Rlength l1)); try assumption; apply lt_pred_n_n;
+ apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H6;
+ discriminate.
+unfold Rmin in |- *; case (Rle_dec b c); intro;
+ [ reflexivity | elim n; assumption ].
+elim H7; intros; assumption.
+case (Rle_dec a x); case (Rle_dec x b); intros;
+ [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H10))
+ | reflexivity
+ | elim n; apply Rle_trans with b; [ assumption | left; assumption ]
+ | elim n0; apply Rle_trans with b; [ assumption | left; assumption ] ].
+assert (H3 := pre psi1); unfold IsStepFun in H3; unfold is_subdivision in H3;
+ elim H3; clear H3; intros l1 [lf1 H3]; split with l1;
+ split with lf1; unfold adapted_couple in H3; decompose [and] H3;
+ clear H3; unfold adapted_couple in |- *; repeat split;
+ try assumption.
+intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval in |- *;
+ unfold constant_D_eq, open_interval in H9; intros;
+ rewrite <- (H9 x H7); unfold psi3 in |- *; assert (H10 : x <= b).
+apply Rle_trans with (pos_Rl l1 (S i)).
+elim H7; intros; left; assumption.
+replace b with (Rmax a b).
+rewrite <- H4; elim (RList_P6 l1); intros; apply H10; try assumption.
+apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H6;
+ discriminate.
+unfold Rmax in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n; assumption ].
+assert (H11 : a <= x).
+apply Rle_trans with (pos_Rl l1 i).
+replace a with (Rmin a b).
+rewrite <- H5; elim (RList_P6 l1); intros; apply H11; try assumption.
+apply le_O_n.
+apply lt_trans with (pred (Rlength l1)); try assumption; apply lt_pred_n_n;
+ apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H6;
+ discriminate.
+unfold Rmin in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n; assumption ].
+left; elim H7; intros; assumption.
+case (Rle_dec a x); case (Rle_dec x b); intros; reflexivity || elim n;
+ assumption.
+apply StepFun_P46 with b.
+assert (H3 := pre phi1); unfold IsStepFun in H3; unfold is_subdivision in H3;
+ elim H3; clear H3; intros l1 [lf1 H3]; split with l1;
+ split with lf1; unfold adapted_couple in H3; decompose [and] H3;
+ clear H3; unfold adapted_couple in |- *; repeat split;
+ try assumption.
+intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval in |- *;
+ unfold constant_D_eq, open_interval in H9; intros;
+ rewrite <- (H9 x H7); unfold psi3 in |- *; assert (H10 : x <= b).
+apply Rle_trans with (pos_Rl l1 (S i)).
+elim H7; intros; left; assumption.
+replace b with (Rmax a b).
+rewrite <- H4; elim (RList_P6 l1); intros; apply H10; try assumption.
+apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H6;
+ discriminate.
+unfold Rmax in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n; assumption ].
+assert (H11 : a <= x).
+apply Rle_trans with (pos_Rl l1 i).
+replace a with (Rmin a b).
+rewrite <- H5; elim (RList_P6 l1); intros; apply H11; try assumption.
+apply le_O_n.
+apply lt_trans with (pred (Rlength l1)); try assumption; apply lt_pred_n_n;
+ apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H6;
+ discriminate.
+unfold Rmin in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n; assumption ].
+left; elim H7; intros; assumption.
+unfold phi3 in |- *; case (Rle_dec a x); case (Rle_dec x b); intros;
+ reflexivity || elim n; assumption.
+assert (H3 := pre phi2); unfold IsStepFun in H3; unfold is_subdivision in H3;
+ elim H3; clear H3; intros l1 [lf1 H3]; split with l1;
+ split with lf1; unfold adapted_couple in H3; decompose [and] H3;
+ clear H3; unfold adapted_couple in |- *; repeat split;
+ try assumption.
+intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval in |- *;
+ unfold constant_D_eq, open_interval in H9; intros;
+ rewrite <- (H9 x H7); unfold psi3 in |- *; assert (H10 : b < x).
+apply Rle_lt_trans with (pos_Rl l1 i).
+replace b with (Rmin b c).
+rewrite <- H5; elim (RList_P6 l1); intros; apply H10; try assumption.
+apply le_O_n.
+apply lt_trans with (pred (Rlength l1)); try assumption; apply lt_pred_n_n;
+ apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H6;
+ discriminate.
+unfold Rmin in |- *; case (Rle_dec b c); intro;
+ [ reflexivity | elim n; assumption ].
+elim H7; intros; assumption.
+unfold phi3 in |- *; case (Rle_dec a x); case (Rle_dec x b); intros;
+ [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H10))
+ | reflexivity
+ | elim n; apply Rle_trans with b; [ assumption | left; assumption ]
+ | elim n0; apply Rle_trans with b; [ assumption | left; assumption ] ].
Qed.
-Lemma RiemannInt_P22 : (f:R->R;a,b,c:R) (Riemann_integrable f a b) -> ``a<=c<=b`` -> (Riemann_integrable f a c).
-Unfold Riemann_integrable; Intros; Elim (X eps); Clear X; Intros phi [psi H0]; Elim H; Elim H0; Clear H H0; Intros; Assert H3 : (IsStepFun phi a c).
-Apply StepFun_P44 with b.
-Apply (pre phi).
-Split; Assumption.
-Assert H4 : (IsStepFun psi a c).
-Apply StepFun_P44 with b.
-Apply (pre psi).
-Split; Assumption.
-Split with (mkStepFun H3); Split with (mkStepFun H4); Split.
-Simpl; Intros; Apply H.
-Replace (Rmin a b) with (Rmin a c).
-Elim H5; Intros; Split; Try Assumption.
-Apply Rle_trans with (Rmax a c); Try Assumption.
-Replace (Rmax a b) with b.
-Replace (Rmax a c) with c.
-Assumption.
-Unfold Rmax; Case (total_order_Rle a c); Intro; [Reflexivity | Elim n; Assumption].
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption].
-Unfold Rmin; Case (total_order_Rle a c); Case (total_order_Rle a b); Intros; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption | Elim n; Assumption | Elim n0; Assumption].
-Rewrite Rabsolu_right.
-Assert H5 : (IsStepFun psi c b).
-Apply StepFun_P46 with a.
-Apply StepFun_P6; Assumption.
-Apply (pre psi).
-Replace (RiemannInt_SF (mkStepFun H4)) with ``(RiemannInt_SF psi)-(RiemannInt_SF (mkStepFun H5))``.
-Apply Rle_lt_trans with (RiemannInt_SF psi).
-Unfold Rminus; Pattern 2 (RiemannInt_SF psi); Rewrite <- Rplus_Or; Apply Rle_compatibility; Rewrite <- Ropp_O; Apply Rge_Ropp; Apply Rle_sym1; Replace R0 with (RiemannInt_SF (mkStepFun (StepFun_P4 c b R0))).
-Apply StepFun_P37; Try Assumption.
-Intros; Simpl; Unfold fct_cte; Apply Rle_trans with ``(Rabsolu ((f x)-(phi x)))``.
-Apply Rabsolu_pos.
-Apply H.
-Replace (Rmin a b) with a.
-Replace (Rmax a b) with b.
-Elim H6; Intros; Split; Left.
-Apply Rle_lt_trans with c; Assumption.
-Assumption.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption].
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption].
-Rewrite StepFun_P18; Ring.
-Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF psi)).
-Apply Rle_Rabsolu.
-Assumption.
-Assert H6 : (IsStepFun psi a b).
-Apply (pre psi).
-Replace (RiemannInt_SF psi) with (RiemannInt_SF (mkStepFun H6)).
-Rewrite <- (StepFun_P43 H4 H5 H6); Ring.
-Unfold RiemannInt_SF; Case (total_order_Rle a b); Intro.
-EApply StepFun_P17.
-Apply StepFun_P1.
-Simpl; Apply StepFun_P1.
-Apply eq_Ropp; EApply StepFun_P17.
-Apply StepFun_P1.
-Simpl; Apply StepFun_P1.
-Apply Rle_sym1; Replace R0 with (RiemannInt_SF (mkStepFun (StepFun_P4 a c R0))).
-Apply StepFun_P37; Try Assumption.
-Intros; Simpl; Unfold fct_cte; Apply Rle_trans with ``(Rabsolu ((f x)-(phi x)))``.
-Apply Rabsolu_pos.
-Apply H.
-Replace (Rmin a b) with a.
-Replace (Rmax a b) with b.
-Elim H5; Intros; Split; Left.
-Assumption.
-Apply Rlt_le_trans with c; Assumption.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption].
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption].
-Rewrite StepFun_P18; Ring.
+Lemma RiemannInt_P22 :
+ forall (f:R -> R) (a b c:R),
+ Riemann_integrable f a b -> a <= c <= b -> Riemann_integrable f a c.
+unfold Riemann_integrable in |- *; intros; elim (X eps); clear X;
+ intros phi [psi H0]; elim H; elim H0; clear H H0;
+ intros; assert (H3 : IsStepFun phi a c).
+apply StepFun_P44 with b.
+apply (pre phi).
+split; assumption.
+assert (H4 : IsStepFun psi a c).
+apply StepFun_P44 with b.
+apply (pre psi).
+split; assumption.
+split with (mkStepFun H3); split with (mkStepFun H4); split.
+simpl in |- *; intros; apply H.
+replace (Rmin a b) with (Rmin a c).
+elim H5; intros; split; try assumption.
+apply Rle_trans with (Rmax a c); try assumption.
+replace (Rmax a b) with b.
+replace (Rmax a c) with c.
+assumption.
+unfold Rmax in |- *; case (Rle_dec a c); intro;
+ [ reflexivity | elim n; assumption ].
+unfold Rmax in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n; apply Rle_trans with c; assumption ].
+unfold Rmin in |- *; case (Rle_dec a c); case (Rle_dec a b); intros;
+ [ reflexivity
+ | elim n; apply Rle_trans with c; assumption
+ | elim n; assumption
+ | elim n0; assumption ].
+rewrite Rabs_right.
+assert (H5 : IsStepFun psi c b).
+apply StepFun_P46 with a.
+apply StepFun_P6; assumption.
+apply (pre psi).
+replace (RiemannInt_SF (mkStepFun H4)) with
+ (RiemannInt_SF psi - RiemannInt_SF (mkStepFun H5)).
+apply Rle_lt_trans with (RiemannInt_SF psi).
+unfold Rminus in |- *; pattern (RiemannInt_SF psi) at 2 in |- *;
+ rewrite <- Rplus_0_r; apply Rplus_le_compat_l; rewrite <- Ropp_0;
+ apply Ropp_ge_le_contravar; apply Rle_ge;
+ replace 0 with (RiemannInt_SF (mkStepFun (StepFun_P4 c b 0))).
+apply StepFun_P37; try assumption.
+intros; simpl in |- *; unfold fct_cte in |- *;
+ apply Rle_trans with (Rabs (f x - phi x)).
+apply Rabs_pos.
+apply H.
+replace (Rmin a b) with a.
+replace (Rmax a b) with b.
+elim H6; intros; split; left.
+apply Rle_lt_trans with c; assumption.
+assumption.
+unfold Rmax in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n; apply Rle_trans with c; assumption ].
+unfold Rmin in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n; apply Rle_trans with c; assumption ].
+rewrite StepFun_P18; ring.
+apply Rle_lt_trans with (Rabs (RiemannInt_SF psi)).
+apply RRle_abs.
+assumption.
+assert (H6 : IsStepFun psi a b).
+apply (pre psi).
+replace (RiemannInt_SF psi) with (RiemannInt_SF (mkStepFun H6)).
+rewrite <- (StepFun_P43 H4 H5 H6); ring.
+unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro.
+eapply StepFun_P17.
+apply StepFun_P1.
+simpl in |- *; apply StepFun_P1.
+apply Ropp_eq_compat; eapply StepFun_P17.
+apply StepFun_P1.
+simpl in |- *; apply StepFun_P1.
+apply Rle_ge; replace 0 with (RiemannInt_SF (mkStepFun (StepFun_P4 a c 0))).
+apply StepFun_P37; try assumption.
+intros; simpl in |- *; unfold fct_cte in |- *;
+ apply Rle_trans with (Rabs (f x - phi x)).
+apply Rabs_pos.
+apply H.
+replace (Rmin a b) with a.
+replace (Rmax a b) with b.
+elim H5; intros; split; left.
+assumption.
+apply Rlt_le_trans with c; assumption.
+unfold Rmax in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n; apply Rle_trans with c; assumption ].
+unfold Rmin in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n; apply Rle_trans with c; assumption ].
+rewrite StepFun_P18; ring.
Qed.
-Lemma RiemannInt_P23 : (f:R->R;a,b,c:R) (Riemann_integrable f a b) -> ``a<=c<=b`` -> (Riemann_integrable f c b).
-Unfold Riemann_integrable; Intros; Elim (X eps); Clear X; Intros phi [psi H0]; Elim H; Elim H0; Clear H H0; Intros; Assert H3 : (IsStepFun phi c b).
-Apply StepFun_P45 with a.
-Apply (pre phi).
-Split; Assumption.
-Assert H4 : (IsStepFun psi c b).
-Apply StepFun_P45 with a.
-Apply (pre psi).
-Split; Assumption.
-Split with (mkStepFun H3); Split with (mkStepFun H4); Split.
-Simpl; Intros; Apply H.
-Replace (Rmax a b) with (Rmax c b).
-Elim H5; Intros; Split; Try Assumption.
-Apply Rle_trans with (Rmin c b); Try Assumption.
-Replace (Rmin a b) with a.
-Replace (Rmin c b) with c.
-Assumption.
-Unfold Rmin; Case (total_order_Rle c b); Intro; [Reflexivity | Elim n; Assumption].
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption].
-Unfold Rmax; Case (total_order_Rle c b); Case (total_order_Rle a b); Intros; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption | Elim n; Assumption | Elim n0; Assumption].
-Rewrite Rabsolu_right.
-Assert H5 : (IsStepFun psi a c).
-Apply StepFun_P46 with b.
-Apply (pre psi).
-Apply StepFun_P6; Assumption.
-Replace (RiemannInt_SF (mkStepFun H4)) with ``(RiemannInt_SF psi)-(RiemannInt_SF (mkStepFun H5))``.
-Apply Rle_lt_trans with (RiemannInt_SF psi).
-Unfold Rminus; Pattern 2 (RiemannInt_SF psi); Rewrite <- Rplus_Or; Apply Rle_compatibility; Rewrite <- Ropp_O; Apply Rge_Ropp; Apply Rle_sym1; Replace R0 with (RiemannInt_SF (mkStepFun (StepFun_P4 a c R0))).
-Apply StepFun_P37; Try Assumption.
-Intros; Simpl; Unfold fct_cte; Apply Rle_trans with ``(Rabsolu ((f x)-(phi x)))``.
-Apply Rabsolu_pos.
-Apply H.
-Replace (Rmin a b) with a.
-Replace (Rmax a b) with b.
-Elim H6; Intros; Split; Left.
-Assumption.
-Apply Rlt_le_trans with c; Assumption.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption].
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption].
-Rewrite StepFun_P18; Ring.
-Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF psi)).
-Apply Rle_Rabsolu.
-Assumption.
-Assert H6 : (IsStepFun psi a b).
-Apply (pre psi).
-Replace (RiemannInt_SF psi) with (RiemannInt_SF (mkStepFun H6)).
-Rewrite <- (StepFun_P43 H5 H4 H6); Ring.
-Unfold RiemannInt_SF; Case (total_order_Rle a b); Intro.
-EApply StepFun_P17.
-Apply StepFun_P1.
-Simpl; Apply StepFun_P1.
-Apply eq_Ropp; EApply StepFun_P17.
-Apply StepFun_P1.
-Simpl; Apply StepFun_P1.
-Apply Rle_sym1; Replace R0 with (RiemannInt_SF (mkStepFun (StepFun_P4 c b R0))).
-Apply StepFun_P37; Try Assumption.
-Intros; Simpl; Unfold fct_cte; Apply Rle_trans with ``(Rabsolu ((f x)-(phi x)))``.
-Apply Rabsolu_pos.
-Apply H.
-Replace (Rmin a b) with a.
-Replace (Rmax a b) with b.
-Elim H5; Intros; Split; Left.
-Apply Rle_lt_trans with c; Assumption.
-Assumption.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption].
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption].
-Rewrite StepFun_P18; Ring.
+Lemma RiemannInt_P23 :
+ forall (f:R -> R) (a b c:R),
+ Riemann_integrable f a b -> a <= c <= b -> Riemann_integrable f c b.
+unfold Riemann_integrable in |- *; intros; elim (X eps); clear X;
+ intros phi [psi H0]; elim H; elim H0; clear H H0;
+ intros; assert (H3 : IsStepFun phi c b).
+apply StepFun_P45 with a.
+apply (pre phi).
+split; assumption.
+assert (H4 : IsStepFun psi c b).
+apply StepFun_P45 with a.
+apply (pre psi).
+split; assumption.
+split with (mkStepFun H3); split with (mkStepFun H4); split.
+simpl in |- *; intros; apply H.
+replace (Rmax a b) with (Rmax c b).
+elim H5; intros; split; try assumption.
+apply Rle_trans with (Rmin c b); try assumption.
+replace (Rmin a b) with a.
+replace (Rmin c b) with c.
+assumption.
+unfold Rmin in |- *; case (Rle_dec c b); intro;
+ [ reflexivity | elim n; assumption ].
+unfold Rmin in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n; apply Rle_trans with c; assumption ].
+unfold Rmax in |- *; case (Rle_dec c b); case (Rle_dec a b); intros;
+ [ reflexivity
+ | elim n; apply Rle_trans with c; assumption
+ | elim n; assumption
+ | elim n0; assumption ].
+rewrite Rabs_right.
+assert (H5 : IsStepFun psi a c).
+apply StepFun_P46 with b.
+apply (pre psi).
+apply StepFun_P6; assumption.
+replace (RiemannInt_SF (mkStepFun H4)) with
+ (RiemannInt_SF psi - RiemannInt_SF (mkStepFun H5)).
+apply Rle_lt_trans with (RiemannInt_SF psi).
+unfold Rminus in |- *; pattern (RiemannInt_SF psi) at 2 in |- *;
+ rewrite <- Rplus_0_r; apply Rplus_le_compat_l; rewrite <- Ropp_0;
+ apply Ropp_ge_le_contravar; apply Rle_ge;
+ replace 0 with (RiemannInt_SF (mkStepFun (StepFun_P4 a c 0))).
+apply StepFun_P37; try assumption.
+intros; simpl in |- *; unfold fct_cte in |- *;
+ apply Rle_trans with (Rabs (f x - phi x)).
+apply Rabs_pos.
+apply H.
+replace (Rmin a b) with a.
+replace (Rmax a b) with b.
+elim H6; intros; split; left.
+assumption.
+apply Rlt_le_trans with c; assumption.
+unfold Rmax in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n; apply Rle_trans with c; assumption ].
+unfold Rmin in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n; apply Rle_trans with c; assumption ].
+rewrite StepFun_P18; ring.
+apply Rle_lt_trans with (Rabs (RiemannInt_SF psi)).
+apply RRle_abs.
+assumption.
+assert (H6 : IsStepFun psi a b).
+apply (pre psi).
+replace (RiemannInt_SF psi) with (RiemannInt_SF (mkStepFun H6)).
+rewrite <- (StepFun_P43 H5 H4 H6); ring.
+unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro.
+eapply StepFun_P17.
+apply StepFun_P1.
+simpl in |- *; apply StepFun_P1.
+apply Ropp_eq_compat; eapply StepFun_P17.
+apply StepFun_P1.
+simpl in |- *; apply StepFun_P1.
+apply Rle_ge; replace 0 with (RiemannInt_SF (mkStepFun (StepFun_P4 c b 0))).
+apply StepFun_P37; try assumption.
+intros; simpl in |- *; unfold fct_cte in |- *;
+ apply Rle_trans with (Rabs (f x - phi x)).
+apply Rabs_pos.
+apply H.
+replace (Rmin a b) with a.
+replace (Rmax a b) with b.
+elim H5; intros; split; left.
+apply Rle_lt_trans with c; assumption.
+assumption.
+unfold Rmax in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n; apply Rle_trans with c; assumption ].
+unfold Rmin in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n; apply Rle_trans with c; assumption ].
+rewrite StepFun_P18; ring.
Qed.
-Lemma RiemannInt_P24 : (f:R->R;a,b,c:R) (Riemann_integrable f a b) -> (Riemann_integrable f b c) -> (Riemann_integrable f a c).
-Intros; Case (total_order_Rle a b); Case (total_order_Rle b c); Intros.
-Apply RiemannInt_P21 with b; Assumption.
-Case (total_order_Rle a c); Intro.
-Apply RiemannInt_P22 with b; Try Assumption.
-Split; [Assumption | Auto with real].
-Apply RiemannInt_P1; Apply RiemannInt_P22 with b.
-Apply RiemannInt_P1; Assumption.
-Split; Auto with real.
-Case (total_order_Rle a c); Intro.
-Apply RiemannInt_P23 with b; Try Assumption.
-Split; Auto with real.
-Apply RiemannInt_P1; Apply RiemannInt_P23 with b.
-Apply RiemannInt_P1; Assumption.
-Split; [Assumption | Auto with real].
-Apply RiemannInt_P1; Apply RiemannInt_P21 with b; Auto with real Orelse Apply RiemannInt_P1; Assumption.
+Lemma RiemannInt_P24 :
+ forall (f:R -> R) (a b c:R),
+ Riemann_integrable f a b ->
+ Riemann_integrable f b c -> Riemann_integrable f a c.
+intros; case (Rle_dec a b); case (Rle_dec b c); intros.
+apply RiemannInt_P21 with b; assumption.
+case (Rle_dec a c); intro.
+apply RiemannInt_P22 with b; try assumption.
+split; [ assumption | auto with real ].
+apply RiemannInt_P1; apply RiemannInt_P22 with b.
+apply RiemannInt_P1; assumption.
+split; auto with real.
+case (Rle_dec a c); intro.
+apply RiemannInt_P23 with b; try assumption.
+split; auto with real.
+apply RiemannInt_P1; apply RiemannInt_P23 with b.
+apply RiemannInt_P1; assumption.
+split; [ assumption | auto with real ].
+apply RiemannInt_P1; apply RiemannInt_P21 with b;
+ auto with real || apply RiemannInt_P1; assumption.
Qed.
-Lemma RiemannInt_P25 : (f:R->R;a,b,c:R;pr1:(Riemann_integrable f a b);pr2:(Riemann_integrable f b c);pr3:(Riemann_integrable f a c)) ``a<=b``->``b<=c``->``(RiemannInt pr1)+(RiemannInt pr2)==(RiemannInt pr3)``.
-Intros f a b c pr1 pr2 pr3 Hyp1 Hyp2; Unfold RiemannInt; Case (RiemannInt_exists 1!f 2!a 3!b pr1 5!RinvN RinvN_cv); Case (RiemannInt_exists 1!f 2!b 3!c pr2 5!RinvN RinvN_cv); Case (RiemannInt_exists 1!f 2!a 3!c pr3 5!RinvN RinvN_cv); Intros; Symmetry; EApply UL_sequence.
-Apply u.
-Unfold Un_cv; Intros; Assert H0 : ``0<eps/3``.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
-Elim (u1 ? H0); Clear u1; Intros N1 H1; Elim (u0 ? H0); Clear u0; Intros N2 H2; Cut (Un_cv [n:nat]``(RiemannInt_SF [(phi_sequence RinvN pr3 n)])-((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+(RiemannInt_SF [(phi_sequence RinvN pr2 n)]))`` R0).
-Intro; Elim (H3 ? H0); Clear H3; Intros N3 H3; Pose N0 := (max (max N1 N2) N3); Exists N0; Intros; Unfold R_dist; Apply Rle_lt_trans with ``(Rabsolu ((RiemannInt_SF [(phi_sequence RinvN pr3 n)])-((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+(RiemannInt_SF [(phi_sequence RinvN pr2 n)]))))+(Rabsolu (((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+(RiemannInt_SF [(phi_sequence RinvN pr2 n)]))-(x1+x0)))``.
-Replace ``(RiemannInt_SF [(phi_sequence RinvN pr3 n)])-(x1+x0)`` with ``((RiemannInt_SF [(phi_sequence RinvN pr3 n)])-((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+(RiemannInt_SF [(phi_sequence RinvN pr2 n)])))+(((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+(RiemannInt_SF [(phi_sequence RinvN pr2 n)]))-(x1+x0))``; [Apply Rabsolu_triang | Ring].
-Replace eps with ``eps/3+eps/3+eps/3``.
-Rewrite Rplus_assoc; Apply Rplus_lt.
-Unfold R_dist in H3; Cut (ge n N3).
-Intro; Assert H6 := (H3 ? H5); Unfold Rminus in H6; Rewrite Ropp_O in H6; Rewrite Rplus_Or in H6; Apply H6.
-Unfold ge; Apply le_trans with N0; [Unfold N0; Apply le_max_r | Assumption].
-Apply Rle_lt_trans with ``(Rabsolu ((RiemannInt_SF [(phi_sequence RinvN pr1 n)])-x1))+(Rabsolu ((RiemannInt_SF [(phi_sequence RinvN pr2 n)])-x0))``.
-Replace ``((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+(RiemannInt_SF [(phi_sequence RinvN pr2 n)]))-(x1+x0)`` with ``((RiemannInt_SF [(phi_sequence RinvN pr1 n)])-x1)+((RiemannInt_SF [(phi_sequence RinvN pr2 n)])-x0)``; [Apply Rabsolu_triang | Ring].
-Apply Rplus_lt.
-Unfold R_dist in H1; Apply H1.
-Unfold ge; Apply le_trans with N0; [Apply le_trans with (max N1 N2); [Apply le_max_l | Unfold N0; Apply le_max_l] | Assumption].
-Unfold R_dist in H2; Apply H2.
-Unfold ge; Apply le_trans with N0; [Apply le_trans with (max N1 N2); [Apply le_max_r | Unfold N0; Apply le_max_l] | Assumption].
-Apply r_Rmult_mult with ``3``; [Unfold Rdiv; Repeat Rewrite Rmult_Rplus_distr; Do 2 Rewrite (Rmult_sym ``3``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Ring | DiscrR] | DiscrR].
-Clear x u x0 x1 eps H H0 N1 H1 N2 H2; Assert H1 : (EXT psi1:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((f t)-([(phi_sequence RinvN pr1 n)] t)))<= (psi1 n t)``)/\``(Rabsolu (RiemannInt_SF (psi1 n))) < (RinvN n)``).
-Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr1 n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr1 n)).
-Assert H2 : (EXT psi2:nat->(StepFun b c) | (n:nat) ((t:R)``(Rmin b c) <= t``/\``t <= (Rmax b c)``->``(Rabsolu ((f t)-([(phi_sequence RinvN pr2 n)] t)))<= (psi2 n t)``)/\``(Rabsolu (RiemannInt_SF (psi2 n))) < (RinvN n)``).
-Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr2 n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr2 n)).
-Assert H3 : (EXT psi3:nat->(StepFun a c) | (n:nat) ((t:R)``(Rmin a c) <= t``/\``t <= (Rmax a c)``->``(Rabsolu ((f t)-([(phi_sequence RinvN pr3 n)] t)))<= (psi3 n t)``)/\``(Rabsolu (RiemannInt_SF (psi3 n))) < (RinvN n)``).
-Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr3 n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr3 n)).
-Elim H1; Clear H1; Intros psi1 H1; Elim H2; Clear H2; Intros psi2 H2; Elim H3; Clear H3; Intros psi3 H3; Assert H := RinvN_cv; Unfold Un_cv; Intros; Assert H4 : ``0<eps/3``.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
-Elim (H ? H4); Clear H; Intros N0 H; Assert H5 : (n:nat)(ge n N0)->``(RinvN n)<eps/3``.
-Intros; Replace (pos (RinvN n)) with ``(R_dist (mkposreal (/((INR n)+1)) (RinvN_pos n)) 0)``.
-Apply H; Assumption.
-Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right; Apply Rle_sym1; Left; Apply (cond_pos (RinvN n)).
-Exists N0; Intros; Elim (H1 n); Elim (H2 n); Elim (H3 n); Clear H1 H2 H3; Intros; Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Pose phi1 := (phi_sequence RinvN pr1 n); Fold phi1 in H8; Pose phi2 := (phi_sequence RinvN pr2 n); Fold phi2 in H3; Pose phi3 := (phi_sequence RinvN pr3 n); Fold phi2 in H1; Assert H10 : (IsStepFun phi3 a b).
-Apply StepFun_P44 with c.
-Apply (pre phi3).
-Split; Assumption.
-Assert H11 : (IsStepFun (psi3 n) a b).
-Apply StepFun_P44 with c.
-Apply (pre (psi3 n)).
-Split; Assumption.
-Assert H12 : (IsStepFun phi3 b c).
-Apply StepFun_P45 with a.
-Apply (pre phi3).
-Split; Assumption.
-Assert H13 : (IsStepFun (psi3 n) b c).
-Apply StepFun_P45 with a.
-Apply (pre (psi3 n)).
-Split; Assumption.
-Replace (RiemannInt_SF phi3) with ``(RiemannInt_SF (mkStepFun H10))+(RiemannInt_SF (mkStepFun H12))``.
-Apply Rle_lt_trans with ``(Rabsolu ((RiemannInt_SF (mkStepFun H10))-(RiemannInt_SF phi1)))+(Rabsolu ((RiemannInt_SF (mkStepFun H12))-(RiemannInt_SF phi2)))``.
-Replace ``(RiemannInt_SF (mkStepFun H10))+(RiemannInt_SF (mkStepFun H12))+ -((RiemannInt_SF phi1)+(RiemannInt_SF phi2))`` with ``((RiemannInt_SF (mkStepFun H10))-(RiemannInt_SF phi1))+((RiemannInt_SF (mkStepFun H12))-(RiemannInt_SF phi2))``; [Apply Rabsolu_triang | Ring].
-Replace ``(RiemannInt_SF (mkStepFun H10))-(RiemannInt_SF phi1)`` with (RiemannInt_SF (mkStepFun (StepFun_P28 ``-1`` (mkStepFun H10) phi1))).
-Replace ``(RiemannInt_SF (mkStepFun H12))-(RiemannInt_SF phi2)`` with (RiemannInt_SF (mkStepFun (StepFun_P28 ``-1`` (mkStepFun H12) phi2))).
-Apply Rle_lt_trans with ``(RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H10) phi1)))))+(RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H12) phi2)))))``.
-Apply Rle_trans with ``(Rabsolu (RiemannInt_SF (mkStepFun (StepFun_P28 (-1) (mkStepFun H10) phi1))))+(RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H12) phi2)))))``.
-Apply Rle_compatibility.
-Apply StepFun_P34; Try Assumption.
-Do 2 Rewrite <- (Rplus_sym (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 ``-1`` (mkStepFun H12) phi2)))))); Apply Rle_compatibility; Apply StepFun_P34; Try Assumption.
-Apply Rle_lt_trans with ``(RiemannInt_SF (mkStepFun (StepFun_P28 R1 (mkStepFun H11) (psi1 n))))+(RiemannInt_SF (mkStepFun (StepFun_P28 R1 (mkStepFun H13) (psi2 n))))``.
-Apply Rle_trans with ``(RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H10) phi1)))))+(RiemannInt_SF (mkStepFun (StepFun_P28 R1 (mkStepFun H13) (psi2 n))))``.
-Apply Rle_compatibility; Apply StepFun_P37; Try Assumption.
-Intros; Simpl; Rewrite Rmult_1l; Apply Rle_trans with ``(Rabsolu ((f x)-(phi3 x)))+(Rabsolu ((f x)-(phi2 x)))``.
-Rewrite <- (Rabsolu_Ropp ``(f x)-(phi3 x)``); Rewrite Ropp_distr2; Replace ``(phi3 x)+ -1*(phi2 x)`` with ``((phi3 x)-(f x))+((f x)-(phi2 x))``; [Apply Rabsolu_triang | Ring].
-Apply Rplus_le.
-Fold phi3 in H1; Apply H1.
-Elim H14; Intros; Split.
-Replace (Rmin a c) with a.
-Apply Rle_trans with b; Try Assumption.
-Left; Assumption.
-Unfold Rmin; Case (total_order_Rle a c); Intro; [Reflexivity | Elim n0; Apply Rle_trans with b; Assumption].
-Replace (Rmax a c) with c.
-Left; Assumption.
-Unfold Rmax; Case (total_order_Rle a c); Intro; [Reflexivity | Elim n0; Apply Rle_trans with b; Assumption].
-Apply H3.
-Elim H14; Intros; Split.
-Replace (Rmin b c) with b.
-Left; Assumption.
-Unfold Rmin; Case (total_order_Rle b c); Intro; [Reflexivity | Elim n0; Assumption].
-Replace (Rmax b c) with c.
-Left; Assumption.
-Unfold Rmax; Case (total_order_Rle b c); Intro; [Reflexivity | Elim n0; Assumption].
-Do 2 Rewrite <- (Rplus_sym ``(RiemannInt_SF (mkStepFun (StepFun_P28 R1 (mkStepFun H13) (psi2 n))))``); Apply Rle_compatibility; Apply StepFun_P37; Try Assumption.
-Intros; Simpl; Rewrite Rmult_1l; Apply Rle_trans with ``(Rabsolu ((f x)-(phi3 x)))+(Rabsolu ((f x)-(phi1 x)))``.
-Rewrite <- (Rabsolu_Ropp ``(f x)-(phi3 x)``); Rewrite Ropp_distr2; Replace ``(phi3 x)+ -1*(phi1 x)`` with ``((phi3 x)-(f x))+((f x)-(phi1 x))``; [Apply Rabsolu_triang | Ring].
-Apply Rplus_le.
-Apply H1.
-Elim H14; Intros; Split.
-Replace (Rmin a c) with a.
-Left; Assumption.
-Unfold Rmin; Case (total_order_Rle a c); Intro; [Reflexivity | Elim n0; Apply Rle_trans with b; Assumption].
-Replace (Rmax a c) with c.
-Apply Rle_trans with b.
-Left; Assumption.
-Assumption.
-Unfold Rmax; Case (total_order_Rle a c); Intro; [Reflexivity | Elim n0; Apply Rle_trans with b; Assumption].
-Apply H8.
-Elim H14; Intros; Split.
-Replace (Rmin a b) with a.
-Left; Assumption.
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption].
-Replace (Rmax a b) with b.
-Left; Assumption.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption].
-Do 2 Rewrite StepFun_P30.
-Do 2 Rewrite Rmult_1l; Replace ``(RiemannInt_SF (mkStepFun H11))+(RiemannInt_SF (psi1 n))+((RiemannInt_SF (mkStepFun H13))+(RiemannInt_SF (psi2 n)))`` with ``(RiemannInt_SF (psi3 n))+(RiemannInt_SF (psi1 n))+(RiemannInt_SF (psi2 n))``.
-Replace eps with ``eps/3+eps/3+eps/3``.
-Repeat Rewrite Rplus_assoc; Repeat Apply Rplus_lt.
-Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi3 n))).
-Apply Rle_Rabsolu.
-Apply Rlt_trans with (pos (RinvN n)).
-Assumption.
-Apply H5; Assumption.
-Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi1 n))).
-Apply Rle_Rabsolu.
-Apply Rlt_trans with (pos (RinvN n)).
-Assumption.
-Apply H5; Assumption.
-Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi2 n))).
-Apply Rle_Rabsolu.
-Apply Rlt_trans with (pos (RinvN n)).
-Assumption.
-Apply H5; Assumption.
-Apply r_Rmult_mult with ``3``; [Unfold Rdiv; Repeat Rewrite Rmult_Rplus_distr; Do 2 Rewrite (Rmult_sym ``3``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Ring | DiscrR] | DiscrR].
-Replace (RiemannInt_SF (psi3 n)) with (RiemannInt_SF (mkStepFun (pre (psi3 n)))).
-Rewrite <- (StepFun_P43 H11 H13 (pre (psi3 n))); Ring.
-Reflexivity.
-Rewrite StepFun_P30; Ring.
-Rewrite StepFun_P30; Ring.
-Apply (StepFun_P43 H10 H12 (pre phi3)).
+Lemma RiemannInt_P25 :
+ forall (f:R -> R) (a b c:R) (pr1:Riemann_integrable f a b)
+ (pr2:Riemann_integrable f b c) (pr3:Riemann_integrable f a c),
+ a <= b -> b <= c -> RiemannInt pr1 + RiemannInt pr2 = RiemannInt pr3.
+intros f a b c pr1 pr2 pr3 Hyp1 Hyp2; unfold RiemannInt in |- *;
+ case (RiemannInt_exists pr1 RinvN RinvN_cv);
+ case (RiemannInt_exists pr2 RinvN RinvN_cv);
+ case (RiemannInt_exists pr3 RinvN RinvN_cv); intros;
+ symmetry in |- *; eapply UL_sequence.
+apply u.
+unfold Un_cv in |- *; intros; assert (H0 : 0 < eps / 3).
+unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
+elim (u1 _ H0); clear u1; intros N1 H1; elim (u0 _ H0); clear u0;
+ intros N2 H2;
+ cut
+ (Un_cv
+ (fun n:nat =>
+ RiemannInt_SF (phi_sequence RinvN pr3 n) -
+ (RiemannInt_SF (phi_sequence RinvN pr1 n) +
+ RiemannInt_SF (phi_sequence RinvN pr2 n))) 0).
+intro; elim (H3 _ H0); clear H3; intros N3 H3;
+ pose (N0 := max (max N1 N2) N3); exists N0; intros;
+ unfold R_dist in |- *;
+ apply Rle_lt_trans with
+ (Rabs
+ (RiemannInt_SF (phi_sequence RinvN pr3 n) -
+ (RiemannInt_SF (phi_sequence RinvN pr1 n) +
+ RiemannInt_SF (phi_sequence RinvN pr2 n))) +
+ Rabs
+ (RiemannInt_SF (phi_sequence RinvN pr1 n) +
+ RiemannInt_SF (phi_sequence RinvN pr2 n) - (x1 + x0))).
+replace (RiemannInt_SF (phi_sequence RinvN pr3 n) - (x1 + x0)) with
+ (RiemannInt_SF (phi_sequence RinvN pr3 n) -
+ (RiemannInt_SF (phi_sequence RinvN pr1 n) +
+ RiemannInt_SF (phi_sequence RinvN pr2 n)) +
+ (RiemannInt_SF (phi_sequence RinvN pr1 n) +
+ RiemannInt_SF (phi_sequence RinvN pr2 n) - (x1 + x0)));
+ [ apply Rabs_triang | ring ].
+replace eps with (eps / 3 + eps / 3 + eps / 3).
+rewrite Rplus_assoc; apply Rplus_lt_compat.
+unfold R_dist in H3; cut (n >= N3)%nat.
+intro; assert (H6 := H3 _ H5); unfold Rminus in H6; rewrite Ropp_0 in H6;
+ rewrite Rplus_0_r in H6; apply H6.
+unfold ge in |- *; apply le_trans with N0;
+ [ unfold N0 in |- *; apply le_max_r | assumption ].
+apply Rle_lt_trans with
+ (Rabs (RiemannInt_SF (phi_sequence RinvN pr1 n) - x1) +
+ Rabs (RiemannInt_SF (phi_sequence RinvN pr2 n) - x0)).
+replace
+ (RiemannInt_SF (phi_sequence RinvN pr1 n) +
+ RiemannInt_SF (phi_sequence RinvN pr2 n) - (x1 + x0)) with
+ (RiemannInt_SF (phi_sequence RinvN pr1 n) - x1 +
+ (RiemannInt_SF (phi_sequence RinvN pr2 n) - x0));
+ [ apply Rabs_triang | ring ].
+apply Rplus_lt_compat.
+unfold R_dist in H1; apply H1.
+unfold ge in |- *; apply le_trans with N0;
+ [ apply le_trans with (max N1 N2);
+ [ apply le_max_l | unfold N0 in |- *; apply le_max_l ]
+ | assumption ].
+unfold R_dist in H2; apply H2.
+unfold ge in |- *; apply le_trans with N0;
+ [ apply le_trans with (max N1 N2);
+ [ apply le_max_r | unfold N0 in |- *; apply le_max_l ]
+ | assumption ].
+apply Rmult_eq_reg_l with 3;
+ [ unfold Rdiv in |- *; repeat rewrite Rmult_plus_distr_l;
+ do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc;
+ rewrite <- Rinv_l_sym; [ ring | discrR ]
+ | discrR ].
+clear x u x0 x1 eps H H0 N1 H1 N2 H2;
+ assert
+ (H1 :
+ exists psi1 : nat -> StepFun a b
+ | (forall n:nat,
+ (forall t:R,
+ Rmin a b <= t /\ t <= Rmax a b ->
+ Rabs (f t - phi_sequence RinvN pr1 n t) <= psi1 n t) /\
+ Rabs (RiemannInt_SF (psi1 n)) < RinvN n)).
+split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr1 n)); intro;
+ apply (projT2 (phi_sequence_prop RinvN pr1 n)).
+assert
+ (H2 :
+ exists psi2 : nat -> StepFun b c
+ | (forall n:nat,
+ (forall t:R,
+ Rmin b c <= t /\ t <= Rmax b c ->
+ Rabs (f t - phi_sequence RinvN pr2 n t) <= psi2 n t) /\
+ Rabs (RiemannInt_SF (psi2 n)) < RinvN n)).
+split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr2 n)); intro;
+ apply (projT2 (phi_sequence_prop RinvN pr2 n)).
+assert
+ (H3 :
+ exists psi3 : nat -> StepFun a c
+ | (forall n:nat,
+ (forall t:R,
+ Rmin a c <= t /\ t <= Rmax a c ->
+ Rabs (f t - phi_sequence RinvN pr3 n t) <= psi3 n t) /\
+ Rabs (RiemannInt_SF (psi3 n)) < RinvN n)).
+split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr3 n)); intro;
+ apply (projT2 (phi_sequence_prop RinvN pr3 n)).
+elim H1; clear H1; intros psi1 H1; elim H2; clear H2; intros psi2 H2; elim H3;
+ clear H3; intros psi3 H3; assert (H := RinvN_cv);
+ unfold Un_cv in |- *; intros; assert (H4 : 0 < eps / 3).
+unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
+elim (H _ H4); clear H; intros N0 H;
+ assert (H5 : forall n:nat, (n >= N0)%nat -> RinvN n < eps / 3).
+intros;
+ replace (pos (RinvN n)) with
+ (R_dist (mkposreal (/ (INR n + 1)) (RinvN_pos n)) 0).
+apply H; assumption.
+unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0;
+ rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge;
+ left; apply (cond_pos (RinvN n)).
+exists N0; intros; elim (H1 n); elim (H2 n); elim (H3 n); clear H1 H2 H3;
+ intros; unfold R_dist in |- *; unfold Rminus in |- *;
+ rewrite Ropp_0; rewrite Rplus_0_r; pose (phi1 := phi_sequence RinvN pr1 n);
+ fold phi1 in H8; pose (phi2 := phi_sequence RinvN pr2 n);
+ fold phi2 in H3; pose (phi3 := phi_sequence RinvN pr3 n);
+ fold phi2 in H1; assert (H10 : IsStepFun phi3 a b).
+apply StepFun_P44 with c.
+apply (pre phi3).
+split; assumption.
+assert (H11 : IsStepFun (psi3 n) a b).
+apply StepFun_P44 with c.
+apply (pre (psi3 n)).
+split; assumption.
+assert (H12 : IsStepFun phi3 b c).
+apply StepFun_P45 with a.
+apply (pre phi3).
+split; assumption.
+assert (H13 : IsStepFun (psi3 n) b c).
+apply StepFun_P45 with a.
+apply (pre (psi3 n)).
+split; assumption.
+replace (RiemannInt_SF phi3) with
+ (RiemannInt_SF (mkStepFun H10) + RiemannInt_SF (mkStepFun H12)).
+apply Rle_lt_trans with
+ (Rabs (RiemannInt_SF (mkStepFun H10) - RiemannInt_SF phi1) +
+ Rabs (RiemannInt_SF (mkStepFun H12) - RiemannInt_SF phi2)).
+replace
+ (RiemannInt_SF (mkStepFun H10) + RiemannInt_SF (mkStepFun H12) +
+ - (RiemannInt_SF phi1 + RiemannInt_SF phi2)) with
+ (RiemannInt_SF (mkStepFun H10) - RiemannInt_SF phi1 +
+ (RiemannInt_SF (mkStepFun H12) - RiemannInt_SF phi2));
+ [ apply Rabs_triang | ring ].
+replace (RiemannInt_SF (mkStepFun H10) - RiemannInt_SF phi1) with
+ (RiemannInt_SF (mkStepFun (StepFun_P28 (-1) (mkStepFun H10) phi1))).
+replace (RiemannInt_SF (mkStepFun H12) - RiemannInt_SF phi2) with
+ (RiemannInt_SF (mkStepFun (StepFun_P28 (-1) (mkStepFun H12) phi2))).
+apply Rle_lt_trans with
+ (RiemannInt_SF
+ (mkStepFun
+ (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H10) phi1)))) +
+ RiemannInt_SF
+ (mkStepFun
+ (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H12) phi2))))).
+apply Rle_trans with
+ (Rabs (RiemannInt_SF (mkStepFun (StepFun_P28 (-1) (mkStepFun H10) phi1))) +
+ RiemannInt_SF
+ (mkStepFun
+ (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H12) phi2))))).
+apply Rplus_le_compat_l.
+apply StepFun_P34; try assumption.
+do 2
+ rewrite <-
+ (Rplus_comm
+ (RiemannInt_SF
+ (mkStepFun
+ (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H12) phi2))))))
+ ; apply Rplus_le_compat_l; apply StepFun_P34; try assumption.
+apply Rle_lt_trans with
+ (RiemannInt_SF (mkStepFun (StepFun_P28 1 (mkStepFun H11) (psi1 n))) +
+ RiemannInt_SF (mkStepFun (StepFun_P28 1 (mkStepFun H13) (psi2 n)))).
+apply Rle_trans with
+ (RiemannInt_SF
+ (mkStepFun
+ (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H10) phi1)))) +
+ RiemannInt_SF (mkStepFun (StepFun_P28 1 (mkStepFun H13) (psi2 n)))).
+apply Rplus_le_compat_l; apply StepFun_P37; try assumption.
+intros; simpl in |- *; rewrite Rmult_1_l;
+ apply Rle_trans with (Rabs (f x - phi3 x) + Rabs (f x - phi2 x)).
+rewrite <- (Rabs_Ropp (f x - phi3 x)); rewrite Ropp_minus_distr;
+ replace (phi3 x + -1 * phi2 x) with (phi3 x - f x + (f x - phi2 x));
+ [ apply Rabs_triang | ring ].
+apply Rplus_le_compat.
+fold phi3 in H1; apply H1.
+elim H14; intros; split.
+replace (Rmin a c) with a.
+apply Rle_trans with b; try assumption.
+left; assumption.
+unfold Rmin in |- *; case (Rle_dec a c); intro;
+ [ reflexivity | elim n0; apply Rle_trans with b; assumption ].
+replace (Rmax a c) with c.
+left; assumption.
+unfold Rmax in |- *; case (Rle_dec a c); intro;
+ [ reflexivity | elim n0; apply Rle_trans with b; assumption ].
+apply H3.
+elim H14; intros; split.
+replace (Rmin b c) with b.
+left; assumption.
+unfold Rmin in |- *; case (Rle_dec b c); intro;
+ [ reflexivity | elim n0; assumption ].
+replace (Rmax b c) with c.
+left; assumption.
+unfold Rmax in |- *; case (Rle_dec b c); intro;
+ [ reflexivity | elim n0; assumption ].
+do 2
+ rewrite <-
+ (Rplus_comm
+ (RiemannInt_SF (mkStepFun (StepFun_P28 1 (mkStepFun H13) (psi2 n)))))
+ ; apply Rplus_le_compat_l; apply StepFun_P37; try assumption.
+intros; simpl in |- *; rewrite Rmult_1_l;
+ apply Rle_trans with (Rabs (f x - phi3 x) + Rabs (f x - phi1 x)).
+rewrite <- (Rabs_Ropp (f x - phi3 x)); rewrite Ropp_minus_distr;
+ replace (phi3 x + -1 * phi1 x) with (phi3 x - f x + (f x - phi1 x));
+ [ apply Rabs_triang | ring ].
+apply Rplus_le_compat.
+apply H1.
+elim H14; intros; split.
+replace (Rmin a c) with a.
+left; assumption.
+unfold Rmin in |- *; case (Rle_dec a c); intro;
+ [ reflexivity | elim n0; apply Rle_trans with b; assumption ].
+replace (Rmax a c) with c.
+apply Rle_trans with b.
+left; assumption.
+assumption.
+unfold Rmax in |- *; case (Rle_dec a c); intro;
+ [ reflexivity | elim n0; apply Rle_trans with b; assumption ].
+apply H8.
+elim H14; intros; split.
+replace (Rmin a b) with a.
+left; assumption.
+unfold Rmin in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n0; assumption ].
+replace (Rmax a b) with b.
+left; assumption.
+unfold Rmax in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n0; assumption ].
+do 2 rewrite StepFun_P30.
+do 2 rewrite Rmult_1_l;
+ replace
+ (RiemannInt_SF (mkStepFun H11) + RiemannInt_SF (psi1 n) +
+ (RiemannInt_SF (mkStepFun H13) + RiemannInt_SF (psi2 n))) with
+ (RiemannInt_SF (psi3 n) + RiemannInt_SF (psi1 n) + RiemannInt_SF (psi2 n)).
+replace eps with (eps / 3 + eps / 3 + eps / 3).
+repeat rewrite Rplus_assoc; repeat apply Rplus_lt_compat.
+apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi3 n))).
+apply RRle_abs.
+apply Rlt_trans with (pos (RinvN n)).
+assumption.
+apply H5; assumption.
+apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n))).
+apply RRle_abs.
+apply Rlt_trans with (pos (RinvN n)).
+assumption.
+apply H5; assumption.
+apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n))).
+apply RRle_abs.
+apply Rlt_trans with (pos (RinvN n)).
+assumption.
+apply H5; assumption.
+apply Rmult_eq_reg_l with 3;
+ [ unfold Rdiv in |- *; repeat rewrite Rmult_plus_distr_l;
+ do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc;
+ rewrite <- Rinv_l_sym; [ ring | discrR ]
+ | discrR ].
+replace (RiemannInt_SF (psi3 n)) with
+ (RiemannInt_SF (mkStepFun (pre (psi3 n)))).
+rewrite <- (StepFun_P43 H11 H13 (pre (psi3 n))); ring.
+reflexivity.
+rewrite StepFun_P30; ring.
+rewrite StepFun_P30; ring.
+apply (StepFun_P43 H10 H12 (pre phi3)).
Qed.
-Lemma RiemannInt_P26 : (f:R->R;a,b,c:R;pr1:(Riemann_integrable f a b);pr2:(Riemann_integrable f b c);pr3:(Riemann_integrable f a c)) ``(RiemannInt pr1)+(RiemannInt pr2)==(RiemannInt pr3)``.
-Intros; Case (total_order_Rle a b); Case (total_order_Rle b c); Intros.
-Apply RiemannInt_P25; Assumption.
-Case (total_order_Rle a c); Intro.
-Assert H : ``c<=b``.
-Auto with real.
-Rewrite <- (RiemannInt_P25 pr3 (RiemannInt_P1 pr2) pr1 r0 H); Rewrite (RiemannInt_P8 pr2 (RiemannInt_P1 pr2)); Ring.
-Assert H : ``c<=a``.
-Auto with real.
-Rewrite (RiemannInt_P8 pr2 (RiemannInt_P1 pr2)); Rewrite <- (RiemannInt_P25 (RiemannInt_P1 pr3) pr1 (RiemannInt_P1 pr2) H r); Rewrite (RiemannInt_P8 pr3 (RiemannInt_P1 pr3)); Ring.
-Assert H : ``b<=a``.
-Auto with real.
-Case (total_order_Rle a c); Intro.
-Rewrite <- (RiemannInt_P25 (RiemannInt_P1 pr1) pr3 pr2 H r0); Rewrite (RiemannInt_P8 pr1 (RiemannInt_P1 pr1)); Ring.
-Assert H0 : ``c<=a``.
-Auto with real.
-Rewrite (RiemannInt_P8 pr1 (RiemannInt_P1 pr1)); Rewrite <- (RiemannInt_P25 pr2 (RiemannInt_P1 pr3) (RiemannInt_P1 pr1) r H0); Rewrite (RiemannInt_P8 pr3 (RiemannInt_P1 pr3)); Ring.
-Rewrite (RiemannInt_P8 pr1 (RiemannInt_P1 pr1)); Rewrite (RiemannInt_P8 pr2 (RiemannInt_P1 pr2)); Rewrite (RiemannInt_P8 pr3 (RiemannInt_P1 pr3)); Rewrite <- (RiemannInt_P25 (RiemannInt_P1 pr2) (RiemannInt_P1 pr1) (RiemannInt_P1 pr3)); [Ring | Auto with real | Auto with real].
+Lemma RiemannInt_P26 :
+ forall (f:R -> R) (a b c:R) (pr1:Riemann_integrable f a b)
+ (pr2:Riemann_integrable f b c) (pr3:Riemann_integrable f a c),
+ RiemannInt pr1 + RiemannInt pr2 = RiemannInt pr3.
+intros; case (Rle_dec a b); case (Rle_dec b c); intros.
+apply RiemannInt_P25; assumption.
+case (Rle_dec a c); intro.
+assert (H : c <= b).
+auto with real.
+rewrite <- (RiemannInt_P25 pr3 (RiemannInt_P1 pr2) pr1 r0 H);
+ rewrite (RiemannInt_P8 pr2 (RiemannInt_P1 pr2)); ring.
+assert (H : c <= a).
+auto with real.
+rewrite (RiemannInt_P8 pr2 (RiemannInt_P1 pr2));
+ rewrite <- (RiemannInt_P25 (RiemannInt_P1 pr3) pr1 (RiemannInt_P1 pr2) H r);
+ rewrite (RiemannInt_P8 pr3 (RiemannInt_P1 pr3)); ring.
+assert (H : b <= a).
+auto with real.
+case (Rle_dec a c); intro.
+rewrite <- (RiemannInt_P25 (RiemannInt_P1 pr1) pr3 pr2 H r0);
+ rewrite (RiemannInt_P8 pr1 (RiemannInt_P1 pr1)); ring.
+assert (H0 : c <= a).
+auto with real.
+rewrite (RiemannInt_P8 pr1 (RiemannInt_P1 pr1));
+ rewrite <- (RiemannInt_P25 pr2 (RiemannInt_P1 pr3) (RiemannInt_P1 pr1) r H0);
+ rewrite (RiemannInt_P8 pr3 (RiemannInt_P1 pr3)); ring.
+rewrite (RiemannInt_P8 pr1 (RiemannInt_P1 pr1));
+ rewrite (RiemannInt_P8 pr2 (RiemannInt_P1 pr2));
+ rewrite (RiemannInt_P8 pr3 (RiemannInt_P1 pr3));
+ rewrite <-
+ (RiemannInt_P25 (RiemannInt_P1 pr2) (RiemannInt_P1 pr1) (RiemannInt_P1 pr3))
+ ; [ ring | auto with real | auto with real ].
Qed.
-Lemma RiemannInt_P27 : (f:R->R;a,b,x:R;h:``a<=b``;C0:((x:R)``a<=x<=b``->(continuity_pt f x))) ``a<x<b`` -> (derivable_pt_lim (primitive h (FTC_P1 h C0)) x (f x)).
-Intro f; Intros; Elim H; Clear H; Intros; Assert H1 : (continuity_pt f x).
-Apply C0; Split; Left; Assumption.
-Unfold derivable_pt_lim; Intros; Assert Hyp : ``0<eps/2``.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
-Elim (H1 ? Hyp); Unfold dist D_x no_cond; Simpl; Unfold R_dist; Intros; Pose del := (Rmin x0 (Rmin ``b-x`` ``x-a``)); Assert H4 : ``0<del``.
-Unfold del; Unfold Rmin; Case (total_order_Rle ``b-x`` ``x-a``); Intro.
-Case (total_order_Rle x0 ``b-x``); Intro; [Elim H3; Intros; Assumption | Apply Rlt_Rminus; Assumption].
-Case (total_order_Rle x0 ``x-a``); Intro; [Elim H3; Intros; Assumption | Apply Rlt_Rminus; Assumption].
-Split with (mkposreal ? H4); Intros; Assert H7 : (Riemann_integrable f x ``x+h0``).
-Case (total_order_Rle x ``x+h0``); Intro.
-Apply continuity_implies_RiemannInt; Try Assumption.
-Intros; Apply C0; Elim H7; Intros; Split.
-Apply Rle_trans with x; [Left; Assumption | Assumption].
-Apply Rle_trans with ``x+h0``.
-Assumption.
-Left; Apply Rlt_le_trans with ``x+del``.
-Apply Rlt_compatibility; Apply Rle_lt_trans with (Rabsolu h0); [Apply Rle_Rabsolu | Apply H6].
-Unfold del; Apply Rle_trans with ``x+(Rmin (b-x) (x-a))``.
-Apply Rle_compatibility; Apply Rmin_r.
-Pattern 2 b; Replace b with ``x+(b-x)``; [Apply Rle_compatibility; Apply Rmin_l | Ring].
-Apply RiemannInt_P1; Apply continuity_implies_RiemannInt; Auto with real.
-Intros; Apply C0; Elim H7; Intros; Split.
-Apply Rle_trans with ``x+h0``.
-Left; Apply Rle_lt_trans with ``x-del``.
-Unfold del; Apply Rle_trans with ``x-(Rmin (b-x) (x-a))``.
-Pattern 1 a; Replace a with ``x+(a-x)``; [Idtac | Ring].
-Unfold Rminus; Apply Rle_compatibility; Apply Ropp_Rle.
-Rewrite Ropp_Ropp; Rewrite Ropp_distr1; Rewrite Ropp_Ropp; Rewrite (Rplus_sym x); Apply Rmin_r.
-Unfold Rminus; Apply Rle_compatibility; Apply Ropp_Rle.
-Do 2 Rewrite Ropp_Ropp; Apply Rmin_r.
-Unfold Rminus; Apply Rlt_compatibility; Apply Ropp_Rlt.
-Rewrite Ropp_Ropp; Apply Rle_lt_trans with (Rabsolu h0); [Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu | Apply H6].
-Assumption.
-Apply Rle_trans with x; [Assumption | Left; Assumption].
-Replace ``(primitive h (FTC_P1 h C0) (x+h0))-(primitive h (FTC_P1 h C0) x)`` with (RiemannInt H7).
-Replace (f x) with ``(RiemannInt (RiemannInt_P14 x (x+h0) (f x)))/h0``.
-Replace ``(RiemannInt H7)/h0-(RiemannInt (RiemannInt_P14 x (x+h0) (f x)))/h0`` with ``((RiemannInt H7)-(RiemannInt (RiemannInt_P14 x (x+h0) (f x))))/h0``.
-Replace ``(RiemannInt H7)-(RiemannInt (RiemannInt_P14 x (x+h0) (f x)))`` with (RiemannInt (RiemannInt_P10 ``-1`` H7 (RiemannInt_P14 x ``x+h0`` (f x)))).
-Unfold Rdiv; Rewrite Rabsolu_mult; Case (total_order_Rle x ``x+h0``); Intro.
-Apply Rle_lt_trans with ``(RiemannInt (RiemannInt_P16 (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x+h0) (f x)))))*(Rabsolu (/h0))``.
-Do 2 Rewrite <- (Rmult_sym ``(Rabsolu (/h0))``); Apply Rle_monotony.
-Apply Rabsolu_pos.
-Apply (RiemannInt_P17 (RiemannInt_P10 ``-1`` H7 (RiemannInt_P14 x ``x+h0`` (f x))) (RiemannInt_P16 (RiemannInt_P10 ``-1`` H7 (RiemannInt_P14 x ``x+h0`` (f x))))); Assumption.
-Apply Rle_lt_trans with ``(RiemannInt (RiemannInt_P14 x (x+h0) (eps/2)))*(Rabsolu (/h0))``.
-Do 2 Rewrite <- (Rmult_sym ``(Rabsolu (/h0))``); Apply Rle_monotony.
-Apply Rabsolu_pos.
-Apply RiemannInt_P19; Try Assumption.
-Intros; Replace ``(f x1)+ -1*(fct_cte (f x) x1)`` with ``(f x1)-(f x)``.
-Unfold fct_cte; Case (Req_EM x x1); Intro.
-Rewrite H9; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Left; Assumption.
-Elim H3; Intros; Left; Apply H11.
-Repeat Split.
-Assumption.
-Rewrite Rabsolu_right.
-Apply Rlt_anti_compatibility with x; Replace ``x+(x1-x)`` with x1; [Idtac | Ring].
-Apply Rlt_le_trans with ``x+h0``.
-Elim H8; Intros; Assumption.
-Apply Rle_compatibility; Apply Rle_trans with del.
-Left; Apply Rle_lt_trans with (Rabsolu h0); [Apply Rle_Rabsolu | Assumption].
-Unfold del; Apply Rmin_l.
-Apply Rge_minus; Apply Rle_sym1; Left; Elim H8; Intros; Assumption.
-Unfold fct_cte; Ring.
-Rewrite RiemannInt_P15.
-Rewrite Rmult_assoc; Replace ``(x+h0-x)*(Rabsolu (/h0))`` with R1.
-Rewrite Rmult_1r; Unfold Rdiv; Apply Rlt_monotony_contra with ``2``; [Sup0 | Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Pattern 1 eps; Rewrite <- Rplus_Or; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
-Rewrite Rabsolu_right.
-Replace ``x+h0-x`` with h0; [Idtac | Ring].
-Apply Rinv_r_sym.
-Assumption.
-Apply Rle_sym1; Left; Apply Rlt_Rinv.
-Elim r; Intro.
-Apply Rlt_anti_compatibility with x; Rewrite Rplus_Or; Assumption.
-Elim H5; Symmetry; Apply r_Rplus_plus with x; Rewrite Rplus_Or; Assumption.
-Apply Rle_lt_trans with ``(RiemannInt (RiemannInt_P16 (RiemannInt_P1 (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x+h0) (f x))))))*(Rabsolu (/h0))``.
-Do 2 Rewrite <- (Rmult_sym ``(Rabsolu (/h0))``); Apply Rle_monotony.
-Apply Rabsolu_pos.
-Replace (RiemannInt (RiemannInt_P10 ``-1`` H7 (RiemannInt_P14 x ``x+h0`` (f x)))) with ``-(RiemannInt (RiemannInt_P1 (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x+h0) (f x)))))``.
-Rewrite Rabsolu_Ropp; Apply (RiemannInt_P17 (RiemannInt_P1 (RiemannInt_P10 ``-1`` H7 (RiemannInt_P14 x ``x+h0`` (f x)))) (RiemannInt_P16 (RiemannInt_P1 (RiemannInt_P10 ``-1`` H7 (RiemannInt_P14 x ``x+h0`` (f x)))))); Auto with real.
-Symmetry; Apply RiemannInt_P8.
-Apply Rle_lt_trans with ``(RiemannInt (RiemannInt_P14 (x+h0) x (eps/2)))*(Rabsolu (/h0))``.
-Do 2 Rewrite <- (Rmult_sym ``(Rabsolu (/h0))``); Apply Rle_monotony.
-Apply Rabsolu_pos.
-Apply RiemannInt_P19.
-Auto with real.
-Intros; Replace ``(f x1)+ -1*(fct_cte (f x) x1)`` with ``(f x1)-(f x)``.
-Unfold fct_cte; Case (Req_EM x x1); Intro.
-Rewrite H9; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Left; Assumption.
-Elim H3; Intros; Left; Apply H11.
-Repeat Split.
-Assumption.
-Rewrite Rabsolu_left.
-Apply Rlt_anti_compatibility with ``x1-x0``; Replace ``x1-x0+x0`` with x1; [Idtac | Ring].
-Replace ``x1-x0+ -(x1-x)`` with ``x-x0``; [Idtac | Ring].
-Apply Rle_lt_trans with ``x+h0``.
-Unfold Rminus; Apply Rle_compatibility; Apply Ropp_Rle.
-Rewrite Ropp_Ropp; Apply Rle_trans with (Rabsolu h0).
-Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu.
-Apply Rle_trans with del; [Left; Assumption | Unfold del; Apply Rmin_l].
-Elim H8; Intros; Assumption.
-Apply Rlt_anti_compatibility with x; Rewrite Rplus_Or; Replace ``x+(x1-x)`` with x1; [Elim H8; Intros; Assumption | Ring].
-Unfold fct_cte; Ring.
-Rewrite RiemannInt_P15.
-Rewrite Rmult_assoc; Replace ``(x-(x+h0))*(Rabsolu (/h0))`` with R1.
-Rewrite Rmult_1r; Unfold Rdiv; Apply Rlt_monotony_contra with ``2``; [Sup0 | Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Pattern 1 eps; Rewrite <- Rplus_Or; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
-Rewrite Rabsolu_left.
-Replace ``x-(x+h0)`` with ``-h0``; [Idtac | Ring].
-Rewrite Ropp_mul1; Rewrite Ropp_mul3; Rewrite Ropp_Ropp; Apply Rinv_r_sym.
-Assumption.
-Apply Rlt_Rinv2.
-Assert H8 : ``x+h0<x``.
-Auto with real.
-Apply Rlt_anti_compatibility with x; Rewrite Rplus_Or; Assumption.
-Rewrite (RiemannInt_P13 H7 (RiemannInt_P14 x ``x+h0`` (f x)) (RiemannInt_P10 ``-1`` H7 (RiemannInt_P14 x ``x+h0`` (f x)))).
-Ring.
-Unfold Rdiv Rminus; Rewrite Rmult_Rplus_distrl; Ring.
-Rewrite RiemannInt_P15; Apply r_Rmult_mult with h0; [Unfold Rdiv; Rewrite -> (Rmult_sym h0); Repeat Rewrite -> Rmult_assoc; Rewrite <- Rinv_l_sym; [Ring | Assumption] | Assumption].
-Cut ``a<=x+h0``.
-Cut ``x+h0<=b``.
-Intros; Unfold primitive.
-Case (total_order_Rle a ``x+h0``); Case (total_order_Rle ``x+h0`` b); Case (total_order_Rle a x); Case (total_order_Rle x b); Intros; Try (Elim n; Assumption Orelse Left; Assumption).
-Rewrite <- (RiemannInt_P26 (FTC_P1 h C0 r0 r) H7 (FTC_P1 h C0 r2 r1)); Ring.
-Apply Rle_anti_compatibility with ``-x``; Replace ``-x+(x+h0)`` with h0; [Idtac | Ring].
-Rewrite Rplus_sym; Apply Rle_trans with (Rabsolu h0).
-Apply Rle_Rabsolu.
-Apply Rle_trans with del; [Left; Assumption | Unfold del; Apply Rle_trans with ``(Rmin (b-x) (x-a))``; [Apply Rmin_r | Apply Rmin_l]].
-Apply Ropp_Rle; Apply Rle_anti_compatibility with ``x``; Replace ``x+-(x+h0)`` with ``-h0``; [Idtac | Ring].
-Apply Rle_trans with (Rabsolu h0); [Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu | Apply Rle_trans with del; [Left; Assumption | Unfold del; Apply Rle_trans with ``(Rmin (b-x) (x-a))``; Apply Rmin_r]].
+Lemma RiemannInt_P27 :
+ forall (f:R -> R) (a b x:R) (h:a <= b)
+ (C0:forall x:R, a <= x <= b -> continuity_pt f x),
+ a < x < b -> derivable_pt_lim (primitive h (FTC_P1 h C0)) x (f x).
+intro f; intros; elim H; clear H; intros; assert (H1 : continuity_pt f x).
+apply C0; split; left; assumption.
+unfold derivable_pt_lim in |- *; intros; assert (Hyp : 0 < eps / 2).
+unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
+elim (H1 _ Hyp); unfold dist, D_x, no_cond in |- *; simpl in |- *;
+ unfold R_dist in |- *; intros; pose (del := Rmin x0 (Rmin (b - x) (x - a)));
+ assert (H4 : 0 < del).
+unfold del in |- *; unfold Rmin in |- *; case (Rle_dec (b - x) (x - a));
+ intro.
+case (Rle_dec x0 (b - x)); intro;
+ [ elim H3; intros; assumption | apply Rlt_Rminus; assumption ].
+case (Rle_dec x0 (x - a)); intro;
+ [ elim H3; intros; assumption | apply Rlt_Rminus; assumption ].
+split with (mkposreal _ H4); intros;
+ assert (H7 : Riemann_integrable f x (x + h0)).
+case (Rle_dec x (x + h0)); intro.
+apply continuity_implies_RiemannInt; try assumption.
+intros; apply C0; elim H7; intros; split.
+apply Rle_trans with x; [ left; assumption | assumption ].
+apply Rle_trans with (x + h0).
+assumption.
+left; apply Rlt_le_trans with (x + del).
+apply Rplus_lt_compat_l; apply Rle_lt_trans with (Rabs h0);
+ [ apply RRle_abs | apply H6 ].
+unfold del in |- *; apply Rle_trans with (x + Rmin (b - x) (x - a)).
+apply Rplus_le_compat_l; apply Rmin_r.
+pattern b at 2 in |- *; replace b with (x + (b - x));
+ [ apply Rplus_le_compat_l; apply Rmin_l | ring ].
+apply RiemannInt_P1; apply continuity_implies_RiemannInt; auto with real.
+intros; apply C0; elim H7; intros; split.
+apply Rle_trans with (x + h0).
+left; apply Rle_lt_trans with (x - del).
+unfold del in |- *; apply Rle_trans with (x - Rmin (b - x) (x - a)).
+pattern a at 1 in |- *; replace a with (x + (a - x)); [ idtac | ring ].
+unfold Rminus in |- *; apply Rplus_le_compat_l; apply Ropp_le_cancel.
+rewrite Ropp_involutive; rewrite Ropp_plus_distr; rewrite Ropp_involutive;
+ rewrite (Rplus_comm x); apply Rmin_r.
+unfold Rminus in |- *; apply Rplus_le_compat_l; apply Ropp_le_cancel.
+do 2 rewrite Ropp_involutive; apply Rmin_r.
+unfold Rminus in |- *; apply Rplus_lt_compat_l; apply Ropp_lt_cancel.
+rewrite Ropp_involutive; apply Rle_lt_trans with (Rabs h0);
+ [ rewrite <- Rabs_Ropp; apply RRle_abs | apply H6 ].
+assumption.
+apply Rle_trans with x; [ assumption | left; assumption ].
+replace (primitive h (FTC_P1 h C0) (x + h0) - primitive h (FTC_P1 h C0) x)
+ with (RiemannInt H7).
+replace (f x) with (RiemannInt (RiemannInt_P14 x (x + h0) (f x)) / h0).
+replace
+ (RiemannInt H7 / h0 - RiemannInt (RiemannInt_P14 x (x + h0) (f x)) / h0)
+ with ((RiemannInt H7 - RiemannInt (RiemannInt_P14 x (x + h0) (f x))) / h0).
+replace (RiemannInt H7 - RiemannInt (RiemannInt_P14 x (x + h0) (f x))) with
+ (RiemannInt (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x)))).
+unfold Rdiv in |- *; rewrite Rabs_mult; case (Rle_dec x (x + h0)); intro.
+apply Rle_lt_trans with
+ (RiemannInt
+ (RiemannInt_P16
+ (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x)))) *
+ Rabs (/ h0)).
+do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l.
+apply Rabs_pos.
+apply
+ (RiemannInt_P17 (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x)))
+ (RiemannInt_P16
+ (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x)))));
+ assumption.
+apply Rle_lt_trans with
+ (RiemannInt (RiemannInt_P14 x (x + h0) (eps / 2)) * Rabs (/ h0)).
+do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l.
+apply Rabs_pos.
+apply RiemannInt_P19; try assumption.
+intros; replace (f x1 + -1 * fct_cte (f x) x1) with (f x1 - f x).
+unfold fct_cte in |- *; case (Req_dec x x1); intro.
+rewrite H9; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; left;
+ assumption.
+elim H3; intros; left; apply H11.
+repeat split.
+assumption.
+rewrite Rabs_right.
+apply Rplus_lt_reg_r with x; replace (x + (x1 - x)) with x1; [ idtac | ring ].
+apply Rlt_le_trans with (x + h0).
+elim H8; intros; assumption.
+apply Rplus_le_compat_l; apply Rle_trans with del.
+left; apply Rle_lt_trans with (Rabs h0); [ apply RRle_abs | assumption ].
+unfold del in |- *; apply Rmin_l.
+apply Rge_minus; apply Rle_ge; left; elim H8; intros; assumption.
+unfold fct_cte in |- *; ring.
+rewrite RiemannInt_P15.
+rewrite Rmult_assoc; replace ((x + h0 - x) * Rabs (/ h0)) with 1.
+rewrite Rmult_1_r; unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2;
+ [ prove_sup0
+ | rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+ rewrite <- Rinv_r_sym;
+ [ rewrite Rmult_1_l; pattern eps at 1 in |- *; rewrite <- Rplus_0_r;
+ rewrite double; apply Rplus_lt_compat_l; assumption
+ | discrR ] ].
+rewrite Rabs_right.
+replace (x + h0 - x) with h0; [ idtac | ring ].
+apply Rinv_r_sym.
+assumption.
+apply Rle_ge; left; apply Rinv_0_lt_compat.
+elim r; intro.
+apply Rplus_lt_reg_r with x; rewrite Rplus_0_r; assumption.
+elim H5; symmetry in |- *; apply Rplus_eq_reg_l with x; rewrite Rplus_0_r;
+ assumption.
+apply Rle_lt_trans with
+ (RiemannInt
+ (RiemannInt_P16
+ (RiemannInt_P1
+ (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x))))) *
+ Rabs (/ h0)).
+do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l.
+apply Rabs_pos.
+replace
+ (RiemannInt (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x)))) with
+ (-
+ RiemannInt
+ (RiemannInt_P1 (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x))))).
+rewrite Rabs_Ropp;
+ apply
+ (RiemannInt_P17
+ (RiemannInt_P1
+ (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x))))
+ (RiemannInt_P16
+ (RiemannInt_P1
+ (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x))))));
+ auto with real.
+symmetry in |- *; apply RiemannInt_P8.
+apply Rle_lt_trans with
+ (RiemannInt (RiemannInt_P14 (x + h0) x (eps / 2)) * Rabs (/ h0)).
+do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l.
+apply Rabs_pos.
+apply RiemannInt_P19.
+auto with real.
+intros; replace (f x1 + -1 * fct_cte (f x) x1) with (f x1 - f x).
+unfold fct_cte in |- *; case (Req_dec x x1); intro.
+rewrite H9; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; left;
+ assumption.
+elim H3; intros; left; apply H11.
+repeat split.
+assumption.
+rewrite Rabs_left.
+apply Rplus_lt_reg_r with (x1 - x0); replace (x1 - x0 + x0) with x1;
+ [ idtac | ring ].
+replace (x1 - x0 + - (x1 - x)) with (x - x0); [ idtac | ring ].
+apply Rle_lt_trans with (x + h0).
+unfold Rminus in |- *; apply Rplus_le_compat_l; apply Ropp_le_cancel.
+rewrite Ropp_involutive; apply Rle_trans with (Rabs h0).
+rewrite <- Rabs_Ropp; apply RRle_abs.
+apply Rle_trans with del;
+ [ left; assumption | unfold del in |- *; apply Rmin_l ].
+elim H8; intros; assumption.
+apply Rplus_lt_reg_r with x; rewrite Rplus_0_r;
+ replace (x + (x1 - x)) with x1; [ elim H8; intros; assumption | ring ].
+unfold fct_cte in |- *; ring.
+rewrite RiemannInt_P15.
+rewrite Rmult_assoc; replace ((x - (x + h0)) * Rabs (/ h0)) with 1.
+rewrite Rmult_1_r; unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2;
+ [ prove_sup0
+ | rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+ rewrite <- Rinv_r_sym;
+ [ rewrite Rmult_1_l; pattern eps at 1 in |- *; rewrite <- Rplus_0_r;
+ rewrite double; apply Rplus_lt_compat_l; assumption
+ | discrR ] ].
+rewrite Rabs_left.
+replace (x - (x + h0)) with (- h0); [ idtac | ring ].
+rewrite Ropp_mult_distr_l_reverse; rewrite Ropp_mult_distr_r_reverse;
+ rewrite Ropp_involutive; apply Rinv_r_sym.
+assumption.
+apply Rinv_lt_0_compat.
+assert (H8 : x + h0 < x).
+auto with real.
+apply Rplus_lt_reg_r with x; rewrite Rplus_0_r; assumption.
+rewrite
+ (RiemannInt_P13 H7 (RiemannInt_P14 x (x + h0) (f x))
+ (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x))))
+ .
+ring.
+unfold Rdiv, Rminus in |- *; rewrite Rmult_plus_distr_r; ring.
+rewrite RiemannInt_P15; apply Rmult_eq_reg_l with h0;
+ [ unfold Rdiv in |- *; rewrite (Rmult_comm h0); repeat rewrite Rmult_assoc;
+ rewrite <- Rinv_l_sym; [ ring | assumption ]
+ | assumption ].
+cut (a <= x + h0).
+cut (x + h0 <= b).
+intros; unfold primitive in |- *.
+case (Rle_dec a (x + h0)); case (Rle_dec (x + h0) b); case (Rle_dec a x);
+ case (Rle_dec x b); intros; try (elim n; assumption || left; assumption).
+rewrite <- (RiemannInt_P26 (FTC_P1 h C0 r0 r) H7 (FTC_P1 h C0 r2 r1)); ring.
+apply Rplus_le_reg_l with (- x); replace (- x + (x + h0)) with h0;
+ [ idtac | ring ].
+rewrite Rplus_comm; apply Rle_trans with (Rabs h0).
+apply RRle_abs.
+apply Rle_trans with del;
+ [ left; assumption
+ | unfold del in |- *; apply Rle_trans with (Rmin (b - x) (x - a));
+ [ apply Rmin_r | apply Rmin_l ] ].
+apply Ropp_le_cancel; apply Rplus_le_reg_l with x;
+ replace (x + - (x + h0)) with (- h0); [ idtac | ring ].
+apply Rle_trans with (Rabs h0);
+ [ rewrite <- Rabs_Ropp; apply RRle_abs
+ | apply Rle_trans with del;
+ [ left; assumption
+ | unfold del in |- *; apply Rle_trans with (Rmin (b - x) (x - a));
+ apply Rmin_r ] ].
Qed.
-Lemma RiemannInt_P28 : (f:R->R;a,b,x:R;h:``a<=b``;C0:((x:R)``a<=x<=b``->(continuity_pt f x))) ``a<=x<=b`` -> (derivable_pt_lim (primitive h (FTC_P1 h C0)) x (f x)).
-Intro f; Intros; Elim h; Intro.
-Elim H; Clear H; Intros; Elim H; Intro.
-Elim H1; Intro.
-Apply RiemannInt_P27; Split; Assumption.
-Pose f_b := [x:R]``(f b)*(x-b)+(RiemannInt [(FTC_P1 h C0 h (FTC_P2 b))])``; Rewrite H3.
-Assert H4 : (derivable_pt_lim f_b b (f b)).
-Unfold f_b; Pattern 2 (f b); Replace (f b) with ``(f b)+0``.
-Change (derivable_pt_lim (plus_fct (mult_fct (fct_cte (f b)) (minus_fct id (fct_cte b))) (fct_cte (RiemannInt (FTC_P1 h C0 h (FTC_P2 b))))) b ``(f b)+0``).
-Apply derivable_pt_lim_plus.
-Pattern 2 (f b); Replace (f b) with ``0*((minus_fct id (fct_cte b)) b)+((fct_cte (f b)) b)*1``.
-Apply derivable_pt_lim_mult.
-Apply derivable_pt_lim_const.
-Replace R1 with ``1-0``; [Idtac | Ring].
-Apply derivable_pt_lim_minus.
-Apply derivable_pt_lim_id.
-Apply derivable_pt_lim_const.
-Unfold fct_cte; Ring.
-Apply derivable_pt_lim_const.
-Ring.
-Unfold derivable_pt_lim; Intros; Elim (H4 ? H5); Intros; Assert H7 : (continuity_pt f b).
-Apply C0; Split; [Left; Assumption | Right; Reflexivity].
-Assert H8 : ``0<eps/2``.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
-Elim (H7 ? H8); Unfold D_x no_cond dist; Simpl; Unfold R_dist; Intros; Pose del := (Rmin x0 (Rmin x1 ``b-a``)); Assert H10 : ``0<del``.
-Unfold del; Unfold Rmin; Case (total_order_Rle x1 ``b-a``); Intros.
-Case (total_order_Rle x0 x1); Intro; [Apply (cond_pos x0) | Elim H9; Intros; Assumption].
-Case (total_order_Rle x0 ``b-a``); Intro; [Apply (cond_pos x0) | Apply Rlt_Rminus; Assumption].
-Split with (mkposreal ? H10); Intros; Case (case_Rabsolu h0); Intro.
-Assert H14 : ``b+h0<b``.
-Pattern 2 b; Rewrite <- Rplus_Or; Apply Rlt_compatibility; Assumption.
-Assert H13 : (Riemann_integrable f ``b+h0`` b).
-Apply continuity_implies_RiemannInt.
-Left; Assumption.
-Intros; Apply C0; Elim H13; Intros; Split; Try Assumption.
-Apply Rle_trans with ``b+h0``; Try Assumption.
-Apply Rle_anti_compatibility with ``-a-h0``.
-Replace ``-a-h0+a`` with ``-h0``; [Idtac | Ring].
-Replace ``-a-h0+(b+h0)`` with ``b-a``; [Idtac | Ring].
-Apply Rle_trans with del.
-Apply Rle_trans with (Rabsolu h0).
-Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu.
-Left; Assumption.
-Unfold del; Apply Rle_trans with (Rmin x1 ``b-a``); Apply Rmin_r.
-Replace ``[(primitive h (FTC_P1 h C0) (b+h0))]-[(primitive h (FTC_P1 h C0) b)]`` with ``-(RiemannInt H13)``.
-Replace (f b) with ``-[(RiemannInt (RiemannInt_P14 (b+h0) b (f b)))]/h0``.
-Rewrite <- Rabsolu_Ropp; Unfold Rminus; Unfold Rdiv; Rewrite Ropp_mul1; Rewrite Ropp_distr1; Repeat Rewrite Ropp_Ropp; Replace ``(RiemannInt H13)*/h0+ -(RiemannInt (RiemannInt_P14 (b+h0) b (f b)))*/h0`` with ``((RiemannInt H13)-(RiemannInt (RiemannInt_P14 (b+h0) b (f b))))/h0``.
-Replace ``(RiemannInt H13)-(RiemannInt (RiemannInt_P14 (b+h0) b (f b)))`` with (RiemannInt (RiemannInt_P10 ``-1`` H13 (RiemannInt_P14 ``b+h0`` b (f b)))).
-Unfold Rdiv; Rewrite Rabsolu_mult; Apply Rle_lt_trans with ``(RiemannInt (RiemannInt_P16 (RiemannInt_P10 (-1) H13 (RiemannInt_P14 (b+h0) b (f b)))))*(Rabsolu (/h0))``.
-Do 2 Rewrite <- (Rmult_sym ``(Rabsolu (/h0))``); Apply Rle_monotony.
-Apply Rabsolu_pos.
-Apply (RiemannInt_P17 (RiemannInt_P10 ``-1`` H13 (RiemannInt_P14 ``b+h0`` b (f b))) (RiemannInt_P16 (RiemannInt_P10 ``-1`` H13 (RiemannInt_P14 ``b+h0`` b (f b))))); Left; Assumption.
-Apply Rle_lt_trans with ``(RiemannInt (RiemannInt_P14 (b+h0) b (eps/2)))*(Rabsolu (/h0))``.
-Do 2 Rewrite <- (Rmult_sym ``(Rabsolu (/h0))``); Apply Rle_monotony.
-Apply Rabsolu_pos.
-Apply RiemannInt_P19.
-Left; Assumption.
-Intros; Replace ``(f x2)+ -1*(fct_cte (f b) x2)`` with ``(f x2)-(f b)``.
-Unfold fct_cte; Case (Req_EM b x2); Intro.
-Rewrite H16; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Left; Assumption.
-Elim H9; Intros; Left; Apply H18.
-Repeat Split.
-Assumption.
-Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Rewrite Rabsolu_right.
-Apply Rlt_anti_compatibility with ``x2-x1``; Replace ``x2-x1+(b-x2)`` with ``b-x1``; [Idtac | Ring].
-Replace ``x2-x1+x1`` with x2; [Idtac | Ring].
-Apply Rlt_le_trans with ``b+h0``.
-2:Elim H15; Intros; Left; Assumption.
-Unfold Rminus; Apply Rlt_compatibility; Apply Ropp_Rlt; Rewrite Ropp_Ropp; Apply Rle_lt_trans with (Rabsolu h0).
-Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu.
-Apply Rlt_le_trans with del; [Assumption | Unfold del; Apply Rle_trans with (Rmin x1 ``b-a``); [Apply Rmin_r | Apply Rmin_l]].
-Apply Rle_sym1; Left; Apply Rlt_Rminus; Elim H15; Intros; Assumption.
-Unfold fct_cte; Ring.
-Rewrite RiemannInt_P15.
-Rewrite Rmult_assoc; Replace ``(b-(b+h0))*(Rabsolu (/h0))`` with R1.
-Rewrite Rmult_1r; Unfold Rdiv; Apply Rlt_monotony_contra with ``2``; [Sup0 | Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Pattern 1 eps; Rewrite <- Rplus_Or; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
-Rewrite Rabsolu_left.
-Apply r_Rmult_mult with h0; [Do 2 Rewrite (Rmult_sym h0); Rewrite Rmult_assoc; Rewrite Ropp_mul1; Rewrite <- Rinv_l_sym; [ Ring | Assumption ] | Assumption].
-Apply Rlt_Rinv2; Assumption.
-Rewrite (RiemannInt_P13 H13 (RiemannInt_P14 ``b+h0`` b (f b)) (RiemannInt_P10 ``-1`` H13 (RiemannInt_P14 ``b+h0`` b (f b)))); Ring.
-Unfold Rdiv Rminus; Rewrite Rmult_Rplus_distrl; Ring.
-Rewrite RiemannInt_P15.
-Rewrite <- Ropp_mul1; Apply r_Rmult_mult with h0; [Repeat Rewrite (Rmult_sym h0); Unfold Rdiv; Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Ring | Assumption] | Assumption].
-Cut ``a<=b+h0``.
-Cut ``b+h0<=b``.
-Intros; Unfold primitive; Case (total_order_Rle a ``b+h0``); Case (total_order_Rle ``b+h0`` b); Case (total_order_Rle a b); Case (total_order_Rle b b); Intros; Try (Elim n; Right; Reflexivity) Orelse (Elim n; Left; Assumption).
-Rewrite <- (RiemannInt_P26 (FTC_P1 h C0 r3 r2) H13 (FTC_P1 h C0 r1 r0)); Ring.
-Elim n; Assumption.
-Left; Assumption.
-Apply Rle_anti_compatibility with ``-a-h0``.
-Replace ``-a-h0+a`` with ``-h0``; [Idtac | Ring].
-Replace ``-a-h0+(b+h0)`` with ``b-a``; [Idtac | Ring].
-Apply Rle_trans with del.
-Apply Rle_trans with (Rabsolu h0).
-Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu.
-Left; Assumption.
-Unfold del; Apply Rle_trans with (Rmin x1 ``b-a``); Apply Rmin_r.
-Cut (primitive h (FTC_P1 h C0) b)==(f_b b).
-Intro; Cut (primitive h (FTC_P1 h C0) ``b+h0``)==(f_b ``b+h0``).
-Intro; Rewrite H13; Rewrite H14; Apply H6.
-Assumption.
-Apply Rlt_le_trans with del; [Assumption | Unfold del; Apply Rmin_l].
-Assert H14 : ``b<b+h0``.
-Pattern 1 b; Rewrite <- Rplus_Or; Apply Rlt_compatibility.
-Assert H14 := (Rle_sym2 ? ? r); Elim H14; Intro.
-Assumption.
-Elim H11; Symmetry; Assumption.
-Unfold primitive; Case (total_order_Rle a ``b+h0``); Case (total_order_Rle ``b+h0`` b); Intros; [Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r0 H14)) | Unfold f_b; Reflexivity | Elim n; Left; Apply Rlt_trans with b; Assumption | Elim n0; Left; Apply Rlt_trans with b; Assumption].
-Unfold f_b; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rmult_Or; Rewrite Rplus_Ol; Unfold primitive; Case (total_order_Rle a b); Case (total_order_Rle b b); Intros; [Apply RiemannInt_P5 | Elim n; Right; Reflexivity | Elim n; Left; Assumption | Elim n; Right; Reflexivity].
+Lemma RiemannInt_P28 :
+ forall (f:R -> R) (a b x:R) (h:a <= b)
+ (C0:forall x:R, a <= x <= b -> continuity_pt f x),
+ a <= x <= b -> derivable_pt_lim (primitive h (FTC_P1 h C0)) x (f x).
+intro f; intros; elim h; intro.
+elim H; clear H; intros; elim H; intro.
+elim H1; intro.
+apply RiemannInt_P27; split; assumption.
+pose
+ (f_b := fun x:R => f b * (x - b) + RiemannInt (FTC_P1 h C0 h (Rle_refl b)));
+ rewrite H3.
+assert (H4 : derivable_pt_lim f_b b (f b)).
+unfold f_b in |- *; pattern (f b) at 2 in |- *; replace (f b) with (f b + 0).
+change
+ (derivable_pt_lim
+ ((fct_cte (f b) * (id - fct_cte b))%F +
+ fct_cte (RiemannInt (FTC_P1 h C0 h (Rle_refl b)))) b (
+ f b + 0)) in |- *.
+apply derivable_pt_lim_plus.
+pattern (f b) at 2 in |- *;
+ replace (f b) with (0 * (id - fct_cte b)%F b + fct_cte (f b) b * 1).
+apply derivable_pt_lim_mult.
+apply derivable_pt_lim_const.
+replace 1 with (1 - 0); [ idtac | ring ].
+apply derivable_pt_lim_minus.
+apply derivable_pt_lim_id.
+apply derivable_pt_lim_const.
+unfold fct_cte in |- *; ring.
+apply derivable_pt_lim_const.
+ring.
+unfold derivable_pt_lim in |- *; intros; elim (H4 _ H5); intros;
+ assert (H7 : continuity_pt f b).
+apply C0; split; [ left; assumption | right; reflexivity ].
+assert (H8 : 0 < eps / 2).
+unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
+elim (H7 _ H8); unfold D_x, no_cond, dist in |- *; simpl in |- *;
+ unfold R_dist in |- *; intros; pose (del := Rmin x0 (Rmin x1 (b - a)));
+ assert (H10 : 0 < del).
+unfold del in |- *; unfold Rmin in |- *; case (Rle_dec x1 (b - a)); intros.
+case (Rle_dec x0 x1); intro;
+ [ apply (cond_pos x0) | elim H9; intros; assumption ].
+case (Rle_dec x0 (b - a)); intro;
+ [ apply (cond_pos x0) | apply Rlt_Rminus; assumption ].
+split with (mkposreal _ H10); intros; case (Rcase_abs h0); intro.
+assert (H14 : b + h0 < b).
+pattern b at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
+ assumption.
+assert (H13 : Riemann_integrable f (b + h0) b).
+apply continuity_implies_RiemannInt.
+left; assumption.
+intros; apply C0; elim H13; intros; split; try assumption.
+apply Rle_trans with (b + h0); try assumption.
+apply Rplus_le_reg_l with (- a - h0).
+replace (- a - h0 + a) with (- h0); [ idtac | ring ].
+replace (- a - h0 + (b + h0)) with (b - a); [ idtac | ring ].
+apply Rle_trans with del.
+apply Rle_trans with (Rabs h0).
+rewrite <- Rabs_Ropp; apply RRle_abs.
+left; assumption.
+unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a)); apply Rmin_r.
+replace (primitive h (FTC_P1 h C0) (b + h0) - primitive h (FTC_P1 h C0) b)
+ with (- RiemannInt H13).
+replace (f b) with (- RiemannInt (RiemannInt_P14 (b + h0) b (f b)) / h0).
+rewrite <- Rabs_Ropp; unfold Rminus in |- *; unfold Rdiv in |- *;
+ rewrite Ropp_mult_distr_l_reverse; rewrite Ropp_plus_distr;
+ repeat rewrite Ropp_involutive;
+ replace
+ (RiemannInt H13 * / h0 +
+ - RiemannInt (RiemannInt_P14 (b + h0) b (f b)) * / h0) with
+ ((RiemannInt H13 - RiemannInt (RiemannInt_P14 (b + h0) b (f b))) / h0).
+replace (RiemannInt H13 - RiemannInt (RiemannInt_P14 (b + h0) b (f b))) with
+ (RiemannInt (RiemannInt_P10 (-1) H13 (RiemannInt_P14 (b + h0) b (f b)))).
+unfold Rdiv in |- *; rewrite Rabs_mult;
+ apply Rle_lt_trans with
+ (RiemannInt
+ (RiemannInt_P16
+ (RiemannInt_P10 (-1) H13 (RiemannInt_P14 (b + h0) b (f b)))) *
+ Rabs (/ h0)).
+do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l.
+apply Rabs_pos.
+apply
+ (RiemannInt_P17 (RiemannInt_P10 (-1) H13 (RiemannInt_P14 (b + h0) b (f b)))
+ (RiemannInt_P16
+ (RiemannInt_P10 (-1) H13 (RiemannInt_P14 (b + h0) b (f b)))));
+ left; assumption.
+apply Rle_lt_trans with
+ (RiemannInt (RiemannInt_P14 (b + h0) b (eps / 2)) * Rabs (/ h0)).
+do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l.
+apply Rabs_pos.
+apply RiemannInt_P19.
+left; assumption.
+intros; replace (f x2 + -1 * fct_cte (f b) x2) with (f x2 - f b).
+unfold fct_cte in |- *; case (Req_dec b x2); intro.
+rewrite H16; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+ left; assumption.
+elim H9; intros; left; apply H18.
+repeat split.
+assumption.
+rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; rewrite Rabs_right.
+apply Rplus_lt_reg_r with (x2 - x1);
+ replace (x2 - x1 + (b - x2)) with (b - x1); [ idtac | ring ].
+replace (x2 - x1 + x1) with x2; [ idtac | ring ].
+apply Rlt_le_trans with (b + h0).
+2: elim H15; intros; left; assumption.
+unfold Rminus in |- *; apply Rplus_lt_compat_l; apply Ropp_lt_cancel;
+ rewrite Ropp_involutive; apply Rle_lt_trans with (Rabs h0).
+rewrite <- Rabs_Ropp; apply RRle_abs.
+apply Rlt_le_trans with del;
+ [ assumption
+ | unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a));
+ [ apply Rmin_r | apply Rmin_l ] ].
+apply Rle_ge; left; apply Rlt_Rminus; elim H15; intros; assumption.
+unfold fct_cte in |- *; ring.
+rewrite RiemannInt_P15.
+rewrite Rmult_assoc; replace ((b - (b + h0)) * Rabs (/ h0)) with 1.
+rewrite Rmult_1_r; unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2;
+ [ prove_sup0
+ | rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+ rewrite <- Rinv_r_sym;
+ [ rewrite Rmult_1_l; pattern eps at 1 in |- *; rewrite <- Rplus_0_r;
+ rewrite double; apply Rplus_lt_compat_l; assumption
+ | discrR ] ].
+rewrite Rabs_left.
+apply Rmult_eq_reg_l with h0;
+ [ do 2 rewrite (Rmult_comm h0); rewrite Rmult_assoc;
+ rewrite Ropp_mult_distr_l_reverse; rewrite <- Rinv_l_sym;
+ [ ring | assumption ]
+ | assumption ].
+apply Rinv_lt_0_compat; assumption.
+rewrite
+ (RiemannInt_P13 H13 (RiemannInt_P14 (b + h0) b (f b))
+ (RiemannInt_P10 (-1) H13 (RiemannInt_P14 (b + h0) b (f b))))
+ ; ring.
+unfold Rdiv, Rminus in |- *; rewrite Rmult_plus_distr_r; ring.
+rewrite RiemannInt_P15.
+rewrite <- Ropp_mult_distr_l_reverse; apply Rmult_eq_reg_l with h0;
+ [ repeat rewrite (Rmult_comm h0); unfold Rdiv in |- *;
+ repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym;
+ [ ring | assumption ]
+ | assumption ].
+cut (a <= b + h0).
+cut (b + h0 <= b).
+intros; unfold primitive in |- *; case (Rle_dec a (b + h0));
+ case (Rle_dec (b + h0) b); case (Rle_dec a b); case (Rle_dec b b);
+ intros; try (elim n; right; reflexivity) || (elim n; left; assumption).
+rewrite <- (RiemannInt_P26 (FTC_P1 h C0 r3 r2) H13 (FTC_P1 h C0 r1 r0)); ring.
+elim n; assumption.
+left; assumption.
+apply Rplus_le_reg_l with (- a - h0).
+replace (- a - h0 + a) with (- h0); [ idtac | ring ].
+replace (- a - h0 + (b + h0)) with (b - a); [ idtac | ring ].
+apply Rle_trans with del.
+apply Rle_trans with (Rabs h0).
+rewrite <- Rabs_Ropp; apply RRle_abs.
+left; assumption.
+unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a)); apply Rmin_r.
+cut (primitive h (FTC_P1 h C0) b = f_b b).
+intro; cut (primitive h (FTC_P1 h C0) (b + h0) = f_b (b + h0)).
+intro; rewrite H13; rewrite H14; apply H6.
+assumption.
+apply Rlt_le_trans with del;
+ [ assumption | unfold del in |- *; apply Rmin_l ].
+assert (H14 : b < b + h0).
+pattern b at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l.
+assert (H14 := Rge_le _ _ r); elim H14; intro.
+assumption.
+elim H11; symmetry in |- *; assumption.
+unfold primitive in |- *; case (Rle_dec a (b + h0));
+ case (Rle_dec (b + h0) b); intros;
+ [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 H14))
+ | unfold f_b in |- *; reflexivity
+ | elim n; left; apply Rlt_trans with b; assumption
+ | elim n0; left; apply Rlt_trans with b; assumption ].
+unfold f_b in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r;
+ rewrite Rmult_0_r; rewrite Rplus_0_l; unfold primitive in |- *;
+ case (Rle_dec a b); case (Rle_dec b b); intros;
+ [ apply RiemannInt_P5
+ | elim n; right; reflexivity
+ | elim n; left; assumption
+ | elim n; right; reflexivity ].
(*****)
-Pose f_a := [x:R]``(f a)*(x-a)``; Rewrite <- H2; Assert H3 : (derivable_pt_lim f_a a (f a)).
-Unfold f_a; Change (derivable_pt_lim (mult_fct (fct_cte (f a)) (minus_fct id (fct_cte a))) a (f a)); Pattern 2 (f a); Replace (f a) with ``0*((minus_fct id (fct_cte a)) a)+((fct_cte (f a)) a)*1``.
-Apply derivable_pt_lim_mult.
-Apply derivable_pt_lim_const.
-Replace R1 with ``1-0``; [Idtac | Ring].
-Apply derivable_pt_lim_minus.
-Apply derivable_pt_lim_id.
-Apply derivable_pt_lim_const.
-Unfold fct_cte; Ring.
-Unfold derivable_pt_lim; Intros; Elim (H3 ? H4); Intros.
-Assert H6 : (continuity_pt f a).
-Apply C0; Split; [Right; Reflexivity | Left; Assumption].
-Assert H7 : ``0<eps/2``.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
-Elim (H6 ? H7); Unfold D_x no_cond dist; Simpl; Unfold R_dist; Intros.
-Pose del := (Rmin x0 (Rmin x1 ``b-a``)).
-Assert H9 : ``0<del``.
-Unfold del; Unfold Rmin.
-Case (total_order_Rle x1 ``b-a``); Intros.
-Case (total_order_Rle x0 x1); Intro.
-Apply (cond_pos x0).
-Elim H8; Intros; Assumption.
-Case (total_order_Rle x0 ``b-a``); Intro.
-Apply (cond_pos x0).
-Apply Rlt_Rminus; Assumption.
-Split with (mkposreal ? H9).
-Intros; Case (case_Rabsolu h0); Intro.
-Assert H12 : ``a+h0<a``.
-Pattern 2 a; Rewrite <- Rplus_Or; Apply Rlt_compatibility; Assumption.
-Unfold primitive.
-Case (total_order_Rle a ``a+h0``); Case (total_order_Rle ``a+h0`` b); Case (total_order_Rle a a); Case (total_order_Rle a b); Intros; Try (Elim n; Left; Assumption) Orelse (Elim n; Right; Reflexivity).
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r3 H12)).
-Elim n; Left; Apply Rlt_trans with a; Assumption.
-Rewrite RiemannInt_P9; Replace R0 with (f_a a).
-Replace ``(f a)*(a+h0-a)`` with (f_a ``a+h0``).
-Apply H5; Try Assumption.
-Apply Rlt_le_trans with del; [Assumption | Unfold del; Apply Rmin_l].
-Unfold f_a; Ring.
-Unfold f_a; Ring.
-Elim n; Left; Apply Rlt_trans with a; Assumption.
-Assert H12 : ``a<a+h0``.
-Pattern 1 a; Rewrite <- Rplus_Or; Apply Rlt_compatibility.
-Assert H12 := (Rle_sym2 ? ? r); Elim H12; Intro.
-Assumption.
-Elim H10; Symmetry; Assumption.
-Assert H13 : (Riemann_integrable f a ``a+h0``).
-Apply continuity_implies_RiemannInt.
-Left; Assumption.
-Intros; Apply C0; Elim H13; Intros; Split; Try Assumption.
-Apply Rle_trans with ``a+h0``; Try Assumption.
-Apply Rle_anti_compatibility with ``-b-h0``.
-Replace ``-b-h0+b`` with ``-h0``; [Idtac | Ring].
-Replace ``-b-h0+(a+h0)`` with ``a-b``; [Idtac | Ring].
-Apply Ropp_Rle; Rewrite Ropp_Ropp; Rewrite Ropp_distr2; Apply Rle_trans with del.
-Apply Rle_trans with (Rabsolu h0); [Apply Rle_Rabsolu | Left; Assumption].
-Unfold del; Apply Rle_trans with (Rmin x1 ``b-a``); Apply Rmin_r.
-Replace ``(primitive h (FTC_P1 h C0) (a+h0))-(primitive h (FTC_P1 h C0) a)`` with ``(RiemannInt H13)``.
-Replace (f a) with ``(RiemannInt (RiemannInt_P14 a (a+h0) (f a)))/h0``.
-Replace ``(RiemannInt H13)/h0-(RiemannInt (RiemannInt_P14 a (a+h0) (f a)))/h0`` with ``((RiemannInt H13)-(RiemannInt (RiemannInt_P14 a (a+h0) (f a))))/h0``.
-Replace ``(RiemannInt H13)-(RiemannInt (RiemannInt_P14 a (a+h0) (f a)))`` with (RiemannInt (RiemannInt_P10 ``-1`` H13 (RiemannInt_P14 a ``a+h0`` (f a)))).
-Unfold Rdiv; Rewrite Rabsolu_mult; Apply Rle_lt_trans with ``(RiemannInt (RiemannInt_P16 (RiemannInt_P10 (-1) H13 (RiemannInt_P14 a (a+h0) (f a)))))*(Rabsolu (/h0))``.
-Do 2 Rewrite <- (Rmult_sym ``(Rabsolu (/h0))``); Apply Rle_monotony.
-Apply Rabsolu_pos.
-Apply (RiemannInt_P17 (RiemannInt_P10 ``-1`` H13 (RiemannInt_P14 a ``a+h0`` (f a))) (RiemannInt_P16 (RiemannInt_P10 ``-1`` H13 (RiemannInt_P14 a ``a+h0`` (f a))))); Left; Assumption.
-Apply Rle_lt_trans with ``(RiemannInt (RiemannInt_P14 a (a+h0) (eps/2)))*(Rabsolu (/h0))``.
-Do 2 Rewrite <- (Rmult_sym ``(Rabsolu (/h0))``); Apply Rle_monotony.
-Apply Rabsolu_pos.
-Apply RiemannInt_P19.
-Left; Assumption.
-Intros; Replace ``(f x2)+ -1*(fct_cte (f a) x2)`` with ``(f x2)-(f a)``.
-Unfold fct_cte; Case (Req_EM a x2); Intro.
-Rewrite H15; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Left; Assumption.
-Elim H8; Intros; Left; Apply H17; Repeat Split.
-Assumption.
-Rewrite Rabsolu_right.
-Apply Rlt_anti_compatibility with a; Replace ``a+(x2-a)`` with x2; [Idtac | Ring].
-Apply Rlt_le_trans with ``a+h0``.
-Elim H14; Intros; Assumption.
-Apply Rle_compatibility; Left; Apply Rle_lt_trans with (Rabsolu h0).
-Apply Rle_Rabsolu.
-Apply Rlt_le_trans with del; [Assumption | Unfold del; Apply Rle_trans with (Rmin x1 ``b-a``); [Apply Rmin_r | Apply Rmin_l]].
-Apply Rle_sym1; Left; Apply Rlt_Rminus; Elim H14; Intros; Assumption.
-Unfold fct_cte; Ring.
-Rewrite RiemannInt_P15.
-Rewrite Rmult_assoc; Replace ``((a+h0)-a)*(Rabsolu (/h0))`` with R1.
-Rewrite Rmult_1r; Unfold Rdiv; Apply Rlt_monotony_contra with ``2``; [Sup0 | Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Pattern 1 eps; Rewrite <- Rplus_Or; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
-Rewrite Rabsolu_right.
-Rewrite Rplus_sym; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or; Rewrite <- Rinv_r_sym; [ Reflexivity | Assumption ].
-Apply Rle_sym1; Left; Apply Rlt_Rinv; Assert H14 := (Rle_sym2 ? ? r); Elim H14; Intro.
-Assumption.
-Elim H10; Symmetry; Assumption.
-Rewrite (RiemannInt_P13 H13 (RiemannInt_P14 a ``a+h0`` (f a)) (RiemannInt_P10 ``-1`` H13 (RiemannInt_P14 a ``a+h0`` (f a)))); Ring.
-Unfold Rdiv Rminus; Rewrite Rmult_Rplus_distrl; Ring.
-Rewrite RiemannInt_P15.
-Rewrite Rplus_sym; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or; Unfold Rdiv; Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym; [ Ring | Assumption ].
-Cut ``a<=a+h0``.
-Cut ``a+h0<=b``.
-Intros; Unfold primitive; Case (total_order_Rle a ``a+h0``); Case (total_order_Rle ``a+h0`` b); Case (total_order_Rle a a); Case (total_order_Rle a b); Intros; Try (Elim n; Right; Reflexivity) Orelse (Elim n; Left; Assumption).
-Rewrite RiemannInt_P9; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply RiemannInt_P5.
-Elim n; Assumption.
-Elim n; Assumption.
-2:Left; Assumption.
-Apply Rle_anti_compatibility with ``-a``; Replace ``-a+(a+h0)`` with h0; [Idtac | Ring].
-Rewrite Rplus_sym; Apply Rle_trans with del; [Apply Rle_trans with (Rabsolu h0); [Apply Rle_Rabsolu | Left; Assumption] | Unfold del; Apply Rle_trans with (Rmin x1 ``b-a``); Apply Rmin_r].
+pose (f_a := fun x:R => f a * (x - a)); rewrite <- H2;
+ assert (H3 : derivable_pt_lim f_a a (f a)).
+unfold f_a in |- *;
+ change (derivable_pt_lim (fct_cte (f a) * (id - fct_cte a)%F) a (f a))
+ in |- *; pattern (f a) at 2 in |- *;
+ replace (f a) with (0 * (id - fct_cte a)%F a + fct_cte (f a) a * 1).
+apply derivable_pt_lim_mult.
+apply derivable_pt_lim_const.
+replace 1 with (1 - 0); [ idtac | ring ].
+apply derivable_pt_lim_minus.
+apply derivable_pt_lim_id.
+apply derivable_pt_lim_const.
+unfold fct_cte in |- *; ring.
+unfold derivable_pt_lim in |- *; intros; elim (H3 _ H4); intros.
+assert (H6 : continuity_pt f a).
+apply C0; split; [ right; reflexivity | left; assumption ].
+assert (H7 : 0 < eps / 2).
+unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
+elim (H6 _ H7); unfold D_x, no_cond, dist in |- *; simpl in |- *;
+ unfold R_dist in |- *; intros.
+pose (del := Rmin x0 (Rmin x1 (b - a))).
+assert (H9 : 0 < del).
+unfold del in |- *; unfold Rmin in |- *.
+case (Rle_dec x1 (b - a)); intros.
+case (Rle_dec x0 x1); intro.
+apply (cond_pos x0).
+elim H8; intros; assumption.
+case (Rle_dec x0 (b - a)); intro.
+apply (cond_pos x0).
+apply Rlt_Rminus; assumption.
+split with (mkposreal _ H9).
+intros; case (Rcase_abs h0); intro.
+assert (H12 : a + h0 < a).
+pattern a at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
+ assumption.
+unfold primitive in |- *.
+case (Rle_dec a (a + h0)); case (Rle_dec (a + h0) b); case (Rle_dec a a);
+ case (Rle_dec a b); intros;
+ try (elim n; left; assumption) || (elim n; right; reflexivity).
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r3 H12)).
+elim n; left; apply Rlt_trans with a; assumption.
+rewrite RiemannInt_P9; replace 0 with (f_a a).
+replace (f a * (a + h0 - a)) with (f_a (a + h0)).
+apply H5; try assumption.
+apply Rlt_le_trans with del;
+ [ assumption | unfold del in |- *; apply Rmin_l ].
+unfold f_a in |- *; ring.
+unfold f_a in |- *; ring.
+elim n; left; apply Rlt_trans with a; assumption.
+assert (H12 : a < a + h0).
+pattern a at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l.
+assert (H12 := Rge_le _ _ r); elim H12; intro.
+assumption.
+elim H10; symmetry in |- *; assumption.
+assert (H13 : Riemann_integrable f a (a + h0)).
+apply continuity_implies_RiemannInt.
+left; assumption.
+intros; apply C0; elim H13; intros; split; try assumption.
+apply Rle_trans with (a + h0); try assumption.
+apply Rplus_le_reg_l with (- b - h0).
+replace (- b - h0 + b) with (- h0); [ idtac | ring ].
+replace (- b - h0 + (a + h0)) with (a - b); [ idtac | ring ].
+apply Ropp_le_cancel; rewrite Ropp_involutive; rewrite Ropp_minus_distr;
+ apply Rle_trans with del.
+apply Rle_trans with (Rabs h0); [ apply RRle_abs | left; assumption ].
+unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a)); apply Rmin_r.
+replace (primitive h (FTC_P1 h C0) (a + h0) - primitive h (FTC_P1 h C0) a)
+ with (RiemannInt H13).
+replace (f a) with (RiemannInt (RiemannInt_P14 a (a + h0) (f a)) / h0).
+replace
+ (RiemannInt H13 / h0 - RiemannInt (RiemannInt_P14 a (a + h0) (f a)) / h0)
+ with ((RiemannInt H13 - RiemannInt (RiemannInt_P14 a (a + h0) (f a))) / h0).
+replace (RiemannInt H13 - RiemannInt (RiemannInt_P14 a (a + h0) (f a))) with
+ (RiemannInt (RiemannInt_P10 (-1) H13 (RiemannInt_P14 a (a + h0) (f a)))).
+unfold Rdiv in |- *; rewrite Rabs_mult;
+ apply Rle_lt_trans with
+ (RiemannInt
+ (RiemannInt_P16
+ (RiemannInt_P10 (-1) H13 (RiemannInt_P14 a (a + h0) (f a)))) *
+ Rabs (/ h0)).
+do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l.
+apply Rabs_pos.
+apply
+ (RiemannInt_P17 (RiemannInt_P10 (-1) H13 (RiemannInt_P14 a (a + h0) (f a)))
+ (RiemannInt_P16
+ (RiemannInt_P10 (-1) H13 (RiemannInt_P14 a (a + h0) (f a)))));
+ left; assumption.
+apply Rle_lt_trans with
+ (RiemannInt (RiemannInt_P14 a (a + h0) (eps / 2)) * Rabs (/ h0)).
+do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l.
+apply Rabs_pos.
+apply RiemannInt_P19.
+left; assumption.
+intros; replace (f x2 + -1 * fct_cte (f a) x2) with (f x2 - f a).
+unfold fct_cte in |- *; case (Req_dec a x2); intro.
+rewrite H15; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+ left; assumption.
+elim H8; intros; left; apply H17; repeat split.
+assumption.
+rewrite Rabs_right.
+apply Rplus_lt_reg_r with a; replace (a + (x2 - a)) with x2; [ idtac | ring ].
+apply Rlt_le_trans with (a + h0).
+elim H14; intros; assumption.
+apply Rplus_le_compat_l; left; apply Rle_lt_trans with (Rabs h0).
+apply RRle_abs.
+apply Rlt_le_trans with del;
+ [ assumption
+ | unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a));
+ [ apply Rmin_r | apply Rmin_l ] ].
+apply Rle_ge; left; apply Rlt_Rminus; elim H14; intros; assumption.
+unfold fct_cte in |- *; ring.
+rewrite RiemannInt_P15.
+rewrite Rmult_assoc; replace ((a + h0 - a) * Rabs (/ h0)) with 1.
+rewrite Rmult_1_r; unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2;
+ [ prove_sup0
+ | rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+ rewrite <- Rinv_r_sym;
+ [ rewrite Rmult_1_l; pattern eps at 1 in |- *; rewrite <- Rplus_0_r;
+ rewrite double; apply Rplus_lt_compat_l; assumption
+ | discrR ] ].
+rewrite Rabs_right.
+rewrite Rplus_comm; unfold Rminus in |- *; rewrite Rplus_assoc;
+ rewrite Rplus_opp_r; rewrite Rplus_0_r; rewrite <- Rinv_r_sym;
+ [ reflexivity | assumption ].
+apply Rle_ge; left; apply Rinv_0_lt_compat; assert (H14 := Rge_le _ _ r);
+ elim H14; intro.
+assumption.
+elim H10; symmetry in |- *; assumption.
+rewrite
+ (RiemannInt_P13 H13 (RiemannInt_P14 a (a + h0) (f a))
+ (RiemannInt_P10 (-1) H13 (RiemannInt_P14 a (a + h0) (f a))))
+ ; ring.
+unfold Rdiv, Rminus in |- *; rewrite Rmult_plus_distr_r; ring.
+rewrite RiemannInt_P15.
+rewrite Rplus_comm; unfold Rminus in |- *; rewrite Rplus_assoc;
+ rewrite Rplus_opp_r; rewrite Rplus_0_r; unfold Rdiv in |- *;
+ rewrite Rmult_assoc; rewrite <- Rinv_r_sym; [ ring | assumption ].
+cut (a <= a + h0).
+cut (a + h0 <= b).
+intros; unfold primitive in |- *; case (Rle_dec a (a + h0));
+ case (Rle_dec (a + h0) b); case (Rle_dec a a); case (Rle_dec a b);
+ intros; try (elim n; right; reflexivity) || (elim n; left; assumption).
+rewrite RiemannInt_P9; unfold Rminus in |- *; rewrite Ropp_0;
+ rewrite Rplus_0_r; apply RiemannInt_P5.
+elim n; assumption.
+elim n; assumption.
+2: left; assumption.
+apply Rplus_le_reg_l with (- a); replace (- a + (a + h0)) with h0;
+ [ idtac | ring ].
+rewrite Rplus_comm; apply Rle_trans with del;
+ [ apply Rle_trans with (Rabs h0); [ apply RRle_abs | left; assumption ]
+ | unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a)); apply Rmin_r ].
(*****)
-Assert H1 : x==a.
-Rewrite <- H0 in H; Elim H; Intros; Apply Rle_antisym; Assumption.
-Pose f_a := [x:R]``(f a)*(x-a)``.
-Assert H2 : (derivable_pt_lim f_a a (f a)).
-Unfold f_a; Change (derivable_pt_lim (mult_fct (fct_cte (f a)) (minus_fct id (fct_cte a))) a (f a)); Pattern 2 (f a); Replace (f a) with ``0*((minus_fct id (fct_cte a)) a)+((fct_cte (f a)) a)*1``.
-Apply derivable_pt_lim_mult.
-Apply derivable_pt_lim_const.
-Replace R1 with ``1-0``; [Idtac | Ring].
-Apply derivable_pt_lim_minus.
-Apply derivable_pt_lim_id.
-Apply derivable_pt_lim_const.
-Unfold fct_cte; Ring.
-Pose f_b := [x:R]``(f b)*(x-b)+(RiemannInt (FTC_P1 h C0 b h (FTC_P2 b)))``.
-Assert H3 : (derivable_pt_lim f_b b (f b)).
-Unfold f_b; Pattern 2 (f b); Replace (f b) with ``(f b)+0``.
-Change (derivable_pt_lim (plus_fct (mult_fct (fct_cte (f b)) (minus_fct id (fct_cte b))) (fct_cte (RiemannInt (FTC_P1 h C0 h (FTC_P2 b))))) b ``(f b)+0``).
-Apply derivable_pt_lim_plus.
-Pattern 2 (f b); Replace (f b) with ``0*((minus_fct id (fct_cte b)) b)+((fct_cte (f b)) b)*1``.
-Apply derivable_pt_lim_mult.
-Apply derivable_pt_lim_const.
-Replace R1 with ``1-0``; [Idtac | Ring].
-Apply derivable_pt_lim_minus.
-Apply derivable_pt_lim_id.
-Apply derivable_pt_lim_const.
-Unfold fct_cte; Ring.
-Apply derivable_pt_lim_const.
-Ring.
-Unfold derivable_pt_lim; Intros; Elim (H2 ? H4); Intros; Elim (H3 ? H4); Intros; Pose del := (Rmin x0 x1).
-Assert H7 : ``0<del``.
-Unfold del; Unfold Rmin; Case (total_order_Rle x0 x1); Intro.
-Apply (cond_pos x0).
-Apply (cond_pos x1).
-Split with (mkposreal ? H7); Intros; Case (case_Rabsolu h0); Intro.
-Assert H10 : ``a+h0<a``.
-Pattern 2 a; Rewrite <- Rplus_Or; Apply Rlt_compatibility; Assumption.
-Rewrite H1; Unfold primitive; Case (total_order_Rle a ``a+h0``); Case (total_order_Rle ``a+h0`` b); Case (total_order_Rle a a); Case (total_order_Rle a b); Intros; Try (Elim n; Right; Assumption Orelse Reflexivity).
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r3 H10)).
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r2 H10)).
-Rewrite RiemannInt_P9; Replace R0 with (f_a a).
-Replace ``(f a)*(a+h0-a)`` with (f_a ``a+h0``).
-Apply H5; Try Assumption.
-Apply Rlt_le_trans with del; Try Assumption.
-Unfold del; Apply Rmin_l.
-Unfold f_a; Ring.
-Unfold f_a; Ring.
-Elim n; Rewrite <- H0; Left; Assumption.
-Assert H10 : ``a<a+h0``.
-Pattern 1 a; Rewrite <- Rplus_Or; Apply Rlt_compatibility.
-Assert H10 := (Rle_sym2 ? ? r); Elim H10; Intro.
-Assumption.
-Elim H8; Symmetry; Assumption.
-Rewrite H0 in H1; Rewrite H1; Unfold primitive; Case (total_order_Rle a ``b+h0``); Case (total_order_Rle ``b+h0`` b); Case (total_order_Rle a b); Case (total_order_Rle b b); Intros; Try (Elim n; Right; Assumption Orelse Reflexivity).
-Rewrite H0 in H10; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r2 H10)).
-Repeat Rewrite RiemannInt_P9.
-Replace (RiemannInt (FTC_P1 h C0 r1 r0)) with (f_b b).
-Fold (f_b ``b+h0``).
-Apply H6; Try Assumption.
-Apply Rlt_le_trans with del; Try Assumption.
-Unfold del; Apply Rmin_r.
-Unfold f_b; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rmult_Or; Rewrite Rplus_Ol; Apply RiemannInt_P5.
-Elim n; Rewrite <- H0; Left; Assumption.
-Elim n0; Rewrite <- H0; Left; Assumption.
+assert (H1 : x = a).
+rewrite <- H0 in H; elim H; intros; apply Rle_antisym; assumption.
+pose (f_a := fun x:R => f a * (x - a)).
+assert (H2 : derivable_pt_lim f_a a (f a)).
+unfold f_a in |- *;
+ change (derivable_pt_lim (fct_cte (f a) * (id - fct_cte a)%F) a (f a))
+ in |- *; pattern (f a) at 2 in |- *;
+ replace (f a) with (0 * (id - fct_cte a)%F a + fct_cte (f a) a * 1).
+apply derivable_pt_lim_mult.
+apply derivable_pt_lim_const.
+replace 1 with (1 - 0); [ idtac | ring ].
+apply derivable_pt_lim_minus.
+apply derivable_pt_lim_id.
+apply derivable_pt_lim_const.
+unfold fct_cte in |- *; ring.
+pose
+ (f_b := fun x:R => f b * (x - b) + RiemannInt (FTC_P1 h C0 h (Rle_refl b))).
+assert (H3 : derivable_pt_lim f_b b (f b)).
+unfold f_b in |- *; pattern (f b) at 2 in |- *; replace (f b) with (f b + 0).
+change
+ (derivable_pt_lim
+ ((fct_cte (f b) * (id - fct_cte b))%F +
+ fct_cte (RiemannInt (FTC_P1 h C0 h (Rle_refl b)))) b (
+ f b + 0)) in |- *.
+apply derivable_pt_lim_plus.
+pattern (f b) at 2 in |- *;
+ replace (f b) with (0 * (id - fct_cte b)%F b + fct_cte (f b) b * 1).
+apply derivable_pt_lim_mult.
+apply derivable_pt_lim_const.
+replace 1 with (1 - 0); [ idtac | ring ].
+apply derivable_pt_lim_minus.
+apply derivable_pt_lim_id.
+apply derivable_pt_lim_const.
+unfold fct_cte in |- *; ring.
+apply derivable_pt_lim_const.
+ring.
+unfold derivable_pt_lim in |- *; intros; elim (H2 _ H4); intros;
+ elim (H3 _ H4); intros; pose (del := Rmin x0 x1).
+assert (H7 : 0 < del).
+unfold del in |- *; unfold Rmin in |- *; case (Rle_dec x0 x1); intro.
+apply (cond_pos x0).
+apply (cond_pos x1).
+split with (mkposreal _ H7); intros; case (Rcase_abs h0); intro.
+assert (H10 : a + h0 < a).
+pattern a at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
+ assumption.
+rewrite H1; unfold primitive in |- *; case (Rle_dec a (a + h0));
+ case (Rle_dec (a + h0) b); case (Rle_dec a a); case (Rle_dec a b);
+ intros; try (elim n; right; assumption || reflexivity).
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r3 H10)).
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r2 H10)).
+rewrite RiemannInt_P9; replace 0 with (f_a a).
+replace (f a * (a + h0 - a)) with (f_a (a + h0)).
+apply H5; try assumption.
+apply Rlt_le_trans with del; try assumption.
+unfold del in |- *; apply Rmin_l.
+unfold f_a in |- *; ring.
+unfold f_a in |- *; ring.
+elim n; rewrite <- H0; left; assumption.
+assert (H10 : a < a + h0).
+pattern a at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l.
+assert (H10 := Rge_le _ _ r); elim H10; intro.
+assumption.
+elim H8; symmetry in |- *; assumption.
+rewrite H0 in H1; rewrite H1; unfold primitive in |- *;
+ case (Rle_dec a (b + h0)); case (Rle_dec (b + h0) b);
+ case (Rle_dec a b); case (Rle_dec b b); intros;
+ try (elim n; right; assumption || reflexivity).
+rewrite H0 in H10; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r2 H10)).
+repeat rewrite RiemannInt_P9.
+replace (RiemannInt (FTC_P1 h C0 r1 r0)) with (f_b b).
+fold (f_b (b + h0)) in |- *.
+apply H6; try assumption.
+apply Rlt_le_trans with del; try assumption.
+unfold del in |- *; apply Rmin_r.
+unfold f_b in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r;
+ rewrite Rmult_0_r; rewrite Rplus_0_l; apply RiemannInt_P5.
+elim n; rewrite <- H0; left; assumption.
+elim n0; rewrite <- H0; left; assumption.
Qed.
-Lemma RiemannInt_P29 : (f:R->R;a,b;h:``a<=b``;C0:((x:R)``a<=x<=b``->(continuity_pt f x))) (antiderivative f (primitive h (FTC_P1 h C0)) a b).
-Intro f; Intros; Unfold antiderivative; Split; Try Assumption; Intros; Assert H0 := (RiemannInt_P28 h C0 H); Assert H1 : (derivable_pt (primitive h (FTC_P1 h C0)) x); [Unfold derivable_pt; Split with (f x); Apply H0 | Split with H1; Symmetry; Apply derive_pt_eq_0; Apply H0].
+Lemma RiemannInt_P29 :
+ forall (f:R -> R) a b (h:a <= b)
+ (C0:forall x:R, a <= x <= b -> continuity_pt f x),
+ antiderivative f (primitive h (FTC_P1 h C0)) a b.
+intro f; intros; unfold antiderivative in |- *; split; try assumption; intros;
+ assert (H0 := RiemannInt_P28 h C0 H);
+ assert (H1 : derivable_pt (primitive h (FTC_P1 h C0)) x);
+ [ unfold derivable_pt in |- *; split with (f x); apply H0
+ | split with H1; symmetry in |- *; apply derive_pt_eq_0; apply H0 ].
Qed.
-Lemma RiemannInt_P30 : (f:R->R;a,b:R) ``a<=b`` -> ((x:R)``a<=x<=b``->(continuity_pt f x)) -> (sigTT ? [g:R->R](antiderivative f g a b)).
-Intros; Split with (primitive H (FTC_P1 H H0)); Apply RiemannInt_P29.
+Lemma RiemannInt_P30 :
+ forall (f:R -> R) (a b:R),
+ a <= b ->
+ (forall x:R, a <= x <= b -> continuity_pt f x) ->
+ sigT (fun g:R -> R => antiderivative f g a b).
+intros; split with (primitive H (FTC_P1 H H0)); apply RiemannInt_P29.
Qed.
-Record C1_fun : Type := mkC1 {
-c1 :> R->R;
-diff0 : (derivable c1);
-cont1 : (continuity (derive c1 diff0)) }.
+Record C1_fun : Type := mkC1
+ {c1 :> R -> R; diff0 : derivable c1; cont1 : continuity (derive c1 diff0)}.
-Lemma RiemannInt_P31 : (f:C1_fun;a,b:R) ``a<=b`` -> (antiderivative (derive f (diff0 f)) f a b).
-Intro f; Intros; Unfold antiderivative; Split; Try Assumption; Intros; Split with (diff0 f x); Reflexivity.
+Lemma RiemannInt_P31 :
+ forall (f:C1_fun) (a b:R),
+ a <= b -> antiderivative (derive f (diff0 f)) f a b.
+intro f; intros; unfold antiderivative in |- *; split; try assumption; intros;
+ split with (diff0 f x); reflexivity.
Qed.
-Lemma RiemannInt_P32 : (f:C1_fun;a,b:R) (Riemann_integrable (derive f (diff0 f)) a b).
-Intro f; Intros; Case (total_order_Rle a b); Intro; [Apply continuity_implies_RiemannInt; Try Assumption; Intros; Apply (cont1 f) | Assert H : ``b<=a``; [Auto with real | Apply RiemannInt_P1; Apply continuity_implies_RiemannInt; Try Assumption; Intros; Apply (cont1 f)]].
+Lemma RiemannInt_P32 :
+ forall (f:C1_fun) (a b:R), Riemann_integrable (derive f (diff0 f)) a b.
+intro f; intros; case (Rle_dec a b); intro;
+ [ apply continuity_implies_RiemannInt; try assumption; intros;
+ apply (cont1 f)
+ | assert (H : b <= a);
+ [ auto with real
+ | apply RiemannInt_P1; apply continuity_implies_RiemannInt;
+ try assumption; intros; apply (cont1 f) ] ].
Qed.
-Lemma RiemannInt_P33 : (f:C1_fun;a,b:R;pr:(Riemann_integrable (derive f (diff0 f)) a b)) ``a<=b`` -> (RiemannInt pr)==``(f b)-(f a)``.
-Intro f; Intros; Assert H0 : (x:R)``a<=x<=b``->(continuity_pt (derive f (diff0 f)) x).
-Intros; Apply (cont1 f).
-Rewrite (RiemannInt_P20 H (FTC_P1 H H0) pr); Assert H1 := (RiemannInt_P29 H H0); Assert H2 := (RiemannInt_P31 f H); Elim (antiderivative_Ucte (derive f (diff0 f)) ? ? ? ? H1 H2); Intros C H3; Repeat Rewrite H3; [Ring | Split; [Right; Reflexivity | Assumption] | Split; [Assumption | Right; Reflexivity]].
+Lemma RiemannInt_P33 :
+ forall (f:C1_fun) (a b:R) (pr:Riemann_integrable (derive f (diff0 f)) a b),
+ a <= b -> RiemannInt pr = f b - f a.
+intro f; intros;
+ assert
+ (H0 : forall x:R, a <= x <= b -> continuity_pt (derive f (diff0 f)) x).
+intros; apply (cont1 f).
+rewrite (RiemannInt_P20 H (FTC_P1 H H0) pr);
+ assert (H1 := RiemannInt_P29 H H0); assert (H2 := RiemannInt_P31 f H);
+ elim (antiderivative_Ucte (derive f (diff0 f)) _ _ _ _ H1 H2);
+ intros C H3; repeat rewrite H3;
+ [ ring
+ | split; [ right; reflexivity | assumption ]
+ | split; [ assumption | right; reflexivity ] ].
Qed.
-Lemma FTC_Riemann : (f:C1_fun;a,b:R;pr:(Riemann_integrable (derive f (diff0 f)) a b)) (RiemannInt pr)==``(f b)-(f a)``.
-Intro f; Intros; Case (total_order_Rle a b); Intro; [Apply RiemannInt_P33; Assumption | Assert H : ``b<=a``; [Auto with real | Assert H0 := (RiemannInt_P1 pr); Rewrite (RiemannInt_P8 pr H0); Rewrite (RiemannInt_P33 H0 H); Ring]].
-Qed.
+Lemma FTC_Riemann :
+ forall (f:C1_fun) (a b:R) (pr:Riemann_integrable (derive f (diff0 f)) a b),
+ RiemannInt pr = f b - f a.
+intro f; intros; case (Rle_dec a b); intro;
+ [ apply RiemannInt_P33; assumption
+ | assert (H : b <= a);
+ [ auto with real
+ | assert (H0 := RiemannInt_P1 pr); rewrite (RiemannInt_P8 pr H0);
+ rewrite (RiemannInt_P33 _ H0 H); ring ] ].
+Qed. \ No newline at end of file
diff --git a/theories/Reals/RiemannInt_SF.v b/theories/Reals/RiemannInt_SF.v
index f81c57997..5f47466ac 100644
--- a/theories/Reals/RiemannInt_SF.v
+++ b/theories/Reals/RiemannInt_SF.v
@@ -8,1393 +8,2625 @@
(*i $Id$ i*)
-Require Rbase.
-Require Rfunctions.
-Require Ranalysis.
-Require Classical_Prop.
-V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
+Require Import Rbase.
+Require Import Rfunctions.
+Require Import Ranalysis.
+Require Import Classical_Prop.
Open Local Scope R_scope.
-Implicit Arguments On.
+Set Implicit Arguments.
(**************************************************)
(* Each bounded subset of N has a maximal element *)
(**************************************************)
-Definition Nbound [I:nat->Prop] : Prop := (EX n:nat | (i:nat)(I i)->(le i n)).
+Definition Nbound (I:nat -> Prop) : Prop :=
+ exists n : nat | (forall i:nat, I i -> (i <= n)%nat).
-Lemma IZN_var:(z:Z)(`0<=z`)->{ n:nat | z=(INZ n)}.
-Intros; Apply inject_nat_complete_inf; Assumption.
+Lemma IZN_var : forall z:Z, (0 <= z)%Z -> {n : nat | z = Z_of_nat n}.
+intros; apply Z_of_nat_complete_inf; assumption.
Qed.
-Lemma Nzorn : (I:nat->Prop) (EX n:nat | (I n)) -> (Nbound I) -> (sigTT ? [n:nat](I n)/\(i:nat)(I i)->(le i n)).
-Intros I H H0; Pose E := [x:R](EX i:nat | (I i)/\(INR i)==x); Assert H1 : (bound E).
-Unfold Nbound in H0; Elim H0; Intros N H1; Unfold bound; Exists (INR N); Unfold is_upper_bound; Intros; Unfold E in H2; Elim H2; Intros; Elim H3; Intros; Rewrite <- H5; Apply le_INR; Apply H1; Assumption.
-Assert H2 : (EXT x:R | (E x)).
-Elim H; Intros; Exists (INR x); Unfold E; Exists x; Split; [Assumption | Reflexivity].
-Assert H3 := (complet E H1 H2); Elim H3; Intros; Unfold is_lub in p; Elim p; Clear p; Intros; Unfold is_upper_bound in H4 H5; Assert H6 : ``0<=x``.
-Elim H2; Intros; Unfold E in H6; Elim H6; Intros; Elim H7; Intros; Apply Rle_trans with x0; [Rewrite <- H9; Change ``(INR O)<=(INR x1)``; Apply le_INR; Apply le_O_n | Apply H4; Assumption].
-Assert H7 := (archimed x); Elim H7; Clear H7; Intros; Assert H9 : ``x<=(IZR (up x))-1``.
-Apply H5; Intros; Assert H10 := (H4 ? H9); Unfold E in H9; Elim H9; Intros; Elim H11; Intros; Rewrite <- H13; Apply Rle_anti_compatibility with R1; Replace ``1+((IZR (up x))-1)`` with (IZR (up x)); [Idtac | Ring]; Replace ``1+(INR x1)`` with (INR (S x1)); [Idtac | Rewrite S_INR; Ring].
-Assert H14 : `0<=(up x)`.
-Apply le_IZR; Apply Rle_trans with x; [Apply H6 | Left; Assumption].
-Assert H15 := (IZN ? H14); Elim H15; Clear H15; Intros; Rewrite H15; Rewrite <- INR_IZR_INZ; Apply le_INR; Apply lt_le_S; Apply INR_lt; Rewrite H13; Apply Rle_lt_trans with x; [Assumption | Rewrite INR_IZR_INZ; Rewrite <- H15; Assumption].
-Assert H10 : ``x==(IZR (up x))-1``.
-Apply Rle_antisym; [Assumption | Apply Rle_anti_compatibility with ``-x+1``; Replace `` -x+1+((IZR (up x))-1)`` with ``(IZR (up x))-x``; [Idtac | Ring]; Replace ``-x+1+x`` with R1; [Assumption | Ring]].
-Assert H11 : `0<=(up x)`.
-Apply le_IZR; Apply Rle_trans with x; [Apply H6 | Left; Assumption].
-Assert H12 := (IZN_var H11); Elim H12; Clear H12; Intros; Assert H13 : (E x).
-Elim (classic (E x)); Intro; Try Assumption.
-Cut ((y:R)(E y)->``y<=x-1``).
-Intro; Assert H14 := (H5 ? H13); Cut ``x-1<x``.
-Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H14 H15)).
-Apply Rminus_lt; Replace ``x-1-x`` with ``-1``; [Idtac | Ring]; Rewrite <- Ropp_O; Apply Rlt_Ropp; Apply Rlt_R0_R1.
-Intros; Assert H14 := (H4 ? H13); Elim H14; Intro; Unfold E in H13; Elim H13; Intros; Elim H16; Intros; Apply Rle_anti_compatibility with R1.
-Replace ``1+(x-1)`` with x; [Idtac | Ring]; Rewrite <- H18; Replace ``1+(INR x1)`` with (INR (S x1)); [Idtac | Rewrite S_INR; Ring].
-Cut x==(INR (pred x0)).
-Intro; Rewrite H19; Apply le_INR; Apply lt_le_S; Apply INR_lt; Rewrite H18; Rewrite <- H19; Assumption.
-Rewrite H10; Rewrite p; Rewrite <- INR_IZR_INZ; Replace R1 with (INR (S O)); [Idtac | Reflexivity]; Rewrite <- minus_INR.
-Replace (minus x0 (S O)) with (pred x0); [Reflexivity | Case x0; [Reflexivity | Intro; Simpl; Apply minus_n_O]].
-Induction x0; [Rewrite p in H7; Rewrite <- INR_IZR_INZ in H7; Simpl in H7; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H6 H7)) | Apply le_n_S; Apply le_O_n].
-Rewrite H15 in H13; Elim H12; Assumption.
-Split with (pred x0); Unfold E in H13; Elim H13; Intros; Elim H12; Intros; Rewrite H10 in H15; Rewrite p in H15; Rewrite <- INR_IZR_INZ in H15; Assert H16 : ``(INR x0)==(INR x1)+1``.
-Rewrite H15; Ring.
-Rewrite <- S_INR in H16; Assert H17 := (INR_eq ? ? H16); Rewrite H17; Simpl; Split.
-Assumption.
-Intros; Apply INR_le; Rewrite H15; Rewrite <- H15; Elim H12; Intros; Rewrite H20; Apply H4; Unfold E; Exists i; Split; [Assumption | Reflexivity].
+Lemma Nzorn :
+ forall I:nat -> Prop,
+ ( exists n : nat | I n) ->
+ Nbound I -> sigT (fun n:nat => I n /\ (forall i:nat, I i -> (i <= n)%nat)).
+intros I H H0; pose (E := fun x:R => exists i : nat | I i /\ INR i = x);
+ assert (H1 : bound E).
+unfold Nbound in H0; elim H0; intros N H1; unfold bound in |- *;
+ exists (INR N); unfold is_upper_bound in |- *; intros;
+ unfold E in H2; elim H2; intros; elim H3; intros;
+ rewrite <- H5; apply le_INR; apply H1; assumption.
+assert (H2 : exists x : R | E x).
+elim H; intros; exists (INR x); unfold E in |- *; exists x; split;
+ [ assumption | reflexivity ].
+assert (H3 := completeness E H1 H2); elim H3; intros; unfold is_lub in p;
+ elim p; clear p; intros; unfold is_upper_bound in H4, H5;
+ assert (H6 : 0 <= x).
+elim H2; intros; unfold E in H6; elim H6; intros; elim H7; intros;
+ apply Rle_trans with x0;
+ [ rewrite <- H9; change (INR 0 <= INR x1) in |- *; apply le_INR;
+ apply le_O_n
+ | apply H4; assumption ].
+assert (H7 := archimed x); elim H7; clear H7; intros;
+ assert (H9 : x <= IZR (up x) - 1).
+apply H5; intros; assert (H10 := H4 _ H9); unfold E in H9; elim H9; intros;
+ elim H11; intros; rewrite <- H13; apply Rplus_le_reg_l with 1;
+ replace (1 + (IZR (up x) - 1)) with (IZR (up x));
+ [ idtac | ring ]; replace (1 + INR x1) with (INR (S x1));
+ [ idtac | rewrite S_INR; ring ].
+assert (H14 : (0 <= up x)%Z).
+apply le_IZR; apply Rle_trans with x; [ apply H6 | left; assumption ].
+assert (H15 := IZN _ H14); elim H15; clear H15; intros; rewrite H15;
+ rewrite <- INR_IZR_INZ; apply le_INR; apply lt_le_S;
+ apply INR_lt; rewrite H13; apply Rle_lt_trans with x;
+ [ assumption | rewrite INR_IZR_INZ; rewrite <- H15; assumption ].
+assert (H10 : x = IZR (up x) - 1).
+apply Rle_antisym;
+ [ assumption
+ | apply Rplus_le_reg_l with (- x + 1);
+ replace (- x + 1 + (IZR (up x) - 1)) with (IZR (up x) - x);
+ [ idtac | ring ]; replace (- x + 1 + x) with 1;
+ [ assumption | ring ] ].
+assert (H11 : (0 <= up x)%Z).
+apply le_IZR; apply Rle_trans with x; [ apply H6 | left; assumption ].
+assert (H12 := IZN_var H11); elim H12; clear H12; intros; assert (H13 : E x).
+elim (classic (E x)); intro; try assumption.
+cut (forall y:R, E y -> y <= x - 1).
+intro; assert (H14 := H5 _ H13); cut (x - 1 < x).
+intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H14 H15)).
+apply Rminus_lt; replace (x - 1 - x) with (-1); [ idtac | ring ];
+ rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; apply Rlt_0_1.
+intros; assert (H14 := H4 _ H13); elim H14; intro; unfold E in H13; elim H13;
+ intros; elim H16; intros; apply Rplus_le_reg_l with 1.
+replace (1 + (x - 1)) with x; [ idtac | ring ]; rewrite <- H18;
+ replace (1 + INR x1) with (INR (S x1)); [ idtac | rewrite S_INR; ring ].
+cut (x = INR (pred x0)).
+intro; rewrite H19; apply le_INR; apply lt_le_S; apply INR_lt; rewrite H18;
+ rewrite <- H19; assumption.
+rewrite H10; rewrite p; rewrite <- INR_IZR_INZ; replace 1 with (INR 1);
+ [ idtac | reflexivity ]; rewrite <- minus_INR.
+replace (x0 - 1)%nat with (pred x0);
+ [ reflexivity
+ | case x0; [ reflexivity | intro; simpl in |- *; apply minus_n_O ] ].
+induction x0 as [| x0 Hrecx0];
+ [ rewrite p in H7; rewrite <- INR_IZR_INZ in H7; simpl in H7;
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H6 H7))
+ | apply le_n_S; apply le_O_n ].
+rewrite H15 in H13; elim H12; assumption.
+split with (pred x0); unfold E in H13; elim H13; intros; elim H12; intros;
+ rewrite H10 in H15; rewrite p in H15; rewrite <- INR_IZR_INZ in H15;
+ assert (H16 : INR x0 = INR x1 + 1).
+rewrite H15; ring.
+rewrite <- S_INR in H16; assert (H17 := INR_eq _ _ H16); rewrite H17;
+ simpl in |- *; split.
+assumption.
+intros; apply INR_le; rewrite H15; rewrite <- H15; elim H12; intros;
+ rewrite H20; apply H4; unfold E in |- *; exists i;
+ split; [ assumption | reflexivity ].
Qed.
(*******************************************)
(* Step functions *)
(*******************************************)
-Definition open_interval [a,b:R] : R->Prop := [x:R]``a<x<b``.
-Definition co_interval [a,b:R] : R->Prop := [x:R]``a<=x<b``.
+Definition open_interval (a b x:R) : Prop := a < x < b.
+Definition co_interval (a b x:R) : Prop := a <= x < b.
-Definition adapted_couple [f:R->R;a,b:R;l,lf:Rlist] : Prop := (ordered_Rlist l)/\``(pos_Rl l O)==(Rmin a b)``/\``(pos_Rl l (pred (Rlength l)))==(Rmax a b)``/\(Rlength l)=(S (Rlength lf))/\(i:nat)(lt i (pred (Rlength l)))->(constant_D_eq f (open_interval (pos_Rl l i) (pos_Rl l (S i))) (pos_Rl lf i)).
+Definition adapted_couple (f:R -> R) (a b:R) (l lf:Rlist) : Prop :=
+ ordered_Rlist l /\
+ pos_Rl l 0 = Rmin a b /\
+ pos_Rl l (pred (Rlength l)) = Rmax a b /\
+ Rlength l = S (Rlength lf) /\
+ (forall i:nat,
+ (i < pred (Rlength l))%nat ->
+ constant_D_eq f (open_interval (pos_Rl l i) (pos_Rl l (S i)))
+ (pos_Rl lf i)).
-Definition adapted_couple_opt [f:R->R;a,b:R;l,lf:Rlist] := (adapted_couple f a b l lf)/\((i:nat)(lt i (pred (Rlength lf)))->(``(pos_Rl lf i)<>(pos_Rl lf (S i))``\/``(f (pos_Rl l (S i)))<>(pos_Rl lf i)``))/\((i:nat)(lt i (pred (Rlength l)))->``(pos_Rl l i)<>(pos_Rl l (S i))``).
+Definition adapted_couple_opt (f:R -> R) (a b:R) (l lf:Rlist) :=
+ adapted_couple f a b l lf /\
+ (forall i:nat,
+ (i < pred (Rlength lf))%nat ->
+ pos_Rl lf i <> pos_Rl lf (S i) \/ f (pos_Rl l (S i)) <> pos_Rl lf i) /\
+ (forall i:nat, (i < pred (Rlength l))%nat -> pos_Rl l i <> pos_Rl l (S i)).
-Definition is_subdivision [f:R->R;a,b:R;l:Rlist] : Type := (sigTT ? [l0:Rlist](adapted_couple f a b l l0)).
+Definition is_subdivision (f:R -> R) (a b:R) (l:Rlist) : Type :=
+ sigT (fun l0:Rlist => adapted_couple f a b l l0).
-Definition IsStepFun [f:R->R;a,b:R] : Type := (SigT ? [l:Rlist](is_subdivision f a b l)).
+Definition IsStepFun (f:R -> R) (a b:R) : Type :=
+ sigT (fun l:Rlist => is_subdivision f a b l).
(* Class of step functions *)
-Record StepFun [a,b:R] : Type := mkStepFun {
- fe:> R->R;
- pre:(IsStepFun fe a b)}.
-
-Definition subdivision [a,b:R;f:(StepFun a b)] : Rlist := (projT1 ? ? (pre f)).
-
-Definition subdivision_val [a,b:R;f:(StepFun a b)] : Rlist := Cases (projT2 ? ? (pre f)) of (existTT a b) => a end.
-
-Fixpoint Int_SF [l:Rlist] : Rlist -> R :=
-[k:Rlist] Cases l of
-| nil => R0
-| (cons a l') => Cases k of
- | nil => R0
- | (cons x nil) => R0
- | (cons x (cons y k')) => ``a*(y-x)+(Int_SF l' (cons y k'))``
- end
-end.
+Record StepFun (a b:R) : Type := mkStepFun
+ {fe :> R -> R; pre : IsStepFun fe a b}.
+
+Definition subdivision (a b:R) (f:StepFun a b) : Rlist := projT1 (pre f).
+
+Definition subdivision_val (a b:R) (f:StepFun a b) : Rlist :=
+ match projT2 (pre f) with
+ | existT a b => a
+ end.
+
+Fixpoint Int_SF (l k:Rlist) {struct l} : R :=
+ match l with
+ | nil => 0
+ | cons a l' =>
+ match k with
+ | nil => 0
+ | cons x nil => 0
+ | cons x (cons y k') => a * (y - x) + Int_SF l' (cons y k')
+ end
+ end.
(* Integral of step functions *)
-Definition RiemannInt_SF [a,b:R;f:(StepFun a b)] : R :=
-Cases (total_order_Rle a b) of
- (leftT _) => (Int_SF (subdivision_val f) (subdivision f))
-| (rightT _) => ``-(Int_SF (subdivision_val f) (subdivision f))``
-end.
+Definition RiemannInt_SF (a b:R) (f:StepFun a b) : R :=
+ match Rle_dec a b with
+ | left _ => Int_SF (subdivision_val f) (subdivision f)
+ | right _ => - Int_SF (subdivision_val f) (subdivision f)
+ end.
(********************************)
(* Properties of step functions *)
(********************************)
-Lemma StepFun_P1 : (a,b:R;f:(StepFun a b)) (adapted_couple f a b (subdivision f) (subdivision_val f)).
-Intros a b f; Unfold subdivision_val; Case (projT2 Rlist ([l:Rlist](is_subdivision f a b l)) (pre f)); Intros; Apply a0.
+Lemma StepFun_P1 :
+ forall (a b:R) (f:StepFun a b),
+ adapted_couple f a b (subdivision f) (subdivision_val f).
+intros a b f; unfold subdivision_val in |- *; case (projT2 (pre f)); intros;
+ apply a0.
Qed.
-Lemma StepFun_P2 : (a,b:R;f:R->R;l,lf:Rlist) (adapted_couple f a b l lf) -> (adapted_couple f b a l lf).
-Unfold adapted_couple; Intros; Decompose [and] H; Clear H; Repeat Split; Try Assumption.
-Rewrite H2; Unfold Rmin; Case (total_order_Rle a b); Intro; Case (total_order_Rle b a); Intro; Try Reflexivity.
-Apply Rle_antisym; Assumption.
-Apply Rle_antisym; Auto with real.
-Rewrite H1; Unfold Rmax; Case (total_order_Rle a b); Intro; Case (total_order_Rle b a); Intro; Try Reflexivity.
-Apply Rle_antisym; Assumption.
-Apply Rle_antisym; Auto with real.
+Lemma StepFun_P2 :
+ forall (a b:R) (f:R -> R) (l lf:Rlist),
+ adapted_couple f a b l lf -> adapted_couple f b a l lf.
+unfold adapted_couple in |- *; intros; decompose [and] H; clear H;
+ repeat split; try assumption.
+rewrite H2; unfold Rmin in |- *; case (Rle_dec a b); intro;
+ case (Rle_dec b a); intro; try reflexivity.
+apply Rle_antisym; assumption.
+apply Rle_antisym; auto with real.
+rewrite H1; unfold Rmax in |- *; case (Rle_dec a b); intro;
+ case (Rle_dec b a); intro; try reflexivity.
+apply Rle_antisym; assumption.
+apply Rle_antisym; auto with real.
Qed.
-Lemma StepFun_P3 : (a,b,c:R) ``a<=b`` -> (adapted_couple (fct_cte c) a b (cons a (cons b nil)) (cons c nil)).
-Intros; Unfold adapted_couple; Repeat Split.
-Unfold ordered_Rlist; Intros; Simpl in H0; Inversion H0; [Simpl; Assumption | Elim (le_Sn_O ? H2)].
-Simpl; Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Simpl; Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Unfold constant_D_eq open_interval; Intros; Simpl in H0; Inversion H0; [Reflexivity | Elim (le_Sn_O ? H3)].
+Lemma StepFun_P3 :
+ forall a b c:R,
+ a <= b ->
+ adapted_couple (fct_cte c) a b (cons a (cons b nil)) (cons c nil).
+intros; unfold adapted_couple in |- *; repeat split.
+unfold ordered_Rlist in |- *; intros; simpl in H0; inversion H0;
+ [ simpl in |- *; assumption | elim (le_Sn_O _ H2) ].
+simpl in |- *; unfold Rmin in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n; assumption ].
+simpl in |- *; unfold Rmax in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n; assumption ].
+unfold constant_D_eq, open_interval in |- *; intros; simpl in H0;
+ inversion H0; [ reflexivity | elim (le_Sn_O _ H3) ].
Qed.
-Lemma StepFun_P4 : (a,b,c:R) (IsStepFun (fct_cte c) a b).
-Intros; Unfold IsStepFun; Case (total_order_Rle a b); Intro.
-Apply Specif.existT with (cons a (cons b nil)); Unfold is_subdivision; Apply existTT with (cons c nil); Apply (StepFun_P3 c r).
-Apply Specif.existT with (cons b (cons a nil)); Unfold is_subdivision; Apply existTT with (cons c nil); Apply StepFun_P2; Apply StepFun_P3; Auto with real.
+Lemma StepFun_P4 : forall a b c:R, IsStepFun (fct_cte c) a b.
+intros; unfold IsStepFun in |- *; case (Rle_dec a b); intro.
+apply existT with (cons a (cons b nil)); unfold is_subdivision in |- *;
+ apply existT with (cons c nil); apply (StepFun_P3 c r).
+apply existT with (cons b (cons a nil)); unfold is_subdivision in |- *;
+ apply existT with (cons c nil); apply StepFun_P2;
+ apply StepFun_P3; auto with real.
Qed.
-Lemma StepFun_P5 : (a,b:R;f:R->R;l:Rlist) (is_subdivision f a b l) -> (is_subdivision f b a l).
-Unfold is_subdivision; Intros; Elim X; Intros; Exists x; Unfold adapted_couple in p; Decompose [and] p; Clear p; Unfold adapted_couple; Repeat Split; Try Assumption.
-Rewrite H1; Unfold Rmin; Case (total_order_Rle a b); Intro; Case (total_order_Rle b a); Intro; Try Reflexivity.
-Apply Rle_antisym; Assumption.
-Apply Rle_antisym; Auto with real.
-Rewrite H0; Unfold Rmax; Case (total_order_Rle a b); Intro; Case (total_order_Rle b a); Intro; Try Reflexivity.
-Apply Rle_antisym; Assumption.
-Apply Rle_antisym; Auto with real.
+Lemma StepFun_P5 :
+ forall (a b:R) (f:R -> R) (l:Rlist),
+ is_subdivision f a b l -> is_subdivision f b a l.
+unfold is_subdivision in |- *; intros; elim X; intros; exists x;
+ unfold adapted_couple in p; decompose [and] p; clear p;
+ unfold adapted_couple in |- *; repeat split; try assumption.
+rewrite H1; unfold Rmin in |- *; case (Rle_dec a b); intro;
+ case (Rle_dec b a); intro; try reflexivity.
+apply Rle_antisym; assumption.
+apply Rle_antisym; auto with real.
+rewrite H0; unfold Rmax in |- *; case (Rle_dec a b); intro;
+ case (Rle_dec b a); intro; try reflexivity.
+apply Rle_antisym; assumption.
+apply Rle_antisym; auto with real.
Qed.
-Lemma StepFun_P6 : (f:R->R;a,b:R) (IsStepFun f a b) -> (IsStepFun f b a).
-Unfold IsStepFun; Intros; Elim X; Intros; Apply Specif.existT with x; Apply StepFun_P5; Assumption.
+Lemma StepFun_P6 :
+ forall (f:R -> R) (a b:R), IsStepFun f a b -> IsStepFun f b a.
+unfold IsStepFun in |- *; intros; elim X; intros; apply existT with x;
+ apply StepFun_P5; assumption.
Qed.
-Lemma StepFun_P7 : (a,b,r1,r2,r3:R;f:R->R;l,lf:Rlist) ``a<=b`` -> (adapted_couple f a b (cons r1 (cons r2 l)) (cons r3 lf)) -> (adapted_couple f r2 b (cons r2 l) lf).
-Unfold adapted_couple; Intros; Decompose [and] H0; Clear H0; Assert H5 : (Rmax a b)==b.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Assert H7 : ``r2<=b``.
-Rewrite H5 in H2; Rewrite <- H2; Apply RList_P7; [Assumption | Simpl; Right; Left; Reflexivity].
-Repeat Split.
-Apply RList_P4 with r1; Assumption.
-Rewrite H5 in H2; Unfold Rmin; Case (total_order_Rle r2 b); Intro; [Reflexivity | Elim n; Assumption].
-Unfold Rmax; Case (total_order_Rle r2 b); Intro; [Rewrite H5 in H2; Rewrite <- H2; Reflexivity | Elim n; Assumption].
-Simpl in H4; Simpl; Apply INR_eq; Apply r_Rplus_plus with R1; Do 2 Rewrite (Rplus_sym R1); Do 2 Rewrite <- S_INR; Rewrite H4; Reflexivity.
-Intros; Unfold constant_D_eq open_interval; Intros; Unfold constant_D_eq open_interval in H6; Assert H9 : (lt (S i) (pred (Rlength (cons r1 (cons r2 l))))).
-Simpl; Simpl in H0; Apply lt_n_S; Assumption.
-Assert H10 := (H6 ? H9); Apply H10; Assumption.
+Lemma StepFun_P7 :
+ forall (a b r1 r2 r3:R) (f:R -> R) (l lf:Rlist),
+ a <= b ->
+ adapted_couple f a b (cons r1 (cons r2 l)) (cons r3 lf) ->
+ adapted_couple f r2 b (cons r2 l) lf.
+unfold adapted_couple in |- *; intros; decompose [and] H0; clear H0;
+ assert (H5 : Rmax a b = b).
+unfold Rmax in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n; assumption ].
+assert (H7 : r2 <= b).
+rewrite H5 in H2; rewrite <- H2; apply RList_P7;
+ [ assumption | simpl in |- *; right; left; reflexivity ].
+repeat split.
+apply RList_P4 with r1; assumption.
+rewrite H5 in H2; unfold Rmin in |- *; case (Rle_dec r2 b); intro;
+ [ reflexivity | elim n; assumption ].
+unfold Rmax in |- *; case (Rle_dec r2 b); intro;
+ [ rewrite H5 in H2; rewrite <- H2; reflexivity | elim n; assumption ].
+simpl in H4; simpl in |- *; apply INR_eq; apply Rplus_eq_reg_l with 1;
+ do 2 rewrite (Rplus_comm 1); do 2 rewrite <- S_INR;
+ rewrite H4; reflexivity.
+intros; unfold constant_D_eq, open_interval in |- *; intros;
+ unfold constant_D_eq, open_interval in H6;
+ assert (H9 : (S i < pred (Rlength (cons r1 (cons r2 l))))%nat).
+simpl in |- *; simpl in H0; apply lt_n_S; assumption.
+assert (H10 := H6 _ H9); apply H10; assumption.
Qed.
-Lemma StepFun_P8 : (f:R->R;l1,lf1:Rlist;a,b:R) (adapted_couple f a b l1 lf1) -> a==b -> (Int_SF lf1 l1)==R0.
-Induction l1.
-Intros; Induction lf1; Reflexivity.
-Induction r0.
-Intros; Induction lf1.
-Reflexivity.
-Unfold adapted_couple in H0; Decompose [and] H0; Clear H0; Simpl in H5; Discriminate.
-Intros; Induction lf1.
-Reflexivity.
-Simpl; Cut r==r1.
-Intro; Rewrite H3; Rewrite (H0 lf1 r b).
-Ring.
-Rewrite H3; Apply StepFun_P7 with a r r3; [Right; Assumption | Assumption].
-Clear H H0 Hreclf1 r0; Unfold adapted_couple in H1; Decompose [and] H1; Intros; Simpl in H4; Rewrite H4; Unfold Rmin; Case (total_order_Rle a b); Intro; [Assumption | Reflexivity].
-Unfold adapted_couple in H1; Decompose [and] H1; Intros; Apply Rle_antisym.
-Apply (H3 O); Simpl; Apply lt_O_Sn.
-Simpl in H5; Rewrite H2 in H5; Rewrite H5; Replace (Rmin b b) with (Rmax a b); [Rewrite <- H4; Apply RList_P7; [Assumption | Simpl; Right; Left; Reflexivity] | Unfold Rmin Rmax; Case (total_order_Rle b b); Case (total_order_Rle a b); Intros; Try Assumption Orelse Reflexivity].
+Lemma StepFun_P8 :
+ forall (f:R -> R) (l1 lf1:Rlist) (a b:R),
+ adapted_couple f a b l1 lf1 -> a = b -> Int_SF lf1 l1 = 0.
+simple induction l1.
+intros; induction lf1 as [| r lf1 Hreclf1]; reflexivity.
+simple induction r0.
+intros; induction lf1 as [| r1 lf1 Hreclf1].
+reflexivity.
+unfold adapted_couple in H0; decompose [and] H0; clear H0; simpl in H5;
+ discriminate.
+intros; induction lf1 as [| r3 lf1 Hreclf1].
+reflexivity.
+simpl in |- *; cut (r = r1).
+intro; rewrite H3; rewrite (H0 lf1 r b).
+ring.
+rewrite H3; apply StepFun_P7 with a r r3; [ right; assumption | assumption ].
+clear H H0 Hreclf1 r0; unfold adapted_couple in H1; decompose [and] H1;
+ intros; simpl in H4; rewrite H4; unfold Rmin in |- *;
+ case (Rle_dec a b); intro; [ assumption | reflexivity ].
+unfold adapted_couple in H1; decompose [and] H1; intros; apply Rle_antisym.
+apply (H3 0%nat); simpl in |- *; apply lt_O_Sn.
+simpl in H5; rewrite H2 in H5; rewrite H5; replace (Rmin b b) with (Rmax a b);
+ [ rewrite <- H4; apply RList_P7;
+ [ assumption | simpl in |- *; right; left; reflexivity ]
+ | unfold Rmin, Rmax in |- *; case (Rle_dec b b); case (Rle_dec a b); intros;
+ try assumption || reflexivity ].
Qed.
-Lemma StepFun_P9 : (a,b:R;f:R->R;l,lf:Rlist) (adapted_couple f a b l lf) -> ``a<>b`` -> (le (2) (Rlength l)).
-Intros; Unfold adapted_couple in H; Decompose [and] H; Clear H; Induction l; [Simpl in H4; Discriminate | Induction l; [Simpl in H3; Simpl in H2; Generalize H3; Generalize H2; Unfold Rmin Rmax; Case (total_order_Rle a b); Intros; Elim H0; Rewrite <- H5; Rewrite <- H7; Reflexivity | Simpl; Do 2 Apply le_n_S; Apply le_O_n]].
+Lemma StepFun_P9 :
+ forall (a b:R) (f:R -> R) (l lf:Rlist),
+ adapted_couple f a b l lf -> a <> b -> (2 <= Rlength l)%nat.
+intros; unfold adapted_couple in H; decompose [and] H; clear H;
+ induction l as [| r l Hrecl];
+ [ simpl in H4; discriminate
+ | induction l as [| r0 l Hrecl0];
+ [ simpl in H3; simpl in H2; generalize H3; generalize H2;
+ unfold Rmin, Rmax in |- *; case (Rle_dec a b);
+ intros; elim H0; rewrite <- H5; rewrite <- H7;
+ reflexivity
+ | simpl in |- *; do 2 apply le_n_S; apply le_O_n ] ].
Qed.
-Lemma StepFun_P10 : (f:R->R;l,lf:Rlist;a,b:R) ``a<=b`` -> (adapted_couple f a b l lf) -> (EXT l':Rlist | (EXT lf':Rlist | (adapted_couple_opt f a b l' lf'))).
-Induction l.
-Intros; Unfold adapted_couple in H0; Decompose [and] H0; Simpl in H4; Discriminate.
-Intros; Case (Req_EM a b); Intro.
-Exists (cons a nil); Exists nil; Unfold adapted_couple_opt; Unfold adapted_couple; Unfold ordered_Rlist; Repeat Split; Try (Intros; Simpl in H3; Elim (lt_n_O ? H3)).
-Simpl; Rewrite <- H2; Unfold Rmin; Case (total_order_Rle a a); Intro; Reflexivity.
-Simpl; Rewrite <- H2; Unfold Rmax; Case (total_order_Rle a a); Intro; Reflexivity.
-Elim (RList_P20 ? (StepFun_P9 H1 H2)); Intros t1 [t2 [t3 H3]]; Induction lf.
-Unfold adapted_couple in H1; Decompose [and] H1; Rewrite H3 in H7; Simpl in H7; Discriminate.
-Clear Hreclf; Assert H4 : (adapted_couple f t2 b r0 lf).
-Rewrite H3 in H1; Assert H4 := (RList_P21 ? ? H3); Simpl in H4; Rewrite H4; EApply StepFun_P7; [Apply H0 | Apply H1].
-Cut ``t2<=b``.
-Intro; Assert H6 := (H ? ? ? H5 H4); Case (Req_EM t1 t2); Intro Hyp_eq.
-Replace a with t2.
-Apply H6.
-Rewrite <- Hyp_eq; Rewrite H3 in H1; Unfold adapted_couple in H1; Decompose [and] H1; Clear H1; Simpl in H9; Rewrite H9; Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Elim H6; Clear H6; Intros l' [lf' H6]; Case (Req_EM t2 b); Intro.
-Exists (cons a (cons b nil)); Exists (cons r1 nil); Unfold adapted_couple_opt; Unfold adapted_couple; Repeat Split.
-Unfold ordered_Rlist; Intros; Simpl in H8; Inversion H8; [Simpl; Assumption | Elim (le_Sn_O ? H10)].
-Simpl; Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Simpl; Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Intros; Simpl in H8; Inversion H8.
-Unfold constant_D_eq open_interval; Intros; Simpl; Simpl in H9; Rewrite H3 in H1; Unfold adapted_couple in H1; Decompose [and] H1; Apply (H16 O).
-Simpl; Apply lt_O_Sn.
-Unfold open_interval; Simpl; Rewrite H7; Simpl in H13; Rewrite H13; Unfold Rmin; Case (total_order_Rle a b); Intro; [Assumption | Elim n; Assumption].
-Elim (le_Sn_O ? H10).
-Intros; Simpl in H8; Elim (lt_n_O ? H8).
-Intros; Simpl in H8; Inversion H8; [Simpl; Assumption | Elim (le_Sn_O ? H10)].
-Assert Hyp_min : (Rmin t2 b)==t2.
-Unfold Rmin; Case (total_order_Rle t2 b); Intro; [Reflexivity | Elim n; Assumption].
-Unfold adapted_couple in H6; Elim H6; Clear H6; Intros; Elim (RList_P20 ? (StepFun_P9 H6 H7)); Intros s1 [s2 [s3 H9]]; Induction lf'.
-Unfold adapted_couple in H6; Decompose [and] H6; Rewrite H9 in H13; Simpl in H13; Discriminate.
-Clear Hreclf'; Case (Req_EM r1 r2); Intro.
-Case (Req_EM (f t2) r1); Intro.
-Exists (cons t1 (cons s2 s3)); Exists (cons r1 lf'); Rewrite H3 in H1; Rewrite H9 in H6; Unfold adapted_couple in H6 H1; Decompose [and] H1; Decompose [and] H6; Clear H1 H6; Unfold adapted_couple_opt; Unfold adapted_couple; Repeat Split.
-Unfold ordered_Rlist; Intros; Simpl in H1; Induction i.
-Simpl; Apply Rle_trans with s1.
-Replace s1 with t2.
-Apply (H12 O).
-Simpl; Apply lt_O_Sn.
-Simpl in H19; Rewrite H19; Symmetry; Apply Hyp_min.
-Apply (H16 O); Simpl; Apply lt_O_Sn.
-Change ``(pos_Rl (cons s2 s3) i)<=(pos_Rl (cons s2 s3) (S i))``; Apply (H16 (S i)); Simpl; Assumption.
-Simpl; Simpl in H14; Rewrite H14; Reflexivity.
-Simpl; Simpl in H18; Rewrite H18; Unfold Rmax; Case (total_order_Rle a b); Case (total_order_Rle t2 b); Intros; Reflexivity Orelse Elim n; Assumption.
-Simpl; Simpl in H20; Apply H20.
-Intros; Simpl in H1; Unfold constant_D_eq open_interval; Intros; Induction i.
-Simpl; Simpl in H6; Case (total_order_T x t2); Intro.
-Elim s; Intro.
-Apply (H17 O); [Simpl; Apply lt_O_Sn | Unfold open_interval; Simpl; Elim H6; Intros; Split; Assumption].
-Rewrite b0; Assumption.
-Rewrite H10; Apply (H22 O); [Simpl; Apply lt_O_Sn | Unfold open_interval; Simpl; Replace s1 with t2; [Elim H6; Intros; Split; Assumption | Simpl in H19; Rewrite H19; Rewrite Hyp_min; Reflexivity]].
-Simpl; Simpl in H6; Apply (H22 (S i)); [Simpl; Assumption | Unfold open_interval; Simpl; Apply H6].
-Intros; Simpl in H1; Rewrite H10; Change ``(pos_Rl (cons r2 lf') i)<>(pos_Rl (cons r2 lf') (S i))``\/``(f (pos_Rl (cons s1 (cons s2 s3)) (S i)))<>(pos_Rl (cons r2 lf') i)``; Rewrite <- H9; Elim H8; Intros; Apply H6; Simpl; Apply H1.
-Intros; Induction i.
-Simpl; Red; Intro; Elim Hyp_eq; Apply Rle_antisym.
-Apply (H12 O); Simpl; Apply lt_O_Sn.
-Rewrite <- Hyp_min; Rewrite H6; Simpl in H19; Rewrite <- H19; Apply (H16 O); Simpl; Apply lt_O_Sn.
-Elim H8; Intros; Rewrite H9 in H21; Apply (H21 (S i)); Simpl; Simpl in H1; Apply H1.
-Exists (cons t1 l'); Exists (cons r1 (cons r2 lf')); Rewrite H9 in H6; Rewrite H3 in H1; Unfold adapted_couple in H1 H6; Decompose [and] H6; Decompose [and] H1; Clear H6 H1; Unfold adapted_couple_opt; Unfold adapted_couple; Repeat Split.
-Rewrite H9; Unfold ordered_Rlist; Intros; Simpl in H1; Induction i.
-Simpl; Replace s1 with t2.
-Apply (H16 O); Simpl; Apply lt_O_Sn.
-Simpl in H14; Rewrite H14; Rewrite Hyp_min; Reflexivity.
-Change ``(pos_Rl (cons s1 (cons s2 s3)) i)<=(pos_Rl (cons s1 (cons s2 s3)) (S i))``; Apply (H12 i); Simpl; Apply lt_S_n; Assumption.
-Simpl; Simpl in H19; Apply H19.
-Rewrite H9; Simpl; Simpl in H13; Rewrite H13; Unfold Rmax; Case (total_order_Rle t2 b); Case (total_order_Rle a b); Intros; Reflexivity Orelse Elim n; Assumption.
-Rewrite H9; Simpl; Simpl in H15; Rewrite H15; Reflexivity.
-Intros; Simpl in H1; Unfold constant_D_eq open_interval; Intros; Induction i.
-Simpl; Rewrite H9 in H6; Simpl in H6; Apply (H22 O).
-Simpl; Apply lt_O_Sn.
-Unfold open_interval; Simpl.
-Replace t2 with s1.
-Assumption.
-Simpl in H14; Rewrite H14; Rewrite Hyp_min; Reflexivity.
-Change (f x)==(pos_Rl (cons r2 lf') i); Clear Hreci; Apply (H17 i).
-Simpl; Rewrite H9 in H1; Simpl in H1; Apply lt_S_n; Apply H1.
-Rewrite H9 in H6; Unfold open_interval; Apply H6.
-Intros; Simpl in H1; Induction i.
-Simpl; Rewrite H9; Right; Simpl; Replace s1 with t2.
-Assumption.
-Simpl in H14; Rewrite H14; Rewrite Hyp_min; Reflexivity.
-Elim H8; Intros; Apply (H6 i).
-Simpl; Apply lt_S_n; Apply H1.
-Intros; Rewrite H9; Induction i.
-Simpl; Red; Intro; Elim Hyp_eq; Apply Rle_antisym.
-Apply (H16 O); Simpl; Apply lt_O_Sn.
-Rewrite <- Hyp_min; Rewrite H6; Simpl in H14; Rewrite <- H14; Right; Reflexivity.
-Elim H8; Intros; Rewrite <- H9; Apply (H21 i); Rewrite H9; Rewrite H9 in H1; Simpl; Simpl in H1; Apply lt_S_n; Apply H1.
-Exists (cons t1 l'); Exists (cons r1 (cons r2 lf')); Rewrite H9 in H6; Rewrite H3 in H1; Unfold adapted_couple in H1 H6; Decompose [and] H6; Decompose [and] H1; Clear H6 H1; Unfold adapted_couple_opt; Unfold adapted_couple; Repeat Split.
-Rewrite H9; Unfold ordered_Rlist; Intros; Simpl in H1; Induction i.
-Simpl; Replace s1 with t2.
-Apply (H15 O); Simpl; Apply lt_O_Sn.
-Simpl in H13; Rewrite H13; Rewrite Hyp_min; Reflexivity.
-Change ``(pos_Rl (cons s1 (cons s2 s3)) i)<=(pos_Rl (cons s1 (cons s2 s3)) (S i))``; Apply (H11 i); Simpl; Apply lt_S_n; Assumption.
-Simpl; Simpl in H18; Apply H18.
-Rewrite H9; Simpl; Simpl in H12; Rewrite H12; Unfold Rmax; Case (total_order_Rle t2 b); Case (total_order_Rle a b); Intros; Reflexivity Orelse Elim n; Assumption.
-Rewrite H9; Simpl; Simpl in H14; Rewrite H14; Reflexivity.
-Intros; Simpl in H1; Unfold constant_D_eq open_interval; Intros; Induction i.
-Simpl; Rewrite H9 in H6; Simpl in H6; Apply (H21 O).
-Simpl; Apply lt_O_Sn.
-Unfold open_interval; Simpl; Replace t2 with s1.
-Assumption.
-Simpl in H13; Rewrite H13; Rewrite Hyp_min; Reflexivity.
-Change (f x)==(pos_Rl (cons r2 lf') i); Clear Hreci; Apply (H16 i).
-Simpl; Rewrite H9 in H1; Simpl in H1; Apply lt_S_n; Apply H1.
-Rewrite H9 in H6; Unfold open_interval; Apply H6.
-Intros; Simpl in H1; Induction i.
-Simpl; Left; Assumption.
-Elim H8; Intros; Apply (H6 i).
-Simpl; Apply lt_S_n; Apply H1.
-Intros; Rewrite H9; Induction i.
-Simpl; Red; Intro; Elim Hyp_eq; Apply Rle_antisym.
-Apply (H15 O); Simpl; Apply lt_O_Sn.
-Rewrite <- Hyp_min; Rewrite H6; Simpl in H13; Rewrite <- H13; Right; Reflexivity.
-Elim H8; Intros; Rewrite <- H9; Apply (H20 i); Rewrite H9; Rewrite H9 in H1; Simpl; Simpl in H1; Apply lt_S_n; Apply H1.
-Rewrite H3 in H1; Clear H4; Unfold adapted_couple in H1; Decompose [and] H1; Clear H1; Clear H H7 H9; Cut (Rmax a b)==b; [Intro; Rewrite H in H5; Rewrite <- H5; Apply RList_P7; [Assumption | Simpl; Right; Left; Reflexivity] | Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption]].
+Lemma StepFun_P10 :
+ forall (f:R -> R) (l lf:Rlist) (a b:R),
+ a <= b ->
+ adapted_couple f a b l lf ->
+ exists l' : Rlist
+ | ( exists lf' : Rlist | adapted_couple_opt f a b l' lf').
+simple induction l.
+intros; unfold adapted_couple in H0; decompose [and] H0; simpl in H4;
+ discriminate.
+intros; case (Req_dec a b); intro.
+exists (cons a nil); exists nil; unfold adapted_couple_opt in |- *;
+ unfold adapted_couple in |- *; unfold ordered_Rlist in |- *;
+ repeat split; try (intros; simpl in H3; elim (lt_n_O _ H3)).
+simpl in |- *; rewrite <- H2; unfold Rmin in |- *; case (Rle_dec a a); intro;
+ reflexivity.
+simpl in |- *; rewrite <- H2; unfold Rmax in |- *; case (Rle_dec a a); intro;
+ reflexivity.
+elim (RList_P20 _ (StepFun_P9 H1 H2)); intros t1 [t2 [t3 H3]];
+ induction lf as [| r1 lf Hreclf].
+unfold adapted_couple in H1; decompose [and] H1; rewrite H3 in H7;
+ simpl in H7; discriminate.
+clear Hreclf; assert (H4 : adapted_couple f t2 b r0 lf).
+rewrite H3 in H1; assert (H4 := RList_P21 _ _ H3); simpl in H4; rewrite H4;
+ eapply StepFun_P7; [ apply H0 | apply H1 ].
+cut (t2 <= b).
+intro; assert (H6 := H _ _ _ H5 H4); case (Req_dec t1 t2); intro Hyp_eq.
+replace a with t2.
+apply H6.
+rewrite <- Hyp_eq; rewrite H3 in H1; unfold adapted_couple in H1;
+ decompose [and] H1; clear H1; simpl in H9; rewrite H9;
+ unfold Rmin in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n; assumption ].
+elim H6; clear H6; intros l' [lf' H6]; case (Req_dec t2 b); intro.
+exists (cons a (cons b nil)); exists (cons r1 nil);
+ unfold adapted_couple_opt in |- *; unfold adapted_couple in |- *;
+ repeat split.
+unfold ordered_Rlist in |- *; intros; simpl in H8; inversion H8;
+ [ simpl in |- *; assumption | elim (le_Sn_O _ H10) ].
+simpl in |- *; unfold Rmin in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n; assumption ].
+simpl in |- *; unfold Rmax in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n; assumption ].
+intros; simpl in H8; inversion H8.
+unfold constant_D_eq, open_interval in |- *; intros; simpl in |- *;
+ simpl in H9; rewrite H3 in H1; unfold adapted_couple in H1;
+ decompose [and] H1; apply (H16 0%nat).
+simpl in |- *; apply lt_O_Sn.
+unfold open_interval in |- *; simpl in |- *; rewrite H7; simpl in H13;
+ rewrite H13; unfold Rmin in |- *; case (Rle_dec a b);
+ intro; [ assumption | elim n; assumption ].
+elim (le_Sn_O _ H10).
+intros; simpl in H8; elim (lt_n_O _ H8).
+intros; simpl in H8; inversion H8;
+ [ simpl in |- *; assumption | elim (le_Sn_O _ H10) ].
+assert (Hyp_min : Rmin t2 b = t2).
+unfold Rmin in |- *; case (Rle_dec t2 b); intro;
+ [ reflexivity | elim n; assumption ].
+unfold adapted_couple in H6; elim H6; clear H6; intros;
+ elim (RList_P20 _ (StepFun_P9 H6 H7)); intros s1 [s2 [s3 H9]];
+ induction lf' as [| r2 lf' Hreclf'].
+unfold adapted_couple in H6; decompose [and] H6; rewrite H9 in H13;
+ simpl in H13; discriminate.
+clear Hreclf'; case (Req_dec r1 r2); intro.
+case (Req_dec (f t2) r1); intro.
+exists (cons t1 (cons s2 s3)); exists (cons r1 lf'); rewrite H3 in H1;
+ rewrite H9 in H6; unfold adapted_couple in H6, H1;
+ decompose [and] H1; decompose [and] H6; clear H1 H6;
+ unfold adapted_couple_opt in |- *; unfold adapted_couple in |- *;
+ repeat split.
+unfold ordered_Rlist in |- *; intros; simpl in H1;
+ induction i as [| i Hreci].
+simpl in |- *; apply Rle_trans with s1.
+replace s1 with t2.
+apply (H12 0%nat).
+simpl in |- *; apply lt_O_Sn.
+simpl in H19; rewrite H19; symmetry in |- *; apply Hyp_min.
+apply (H16 0%nat); simpl in |- *; apply lt_O_Sn.
+change (pos_Rl (cons s2 s3) i <= pos_Rl (cons s2 s3) (S i)) in |- *;
+ apply (H16 (S i)); simpl in |- *; assumption.
+simpl in |- *; simpl in H14; rewrite H14; reflexivity.
+simpl in |- *; simpl in H18; rewrite H18; unfold Rmax in |- *;
+ case (Rle_dec a b); case (Rle_dec t2 b); intros; reflexivity || elim n;
+ assumption.
+simpl in |- *; simpl in H20; apply H20.
+intros; simpl in H1; unfold constant_D_eq, open_interval in |- *; intros;
+ induction i as [| i Hreci].
+simpl in |- *; simpl in H6; case (total_order_T x t2); intro.
+elim s; intro.
+apply (H17 0%nat);
+ [ simpl in |- *; apply lt_O_Sn
+ | unfold open_interval in |- *; simpl in |- *; elim H6; intros; split;
+ assumption ].
+rewrite b0; assumption.
+rewrite H10; apply (H22 0%nat);
+ [ simpl in |- *; apply lt_O_Sn
+ | unfold open_interval in |- *; simpl in |- *; replace s1 with t2;
+ [ elim H6; intros; split; assumption
+ | simpl in H19; rewrite H19; rewrite Hyp_min; reflexivity ] ].
+simpl in |- *; simpl in H6; apply (H22 (S i));
+ [ simpl in |- *; assumption
+ | unfold open_interval in |- *; simpl in |- *; apply H6 ].
+intros; simpl in H1; rewrite H10;
+ change
+ (pos_Rl (cons r2 lf') i <> pos_Rl (cons r2 lf') (S i) \/
+ f (pos_Rl (cons s1 (cons s2 s3)) (S i)) <> pos_Rl (cons r2 lf') i)
+ in |- *; rewrite <- H9; elim H8; intros; apply H6;
+ simpl in |- *; apply H1.
+intros; induction i as [| i Hreci].
+simpl in |- *; red in |- *; intro; elim Hyp_eq; apply Rle_antisym.
+apply (H12 0%nat); simpl in |- *; apply lt_O_Sn.
+rewrite <- Hyp_min; rewrite H6; simpl in H19; rewrite <- H19;
+ apply (H16 0%nat); simpl in |- *; apply lt_O_Sn.
+elim H8; intros; rewrite H9 in H21; apply (H21 (S i)); simpl in |- *;
+ simpl in H1; apply H1.
+exists (cons t1 l'); exists (cons r1 (cons r2 lf')); rewrite H9 in H6;
+ rewrite H3 in H1; unfold adapted_couple in H1, H6;
+ decompose [and] H6; decompose [and] H1; clear H6 H1;
+ unfold adapted_couple_opt in |- *; unfold adapted_couple in |- *;
+ repeat split.
+rewrite H9; unfold ordered_Rlist in |- *; intros; simpl in H1;
+ induction i as [| i Hreci].
+simpl in |- *; replace s1 with t2.
+apply (H16 0%nat); simpl in |- *; apply lt_O_Sn.
+simpl in H14; rewrite H14; rewrite Hyp_min; reflexivity.
+change
+ (pos_Rl (cons s1 (cons s2 s3)) i <= pos_Rl (cons s1 (cons s2 s3)) (S i))
+ in |- *; apply (H12 i); simpl in |- *; apply lt_S_n;
+ assumption.
+simpl in |- *; simpl in H19; apply H19.
+rewrite H9; simpl in |- *; simpl in H13; rewrite H13; unfold Rmax in |- *;
+ case (Rle_dec t2 b); case (Rle_dec a b); intros; reflexivity || elim n;
+ assumption.
+rewrite H9; simpl in |- *; simpl in H15; rewrite H15; reflexivity.
+intros; simpl in H1; unfold constant_D_eq, open_interval in |- *; intros;
+ induction i as [| i Hreci].
+simpl in |- *; rewrite H9 in H6; simpl in H6; apply (H22 0%nat).
+simpl in |- *; apply lt_O_Sn.
+unfold open_interval in |- *; simpl in |- *.
+replace t2 with s1.
+assumption.
+simpl in H14; rewrite H14; rewrite Hyp_min; reflexivity.
+change (f x = pos_Rl (cons r2 lf') i) in |- *; clear Hreci; apply (H17 i).
+simpl in |- *; rewrite H9 in H1; simpl in H1; apply lt_S_n; apply H1.
+rewrite H9 in H6; unfold open_interval in |- *; apply H6.
+intros; simpl in H1; induction i as [| i Hreci].
+simpl in |- *; rewrite H9; right; simpl in |- *; replace s1 with t2.
+assumption.
+simpl in H14; rewrite H14; rewrite Hyp_min; reflexivity.
+elim H8; intros; apply (H6 i).
+simpl in |- *; apply lt_S_n; apply H1.
+intros; rewrite H9; induction i as [| i Hreci].
+simpl in |- *; red in |- *; intro; elim Hyp_eq; apply Rle_antisym.
+apply (H16 0%nat); simpl in |- *; apply lt_O_Sn.
+rewrite <- Hyp_min; rewrite H6; simpl in H14; rewrite <- H14; right;
+ reflexivity.
+elim H8; intros; rewrite <- H9; apply (H21 i); rewrite H9; rewrite H9 in H1;
+ simpl in |- *; simpl in H1; apply lt_S_n; apply H1.
+exists (cons t1 l'); exists (cons r1 (cons r2 lf')); rewrite H9 in H6;
+ rewrite H3 in H1; unfold adapted_couple in H1, H6;
+ decompose [and] H6; decompose [and] H1; clear H6 H1;
+ unfold adapted_couple_opt in |- *; unfold adapted_couple in |- *;
+ repeat split.
+rewrite H9; unfold ordered_Rlist in |- *; intros; simpl in H1;
+ induction i as [| i Hreci].
+simpl in |- *; replace s1 with t2.
+apply (H15 0%nat); simpl in |- *; apply lt_O_Sn.
+simpl in H13; rewrite H13; rewrite Hyp_min; reflexivity.
+change
+ (pos_Rl (cons s1 (cons s2 s3)) i <= pos_Rl (cons s1 (cons s2 s3)) (S i))
+ in |- *; apply (H11 i); simpl in |- *; apply lt_S_n;
+ assumption.
+simpl in |- *; simpl in H18; apply H18.
+rewrite H9; simpl in |- *; simpl in H12; rewrite H12; unfold Rmax in |- *;
+ case (Rle_dec t2 b); case (Rle_dec a b); intros; reflexivity || elim n;
+ assumption.
+rewrite H9; simpl in |- *; simpl in H14; rewrite H14; reflexivity.
+intros; simpl in H1; unfold constant_D_eq, open_interval in |- *; intros;
+ induction i as [| i Hreci].
+simpl in |- *; rewrite H9 in H6; simpl in H6; apply (H21 0%nat).
+simpl in |- *; apply lt_O_Sn.
+unfold open_interval in |- *; simpl in |- *; replace t2 with s1.
+assumption.
+simpl in H13; rewrite H13; rewrite Hyp_min; reflexivity.
+change (f x = pos_Rl (cons r2 lf') i) in |- *; clear Hreci; apply (H16 i).
+simpl in |- *; rewrite H9 in H1; simpl in H1; apply lt_S_n; apply H1.
+rewrite H9 in H6; unfold open_interval in |- *; apply H6.
+intros; simpl in H1; induction i as [| i Hreci].
+simpl in |- *; left; assumption.
+elim H8; intros; apply (H6 i).
+simpl in |- *; apply lt_S_n; apply H1.
+intros; rewrite H9; induction i as [| i Hreci].
+simpl in |- *; red in |- *; intro; elim Hyp_eq; apply Rle_antisym.
+apply (H15 0%nat); simpl in |- *; apply lt_O_Sn.
+rewrite <- Hyp_min; rewrite H6; simpl in H13; rewrite <- H13; right;
+ reflexivity.
+elim H8; intros; rewrite <- H9; apply (H20 i); rewrite H9; rewrite H9 in H1;
+ simpl in |- *; simpl in H1; apply lt_S_n; apply H1.
+rewrite H3 in H1; clear H4; unfold adapted_couple in H1; decompose [and] H1;
+ clear H1; clear H H7 H9; cut (Rmax a b = b);
+ [ intro; rewrite H in H5; rewrite <- H5; apply RList_P7;
+ [ assumption | simpl in |- *; right; left; reflexivity ]
+ | unfold Rmax in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n; assumption ] ].
Qed.
-Lemma StepFun_P11 : (a,b,r,r1,r3,s1,s2,r4:R;r2,lf1,s3,lf2:Rlist;f:R->R) ``a<b`` -> (adapted_couple f a b (cons r (cons r1 r2)) (cons r3 lf1)) -> (adapted_couple_opt f a b (cons s1 (cons s2 s3)) (cons r4 lf2)) -> ``r1<=s2``.
-Intros; Unfold adapted_couple_opt in H1; Elim H1; Clear H1; Intros; Unfold adapted_couple in H0 H1; Decompose [and] H0; Decompose [and] H1; Clear H0 H1; Assert H12 : r==s1.
-Simpl in H10; Simpl in H5; Rewrite H10; Rewrite H5; Reflexivity.
-Assert H14 := (H3 O (lt_O_Sn ?)); Simpl in H14; Elim H14; Intro.
-Assert H15 := (H7 O (lt_O_Sn ?)); Simpl in H15; Elim H15; Intro.
-Rewrite <- H12 in H1; Case (total_order_Rle r1 s2); Intro; Try Assumption.
-Assert H16 : ``s2<r1``; Auto with real.
-Induction s3.
-Simpl in H9; Rewrite H9 in H16; Cut ``r1<=(Rmax a b)``.
-Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H17 H16)).
-Rewrite <- H4; Apply RList_P7; [Assumption | Simpl; Right; Left; Reflexivity].
-Clear Hrecs3; Induction lf2.
-Simpl in H11; Discriminate.
-Clear Hreclf2; Assert H17 : r3==r4.
-Pose x := ``(r+s2)/2``; Assert H17 := (H8 O (lt_O_Sn ?)); Assert H18 := (H13 O (lt_O_Sn ?)); Unfold constant_D_eq open_interval in H17 H18; Simpl in H17; Simpl in H18; Rewrite <- (H17 x).
-Rewrite <- (H18 x).
-Reflexivity.
-Rewrite <- H12; Unfold x; Split.
-Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
-Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite (Rplus_sym r); Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
-Unfold x; Split.
-Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
-Apply Rlt_trans with s2; [Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite (Rplus_sym r); Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]] | Assumption].
-Assert H18 : (f s2)==r3.
-Apply (H8 O); [Simpl; Apply lt_O_Sn | Unfold open_interval; Simpl; Split; Assumption].
-Assert H19 : r3 == r5.
-Assert H19 := (H7 (S O)); Simpl in H19; Assert H20 := (H19 (lt_n_S ? ? (lt_O_Sn ?))); Elim H20; Intro.
-Pose x := ``(s2+(Rmin r1 r0))/2``; Assert H22 := (H8 O); Assert H23 := (H13 (S O)); Simpl in H22; Simpl in H23; Rewrite <- (H22 (lt_O_Sn ?) x).
-Rewrite <- (H23 (lt_n_S ? ? (lt_O_Sn ?)) x).
-Reflexivity.
-Unfold open_interval; Simpl; Unfold x; Split.
-Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Unfold Rmin; Case (total_order_Rle r1 r0); Intro; Assumption | DiscrR]].
-Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_le_trans with ``r0+(Rmin r1 r0)``; [Do 2 Rewrite <- (Rplus_sym (Rmin r1 r0)); Apply Rlt_compatibility; Assumption | Apply Rle_compatibility; Apply Rmin_r] | DiscrR]].
-Unfold open_interval; Simpl; Unfold x; Split.
-Apply Rlt_trans with s2; [Assumption | Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Unfold Rmin; Case (total_order_Rle r1 r0); Intro; Assumption | DiscrR]]].
-Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_le_trans with ``r1+(Rmin r1 r0)``; [Do 2 Rewrite <- (Rplus_sym (Rmin r1 r0)); Apply Rlt_compatibility; Assumption | Apply Rle_compatibility; Apply Rmin_l] | DiscrR]].
-Elim H2; Clear H2; Intros; Assert H23 := (H22 (S O)); Simpl in H23; Assert H24 := (H23 (lt_n_S ? ? (lt_O_Sn ?))); Elim H24; Assumption.
-Elim H2; Intros; Assert H22 := (H20 O); Simpl in H22; Assert H23 := (H22 (lt_O_Sn ?)); Elim H23; Intro; [Elim H24; Rewrite <- H17; Rewrite <- H19; Reflexivity | Elim H24; Rewrite <- H17; Assumption].
-Elim H2; Clear H2; Intros; Assert H17 := (H16 O); Simpl in H17; Elim (H17 (lt_O_Sn ?)); Assumption.
-Rewrite <- H0; Rewrite H12; Apply (H7 O); Simpl; Apply lt_O_Sn.
+Lemma StepFun_P11 :
+ forall (a b r r1 r3 s1 s2 r4:R) (r2 lf1 s3 lf2:Rlist)
+ (f:R -> R),
+ a < b ->
+ adapted_couple f a b (cons r (cons r1 r2)) (cons r3 lf1) ->
+ adapted_couple_opt f a b (cons s1 (cons s2 s3)) (cons r4 lf2) -> r1 <= s2.
+intros; unfold adapted_couple_opt in H1; elim H1; clear H1; intros;
+ unfold adapted_couple in H0, H1; decompose [and] H0;
+ decompose [and] H1; clear H0 H1; assert (H12 : r = s1).
+simpl in H10; simpl in H5; rewrite H10; rewrite H5; reflexivity.
+assert (H14 := H3 0%nat (lt_O_Sn _)); simpl in H14; elim H14; intro.
+assert (H15 := H7 0%nat (lt_O_Sn _)); simpl in H15; elim H15; intro.
+rewrite <- H12 in H1; case (Rle_dec r1 s2); intro; try assumption.
+assert (H16 : s2 < r1); auto with real.
+induction s3 as [| r0 s3 Hrecs3].
+simpl in H9; rewrite H9 in H16; cut (r1 <= Rmax a b).
+intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H17 H16)).
+rewrite <- H4; apply RList_P7;
+ [ assumption | simpl in |- *; right; left; reflexivity ].
+clear Hrecs3; induction lf2 as [| r5 lf2 Hreclf2].
+simpl in H11; discriminate.
+clear Hreclf2; assert (H17 : r3 = r4).
+pose (x := (r + s2) / 2); assert (H17 := H8 0%nat (lt_O_Sn _));
+ assert (H18 := H13 0%nat (lt_O_Sn _));
+ unfold constant_D_eq, open_interval in H17, H18; simpl in H17;
+ simpl in H18; rewrite <- (H17 x).
+rewrite <- (H18 x).
+reflexivity.
+rewrite <- H12; unfold x in |- *; split.
+apply Rmult_lt_reg_l with 2;
+ [ prove_sup0
+ | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+ rewrite <- Rinv_r_sym;
+ [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption
+ | discrR ] ].
+apply Rmult_lt_reg_l with 2;
+ [ prove_sup0
+ | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+ rewrite <- Rinv_r_sym;
+ [ rewrite Rmult_1_l; rewrite (Rplus_comm r); rewrite double;
+ apply Rplus_lt_compat_l; assumption
+ | discrR ] ].
+unfold x in |- *; split.
+apply Rmult_lt_reg_l with 2;
+ [ prove_sup0
+ | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+ rewrite <- Rinv_r_sym;
+ [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption
+ | discrR ] ].
+apply Rlt_trans with s2;
+ [ apply Rmult_lt_reg_l with 2;
+ [ prove_sup0
+ | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2));
+ rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym;
+ [ rewrite Rmult_1_l; rewrite (Rplus_comm r); rewrite double;
+ apply Rplus_lt_compat_l; assumption
+ | discrR ] ]
+ | assumption ].
+assert (H18 : f s2 = r3).
+apply (H8 0%nat);
+ [ simpl in |- *; apply lt_O_Sn
+ | unfold open_interval in |- *; simpl in |- *; split; assumption ].
+assert (H19 : r3 = r5).
+assert (H19 := H7 1%nat); simpl in H19;
+ assert (H20 := H19 (lt_n_S _ _ (lt_O_Sn _))); elim H20;
+ intro.
+pose (x := (s2 + Rmin r1 r0) / 2); assert (H22 := H8 0%nat);
+ assert (H23 := H13 1%nat); simpl in H22; simpl in H23;
+ rewrite <- (H22 (lt_O_Sn _) x).
+rewrite <- (H23 (lt_n_S _ _ (lt_O_Sn _)) x).
+reflexivity.
+unfold open_interval in |- *; simpl in |- *; unfold x in |- *; split.
+apply Rmult_lt_reg_l with 2;
+ [ prove_sup0
+ | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+ rewrite <- Rinv_r_sym;
+ [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l;
+ unfold Rmin in |- *; case (Rle_dec r1 r0); intro;
+ assumption
+ | discrR ] ].
+apply Rmult_lt_reg_l with 2;
+ [ prove_sup0
+ | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+ rewrite <- Rinv_r_sym;
+ [ rewrite Rmult_1_l; rewrite double;
+ apply Rlt_le_trans with (r0 + Rmin r1 r0);
+ [ do 2 rewrite <- (Rplus_comm (Rmin r1 r0)); apply Rplus_lt_compat_l;
+ assumption
+ | apply Rplus_le_compat_l; apply Rmin_r ]
+ | discrR ] ].
+unfold open_interval in |- *; simpl in |- *; unfold x in |- *; split.
+apply Rlt_trans with s2;
+ [ assumption
+ | apply Rmult_lt_reg_l with 2;
+ [ prove_sup0
+ | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2));
+ rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym;
+ [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l;
+ unfold Rmin in |- *; case (Rle_dec r1 r0);
+ intro; assumption
+ | discrR ] ] ].
+apply Rmult_lt_reg_l with 2;
+ [ prove_sup0
+ | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+ rewrite <- Rinv_r_sym;
+ [ rewrite Rmult_1_l; rewrite double;
+ apply Rlt_le_trans with (r1 + Rmin r1 r0);
+ [ do 2 rewrite <- (Rplus_comm (Rmin r1 r0)); apply Rplus_lt_compat_l;
+ assumption
+ | apply Rplus_le_compat_l; apply Rmin_l ]
+ | discrR ] ].
+elim H2; clear H2; intros; assert (H23 := H22 1%nat); simpl in H23;
+ assert (H24 := H23 (lt_n_S _ _ (lt_O_Sn _))); elim H24;
+ assumption.
+elim H2; intros; assert (H22 := H20 0%nat); simpl in H22;
+ assert (H23 := H22 (lt_O_Sn _)); elim H23; intro;
+ [ elim H24; rewrite <- H17; rewrite <- H19; reflexivity
+ | elim H24; rewrite <- H17; assumption ].
+elim H2; clear H2; intros; assert (H17 := H16 0%nat); simpl in H17;
+ elim (H17 (lt_O_Sn _)); assumption.
+rewrite <- H0; rewrite H12; apply (H7 0%nat); simpl in |- *; apply lt_O_Sn.
Qed.
-Lemma StepFun_P12 : (a,b:R;f:R->R;l,lf:Rlist) (adapted_couple_opt f a b l lf) -> (adapted_couple_opt f b a l lf).
-Unfold adapted_couple_opt; Unfold adapted_couple; Intros; Decompose [and] H; Clear H; Repeat Split; Try Assumption.
-Rewrite H0; Unfold Rmin; Case (total_order_Rle a b); Intro; Case (total_order_Rle b a); Intro; Try Reflexivity.
-Apply Rle_antisym; Assumption.
-Apply Rle_antisym; Auto with real.
-Rewrite H3; Unfold Rmax; Case (total_order_Rle a b); Intro; Case (total_order_Rle b a); Intro; Try Reflexivity.
-Apply Rle_antisym; Assumption.
-Apply Rle_antisym; Auto with real.
+Lemma StepFun_P12 :
+ forall (a b:R) (f:R -> R) (l lf:Rlist),
+ adapted_couple_opt f a b l lf -> adapted_couple_opt f b a l lf.
+unfold adapted_couple_opt in |- *; unfold adapted_couple in |- *; intros;
+ decompose [and] H; clear H; repeat split; try assumption.
+rewrite H0; unfold Rmin in |- *; case (Rle_dec a b); intro;
+ case (Rle_dec b a); intro; try reflexivity.
+apply Rle_antisym; assumption.
+apply Rle_antisym; auto with real.
+rewrite H3; unfold Rmax in |- *; case (Rle_dec a b); intro;
+ case (Rle_dec b a); intro; try reflexivity.
+apply Rle_antisym; assumption.
+apply Rle_antisym; auto with real.
Qed.
-Lemma StepFun_P13 : (a,b,r,r1,r3,s1,s2,r4:R;r2,lf1,s3,lf2:Rlist;f:R->R) ``a<>b`` -> (adapted_couple f a b (cons r (cons r1 r2)) (cons r3 lf1)) -> (adapted_couple_opt f a b (cons s1 (cons s2 s3)) (cons r4 lf2)) -> ``r1<=s2``.
-Intros; Case (total_order_T a b); Intro.
-Elim s; Intro.
-EApply StepFun_P11; [Apply a0 | Apply H0 | Apply H1].
-Elim H; Assumption.
-EApply StepFun_P11; [Apply r0 | Apply StepFun_P2; Apply H0 | Apply StepFun_P12; Apply H1].
+Lemma StepFun_P13 :
+ forall (a b r r1 r3 s1 s2 r4:R) (r2 lf1 s3 lf2:Rlist)
+ (f:R -> R),
+ a <> b ->
+ adapted_couple f a b (cons r (cons r1 r2)) (cons r3 lf1) ->
+ adapted_couple_opt f a b (cons s1 (cons s2 s3)) (cons r4 lf2) -> r1 <= s2.
+intros; case (total_order_T a b); intro.
+elim s; intro.
+eapply StepFun_P11; [ apply a0 | apply H0 | apply H1 ].
+elim H; assumption.
+eapply StepFun_P11;
+ [ apply r0 | apply StepFun_P2; apply H0 | apply StepFun_P12; apply H1 ].
Qed.
-Lemma StepFun_P14 : (f:R->R;l1,l2,lf1,lf2:Rlist;a,b:R) ``a<=b`` -> (adapted_couple f a b l1 lf1) -> (adapted_couple_opt f a b l2 lf2) -> (Int_SF lf1 l1)==(Int_SF lf2 l2).
-Induction l1.
-Intros l2 lf1 lf2 a b Hyp H H0; Unfold adapted_couple in H; Decompose [and] H; Clear H H0 H2 H3 H1 H6; Simpl in H4; Discriminate.
-Induction r0.
-Intros; Case (Req_EM a b); Intro.
-Unfold adapted_couple_opt in H2; Elim H2; Intros; Rewrite (StepFun_P8 H4 H3); Rewrite (StepFun_P8 H1 H3); Reflexivity.
-Assert H4 := (StepFun_P9 H1 H3); Simpl in H4; Elim (le_Sn_O ? (le_S_n ? ? H4)).
-Intros; Clear H; Unfold adapted_couple_opt in H3; Elim H3; Clear H3; Intros; Case (Req_EM a b); Intro.
-Rewrite (StepFun_P8 H2 H4); Rewrite (StepFun_P8 H H4); Reflexivity.
-Assert Hyp_min : (Rmin a b)==a.
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Assert Hyp_max : (Rmax a b)==b.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Elim (RList_P20 ? (StepFun_P9 H H4)); Intros s1 [s2 [s3 H5]]; Rewrite H5 in H; Rewrite H5; Induction lf1.
-Unfold adapted_couple in H2; Decompose [and] H2; Clear H H2 H4 H5 H3 H6 H8 H7 H11; Simpl in H9; Discriminate.
-Clear Hreclf1; Induction lf2.
-Unfold adapted_couple in H; Decompose [and] H; Clear H H2 H4 H5 H3 H6 H8 H7 H11; Simpl in H9; Discriminate.
-Clear Hreclf2; Assert H6 : r==s1.
-Unfold adapted_couple in H H2; Decompose [and] H; Decompose [and] H2; Clear H H2; Simpl in H13; Simpl in H8; Rewrite H13; Rewrite H8; Reflexivity.
-Assert H7 : r3==r4\/r==r1.
-Case (Req_EM r r1); Intro.
-Right; Assumption.
-Left; Cut ``r1<=s2``.
-Intro; Unfold adapted_couple in H2 H; Decompose [and] H; Decompose [and] H2; Clear H H2; Pose x := ``(r+r1)/2``; Assert H18 := (H14 O); Assert H20 := (H19 O); Unfold constant_D_eq open_interval in H18 H20; Simpl in H18; Simpl in H20; Rewrite <- (H18 (lt_O_Sn ?) x).
-Rewrite <- (H20 (lt_O_Sn ?) x).
-Reflexivity.
-Assert H21 := (H13 O (lt_O_Sn ?)); Simpl in H21; Elim H21; Intro; [Idtac | Elim H7; Assumption]; Unfold x; Split.
-Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Apply H | DiscrR]].
-Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite <- (Rplus_sym r1); Rewrite double; Apply Rlt_compatibility; Apply H | DiscrR]].
-Rewrite <- H6; Assert H21 := (H13 O (lt_O_Sn ?)); Simpl in H21; Elim H21; Intro; [Idtac | Elim H7; Assumption]; Unfold x; Split.
-Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Apply H | DiscrR]].
-Apply Rlt_le_trans with r1; [Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite <- (Rplus_sym r1); Rewrite double; Apply Rlt_compatibility; Apply H | DiscrR]] | Assumption].
-EApply StepFun_P13.
-Apply H4.
-Apply H2.
-Unfold adapted_couple_opt; Split.
-Apply H.
-Rewrite H5 in H3; Apply H3.
-Assert H8 : ``r1<=s2``.
-EApply StepFun_P13.
-Apply H4.
-Apply H2.
-Unfold adapted_couple_opt; Split.
-Apply H.
-Rewrite H5 in H3; Apply H3.
-Elim H7; Intro.
-Simpl; Elim H8; Intro.
-Replace ``r4*(s2-s1)`` with ``r3*(r1-r)+r3*(s2-r1)``; [Idtac | Rewrite H9; Rewrite H6; Ring].
-Rewrite Rplus_assoc; Apply Rplus_plus_r; Change (Int_SF lf1 (cons r1 r2))==(Int_SF (cons r3 lf2) (cons r1 (cons s2 s3))); Apply H0 with r1 b.
-Unfold adapted_couple in H2; Decompose [and] H2; Clear H2; Replace b with (Rmax a b).
-Rewrite <- H12; Apply RList_P7; [Assumption | Simpl; Right; Left; Reflexivity].
-EApply StepFun_P7.
-Apply H1.
-Apply H2.
-Unfold adapted_couple_opt; Split.
-Apply StepFun_P7 with a a r3.
-Apply H1.
-Unfold adapted_couple in H2 H; Decompose [and] H2; Decompose [and] H; Clear H H2; Assert H20 : r==a.
-Simpl in H13; Rewrite H13; Apply Hyp_min.
-Unfold adapted_couple; Repeat Split.
-Unfold ordered_Rlist; Intros; Simpl in H; Induction i.
-Simpl; Rewrite <- H20; Apply (H11 O).
-Simpl; Apply lt_O_Sn.
-Induction i.
-Simpl; Assumption.
-Change ``(pos_Rl (cons s2 s3) i)<=(pos_Rl (cons s2 s3) (S i))``; Apply (H15 (S i)); Simpl; Apply lt_S_n; Assumption.
-Simpl; Symmetry; Apply Hyp_min.
-Rewrite <- H17; Reflexivity.
-Simpl in H19; Simpl; Rewrite H19; Reflexivity.
-Intros; Simpl in H; Unfold constant_D_eq open_interval; Intros; Induction i.
-Simpl; Apply (H16 O).
-Simpl; Apply lt_O_Sn.
-Simpl in H2; Rewrite <- H20 in H2; Unfold open_interval; Simpl; Apply H2.
-Clear Hreci; Induction i.
-Simpl; Simpl in H2; Rewrite H9; Apply (H21 O).
-Simpl; Apply lt_O_Sn.
-Unfold open_interval; Simpl; Elim H2; Intros; Split.
-Apply Rle_lt_trans with r1; Try Assumption; Rewrite <- H6; Apply (H11 O); Simpl; Apply lt_O_Sn.
-Assumption.
-Clear Hreci; Simpl; Apply (H21 (S i)).
-Simpl; Apply lt_S_n; Assumption.
-Unfold open_interval; Apply H2.
-Elim H3; Clear H3; Intros; Split.
-Rewrite H9; Change (i:nat) (lt i (pred (Rlength (cons r4 lf2)))) ->``(pos_Rl (cons r4 lf2) i)<>(pos_Rl (cons r4 lf2) (S i))``\/``(f (pos_Rl (cons s1 (cons s2 s3)) (S i)))<>(pos_Rl (cons r4 lf2) i)``; Rewrite <- H5; Apply H3.
-Rewrite H5 in H11; Intros; Simpl in H12; Induction i.
-Simpl; Red; Intro; Rewrite H13 in H10; Elim (Rlt_antirefl ? H10).
-Clear Hreci; Apply (H11 (S i)); Simpl; Apply H12.
-Rewrite H9; Rewrite H10; Rewrite H6; Apply Rplus_plus_r; Rewrite <- H10; Apply H0 with r1 b.
-Unfold adapted_couple in H2; Decompose [and] H2; Clear H2; Replace b with (Rmax a b).
-Rewrite <- H12; Apply RList_P7; [Assumption | Simpl; Right; Left; Reflexivity].
-EApply StepFun_P7.
-Apply H1.
-Apply H2.
-Unfold adapted_couple_opt; Split.
-Apply StepFun_P7 with a a r3.
-Apply H1.
-Unfold adapted_couple in H2 H; Decompose [and] H2; Decompose [and] H; Clear H H2; Assert H20 : r==a.
-Simpl in H13; Rewrite H13; Apply Hyp_min.
-Unfold adapted_couple; Repeat Split.
-Unfold ordered_Rlist; Intros; Simpl in H; Induction i.
-Simpl; Rewrite <- H20; Apply (H11 O); Simpl; Apply lt_O_Sn.
-Rewrite H10; Apply (H15 (S i)); Simpl; Assumption.
-Simpl; Symmetry; Apply Hyp_min.
-Rewrite <- H17; Rewrite H10; Reflexivity.
-Simpl in H19; Simpl; Apply H19.
-Intros; Simpl in H; Unfold constant_D_eq open_interval; Intros; Induction i.
-Simpl; Apply (H16 O).
-Simpl; Apply lt_O_Sn.
-Simpl in H2; Rewrite <- H20 in H2; Unfold open_interval; Simpl; Apply H2.
-Clear Hreci; Simpl; Apply (H21 (S i)).
-Simpl; Assumption.
-Rewrite <- H10; Unfold open_interval; Apply H2.
-Elim H3; Clear H3; Intros; Split.
-Rewrite H5 in H3; Intros; Apply (H3 (S i)).
-Simpl; Replace (Rlength lf2) with (S (pred (Rlength lf2))).
-Apply lt_n_S; Apply H12.
-Symmetry; Apply S_pred with O; Apply neq_O_lt; Red; Intro; Rewrite <- H13 in H12; Elim (lt_n_O ? H12).
-Intros; Simpl in H12; Rewrite H10; Rewrite H5 in H11; Apply (H11 (S i)); Simpl; Apply lt_n_S; Apply H12.
-Simpl; Rewrite H9; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rmult_Or; Rewrite Rplus_Ol; Change (Int_SF lf1 (cons r1 r2))==(Int_SF (cons r4 lf2) (cons s1 (cons s2 s3))); EApply H0.
-Apply H1.
-2: Rewrite H5 in H3; Unfold adapted_couple_opt; Split; Assumption.
-Assert H10 : r==a.
-Unfold adapted_couple in H2; Decompose [and] H2; Clear H2; Simpl in H12; Rewrite H12; Apply Hyp_min.
-Rewrite <- H9; Rewrite H10; Apply StepFun_P7 with a r r3; [Apply H1 | Pattern 2 a; Rewrite <- H10; Pattern 2 r; Rewrite H9; Apply H2].
+Lemma StepFun_P14 :
+ forall (f:R -> R) (l1 l2 lf1 lf2:Rlist) (a b:R),
+ a <= b ->
+ adapted_couple f a b l1 lf1 ->
+ adapted_couple_opt f a b l2 lf2 -> Int_SF lf1 l1 = Int_SF lf2 l2.
+simple induction l1.
+intros l2 lf1 lf2 a b Hyp H H0; unfold adapted_couple in H; decompose [and] H;
+ clear H H0 H2 H3 H1 H6; simpl in H4; discriminate.
+simple induction r0.
+intros; case (Req_dec a b); intro.
+unfold adapted_couple_opt in H2; elim H2; intros; rewrite (StepFun_P8 H4 H3);
+ rewrite (StepFun_P8 H1 H3); reflexivity.
+assert (H4 := StepFun_P9 H1 H3); simpl in H4;
+ elim (le_Sn_O _ (le_S_n _ _ H4)).
+intros; clear H; unfold adapted_couple_opt in H3; elim H3; clear H3; intros;
+ case (Req_dec a b); intro.
+rewrite (StepFun_P8 H2 H4); rewrite (StepFun_P8 H H4); reflexivity.
+assert (Hyp_min : Rmin a b = a).
+unfold Rmin in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n; assumption ].
+assert (Hyp_max : Rmax a b = b).
+unfold Rmax in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n; assumption ].
+elim (RList_P20 _ (StepFun_P9 H H4)); intros s1 [s2 [s3 H5]]; rewrite H5 in H;
+ rewrite H5; induction lf1 as [| r3 lf1 Hreclf1].
+unfold adapted_couple in H2; decompose [and] H2;
+ clear H H2 H4 H5 H3 H6 H8 H7 H11; simpl in H9; discriminate.
+clear Hreclf1; induction lf2 as [| r4 lf2 Hreclf2].
+unfold adapted_couple in H; decompose [and] H;
+ clear H H2 H4 H5 H3 H6 H8 H7 H11; simpl in H9; discriminate.
+clear Hreclf2; assert (H6 : r = s1).
+unfold adapted_couple in H, H2; decompose [and] H; decompose [and] H2;
+ clear H H2; simpl in H13; simpl in H8; rewrite H13;
+ rewrite H8; reflexivity.
+assert (H7 : r3 = r4 \/ r = r1).
+case (Req_dec r r1); intro.
+right; assumption.
+left; cut (r1 <= s2).
+intro; unfold adapted_couple in H2, H; decompose [and] H; decompose [and] H2;
+ clear H H2; pose (x := (r + r1) / 2); assert (H18 := H14 0%nat);
+ assert (H20 := H19 0%nat); unfold constant_D_eq, open_interval in H18, H20;
+ simpl in H18; simpl in H20; rewrite <- (H18 (lt_O_Sn _) x).
+rewrite <- (H20 (lt_O_Sn _) x).
+reflexivity.
+assert (H21 := H13 0%nat (lt_O_Sn _)); simpl in H21; elim H21; intro;
+ [ idtac | elim H7; assumption ]; unfold x in |- *;
+ split.
+apply Rmult_lt_reg_l with 2;
+ [ prove_sup0
+ | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+ rewrite <- Rinv_r_sym;
+ [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; apply H
+ | discrR ] ].
+apply Rmult_lt_reg_l with 2;
+ [ prove_sup0
+ | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+ rewrite <- Rinv_r_sym;
+ [ rewrite Rmult_1_l; rewrite <- (Rplus_comm r1); rewrite double;
+ apply Rplus_lt_compat_l; apply H
+ | discrR ] ].
+rewrite <- H6; assert (H21 := H13 0%nat (lt_O_Sn _)); simpl in H21; elim H21;
+ intro; [ idtac | elim H7; assumption ]; unfold x in |- *;
+ split.
+apply Rmult_lt_reg_l with 2;
+ [ prove_sup0
+ | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+ rewrite <- Rinv_r_sym;
+ [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; apply H
+ | discrR ] ].
+apply Rlt_le_trans with r1;
+ [ apply Rmult_lt_reg_l with 2;
+ [ prove_sup0
+ | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2));
+ rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym;
+ [ rewrite Rmult_1_l; rewrite <- (Rplus_comm r1); rewrite double;
+ apply Rplus_lt_compat_l; apply H
+ | discrR ] ]
+ | assumption ].
+eapply StepFun_P13.
+apply H4.
+apply H2.
+unfold adapted_couple_opt in |- *; split.
+apply H.
+rewrite H5 in H3; apply H3.
+assert (H8 : r1 <= s2).
+eapply StepFun_P13.
+apply H4.
+apply H2.
+unfold adapted_couple_opt in |- *; split.
+apply H.
+rewrite H5 in H3; apply H3.
+elim H7; intro.
+simpl in |- *; elim H8; intro.
+replace (r4 * (s2 - s1)) with (r3 * (r1 - r) + r3 * (s2 - r1));
+ [ idtac | rewrite H9; rewrite H6; ring ].
+rewrite Rplus_assoc; apply Rplus_eq_compat_l;
+ change
+ (Int_SF lf1 (cons r1 r2) = Int_SF (cons r3 lf2) (cons r1 (cons s2 s3)))
+ in |- *; apply H0 with r1 b.
+unfold adapted_couple in H2; decompose [and] H2; clear H2;
+ replace b with (Rmax a b).
+rewrite <- H12; apply RList_P7;
+ [ assumption | simpl in |- *; right; left; reflexivity ].
+eapply StepFun_P7.
+apply H1.
+apply H2.
+unfold adapted_couple_opt in |- *; split.
+apply StepFun_P7 with a a r3.
+apply H1.
+unfold adapted_couple in H2, H; decompose [and] H2; decompose [and] H;
+ clear H H2; assert (H20 : r = a).
+simpl in H13; rewrite H13; apply Hyp_min.
+unfold adapted_couple in |- *; repeat split.
+unfold ordered_Rlist in |- *; intros; simpl in H; induction i as [| i Hreci].
+simpl in |- *; rewrite <- H20; apply (H11 0%nat).
+simpl in |- *; apply lt_O_Sn.
+induction i as [| i Hreci0].
+simpl in |- *; assumption.
+change (pos_Rl (cons s2 s3) i <= pos_Rl (cons s2 s3) (S i)) in |- *;
+ apply (H15 (S i)); simpl in |- *; apply lt_S_n; assumption.
+simpl in |- *; symmetry in |- *; apply Hyp_min.
+rewrite <- H17; reflexivity.
+simpl in H19; simpl in |- *; rewrite H19; reflexivity.
+intros; simpl in H; unfold constant_D_eq, open_interval in |- *; intros;
+ induction i as [| i Hreci].
+simpl in |- *; apply (H16 0%nat).
+simpl in |- *; apply lt_O_Sn.
+simpl in H2; rewrite <- H20 in H2; unfold open_interval in |- *;
+ simpl in |- *; apply H2.
+clear Hreci; induction i as [| i Hreci].
+simpl in |- *; simpl in H2; rewrite H9; apply (H21 0%nat).
+simpl in |- *; apply lt_O_Sn.
+unfold open_interval in |- *; simpl in |- *; elim H2; intros; split.
+apply Rle_lt_trans with r1; try assumption; rewrite <- H6; apply (H11 0%nat);
+ simpl in |- *; apply lt_O_Sn.
+assumption.
+clear Hreci; simpl in |- *; apply (H21 (S i)).
+simpl in |- *; apply lt_S_n; assumption.
+unfold open_interval in |- *; apply H2.
+elim H3; clear H3; intros; split.
+rewrite H9;
+ change
+ (forall i:nat,
+ (i < pred (Rlength (cons r4 lf2)))%nat ->
+ pos_Rl (cons r4 lf2) i <> pos_Rl (cons r4 lf2) (S i) \/
+ f (pos_Rl (cons s1 (cons s2 s3)) (S i)) <> pos_Rl (cons r4 lf2) i)
+ in |- *; rewrite <- H5; apply H3.
+rewrite H5 in H11; intros; simpl in H12; induction i as [| i Hreci].
+simpl in |- *; red in |- *; intro; rewrite H13 in H10;
+ elim (Rlt_irrefl _ H10).
+clear Hreci; apply (H11 (S i)); simpl in |- *; apply H12.
+rewrite H9; rewrite H10; rewrite H6; apply Rplus_eq_compat_l; rewrite <- H10;
+ apply H0 with r1 b.
+unfold adapted_couple in H2; decompose [and] H2; clear H2;
+ replace b with (Rmax a b).
+rewrite <- H12; apply RList_P7;
+ [ assumption | simpl in |- *; right; left; reflexivity ].
+eapply StepFun_P7.
+apply H1.
+apply H2.
+unfold adapted_couple_opt in |- *; split.
+apply StepFun_P7 with a a r3.
+apply H1.
+unfold adapted_couple in H2, H; decompose [and] H2; decompose [and] H;
+ clear H H2; assert (H20 : r = a).
+simpl in H13; rewrite H13; apply Hyp_min.
+unfold adapted_couple in |- *; repeat split.
+unfold ordered_Rlist in |- *; intros; simpl in H; induction i as [| i Hreci].
+simpl in |- *; rewrite <- H20; apply (H11 0%nat); simpl in |- *;
+ apply lt_O_Sn.
+rewrite H10; apply (H15 (S i)); simpl in |- *; assumption.
+simpl in |- *; symmetry in |- *; apply Hyp_min.
+rewrite <- H17; rewrite H10; reflexivity.
+simpl in H19; simpl in |- *; apply H19.
+intros; simpl in H; unfold constant_D_eq, open_interval in |- *; intros;
+ induction i as [| i Hreci].
+simpl in |- *; apply (H16 0%nat).
+simpl in |- *; apply lt_O_Sn.
+simpl in H2; rewrite <- H20 in H2; unfold open_interval in |- *;
+ simpl in |- *; apply H2.
+clear Hreci; simpl in |- *; apply (H21 (S i)).
+simpl in |- *; assumption.
+rewrite <- H10; unfold open_interval in |- *; apply H2.
+elim H3; clear H3; intros; split.
+rewrite H5 in H3; intros; apply (H3 (S i)).
+simpl in |- *; replace (Rlength lf2) with (S (pred (Rlength lf2))).
+apply lt_n_S; apply H12.
+symmetry in |- *; apply S_pred with 0%nat; apply neq_O_lt; red in |- *;
+ intro; rewrite <- H13 in H12; elim (lt_n_O _ H12).
+intros; simpl in H12; rewrite H10; rewrite H5 in H11; apply (H11 (S i));
+ simpl in |- *; apply lt_n_S; apply H12.
+simpl in |- *; rewrite H9; unfold Rminus in |- *; rewrite Rplus_opp_r;
+ rewrite Rmult_0_r; rewrite Rplus_0_l;
+ change
+ (Int_SF lf1 (cons r1 r2) = Int_SF (cons r4 lf2) (cons s1 (cons s2 s3)))
+ in |- *; eapply H0.
+apply H1.
+2: rewrite H5 in H3; unfold adapted_couple_opt in |- *; split; assumption.
+assert (H10 : r = a).
+unfold adapted_couple in H2; decompose [and] H2; clear H2; simpl in H12;
+ rewrite H12; apply Hyp_min.
+rewrite <- H9; rewrite H10; apply StepFun_P7 with a r r3;
+ [ apply H1
+ | pattern a at 2 in |- *; rewrite <- H10; pattern r at 2 in |- *; rewrite H9;
+ apply H2 ].
Qed.
-Lemma StepFun_P15 : (f:R->R;l1,l2,lf1,lf2:Rlist;a,b:R) (adapted_couple f a b l1 lf1) -> (adapted_couple_opt f a b l2 lf2) -> (Int_SF lf1 l1)==(Int_SF lf2 l2).
-Intros; Case (total_order_Rle a b); Intro; [Apply (StepFun_P14 r H H0) | Assert H1 : ``b<=a``; [Auto with real | EApply StepFun_P14; [Apply H1 | Apply StepFun_P2; Apply H | Apply StepFun_P12; Apply H0]]].
+Lemma StepFun_P15 :
+ forall (f:R -> R) (l1 l2 lf1 lf2:Rlist) (a b:R),
+ adapted_couple f a b l1 lf1 ->
+ adapted_couple_opt f a b l2 lf2 -> Int_SF lf1 l1 = Int_SF lf2 l2.
+intros; case (Rle_dec a b); intro;
+ [ apply (StepFun_P14 r H H0)
+ | assert (H1 : b <= a);
+ [ auto with real
+ | eapply StepFun_P14;
+ [ apply H1 | apply StepFun_P2; apply H | apply StepFun_P12; apply H0 ] ] ].
Qed.
-Lemma StepFun_P16 : (f:R->R;l,lf:Rlist;a,b:R) (adapted_couple f a b l lf) -> (EXT l':Rlist | (EXT lf':Rlist | (adapted_couple_opt f a b l' lf'))).
-Intros; Case (total_order_Rle a b); Intro; [Apply (StepFun_P10 r H) | Assert H1 : ``b<=a``; [Auto with real | Assert H2 := (StepFun_P10 H1 (StepFun_P2 H)); Elim H2; Intros l' [lf' H3]; Exists l'; Exists lf'; Apply StepFun_P12; Assumption]].
+Lemma StepFun_P16 :
+ forall (f:R -> R) (l lf:Rlist) (a b:R),
+ adapted_couple f a b l lf ->
+ exists l' : Rlist
+ | ( exists lf' : Rlist | adapted_couple_opt f a b l' lf').
+intros; case (Rle_dec a b); intro;
+ [ apply (StepFun_P10 r H)
+ | assert (H1 : b <= a);
+ [ auto with real
+ | assert (H2 := StepFun_P10 H1 (StepFun_P2 H)); elim H2;
+ intros l' [lf' H3]; exists l'; exists lf'; apply StepFun_P12;
+ assumption ] ].
Qed.
-Lemma StepFun_P17 : (f:R->R;l1,l2,lf1,lf2:Rlist;a,b:R) (adapted_couple f a b l1 lf1) -> (adapted_couple f a b l2 lf2) -> (Int_SF lf1 l1)==(Int_SF lf2 l2).
-Intros; Elim (StepFun_P16 H); Intros l' [lf' H1]; Rewrite (StepFun_P15 H H1); Rewrite (StepFun_P15 H0 H1); Reflexivity.
+Lemma StepFun_P17 :
+ forall (f:R -> R) (l1 l2 lf1 lf2:Rlist) (a b:R),
+ adapted_couple f a b l1 lf1 ->
+ adapted_couple f a b l2 lf2 -> Int_SF lf1 l1 = Int_SF lf2 l2.
+intros; elim (StepFun_P16 H); intros l' [lf' H1]; rewrite (StepFun_P15 H H1);
+ rewrite (StepFun_P15 H0 H1); reflexivity.
Qed.
-Lemma StepFun_P18 : (a,b,c:R) (RiemannInt_SF (mkStepFun (StepFun_P4 a b c)))==``c*(b-a)``.
-Intros; Unfold RiemannInt_SF; Case (total_order_Rle a b); Intro.
-Replace (Int_SF (subdivision_val (mkStepFun (StepFun_P4 a b c))) (subdivision (mkStepFun (StepFun_P4 a b c)))) with (Int_SF (cons c nil) (cons a (cons b nil))); [Simpl; Ring | Apply StepFun_P17 with (fct_cte c) a b; [Apply StepFun_P3; Assumption | Apply (StepFun_P1 (mkStepFun (StepFun_P4 a b c)))]].
-Replace (Int_SF (subdivision_val (mkStepFun (StepFun_P4 a b c))) (subdivision (mkStepFun (StepFun_P4 a b c)))) with (Int_SF (cons c nil) (cons b (cons a nil))); [Simpl; Ring | Apply StepFun_P17 with (fct_cte c) a b; [Apply StepFun_P2; Apply StepFun_P3; Auto with real | Apply (StepFun_P1 (mkStepFun (StepFun_P4 a b c)))]].
+Lemma StepFun_P18 :
+ forall a b c:R, RiemannInt_SF (mkStepFun (StepFun_P4 a b c)) = c * (b - a).
+intros; unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro.
+replace
+ (Int_SF (subdivision_val (mkStepFun (StepFun_P4 a b c)))
+ (subdivision (mkStepFun (StepFun_P4 a b c)))) with
+ (Int_SF (cons c nil) (cons a (cons b nil)));
+ [ simpl in |- *; ring
+ | apply StepFun_P17 with (fct_cte c) a b;
+ [ apply StepFun_P3; assumption
+ | apply (StepFun_P1 (mkStepFun (StepFun_P4 a b c))) ] ].
+replace
+ (Int_SF (subdivision_val (mkStepFun (StepFun_P4 a b c)))
+ (subdivision (mkStepFun (StepFun_P4 a b c)))) with
+ (Int_SF (cons c nil) (cons b (cons a nil)));
+ [ simpl in |- *; ring
+ | apply StepFun_P17 with (fct_cte c) a b;
+ [ apply StepFun_P2; apply StepFun_P3; auto with real
+ | apply (StepFun_P1 (mkStepFun (StepFun_P4 a b c))) ] ].
Qed.
-Lemma StepFun_P19 : (l1:Rlist;f,g:R->R;l:R) (Int_SF (FF l1 [x:R]``(f x)+l*(g x)``) l1)==``(Int_SF (FF l1 f) l1)+l*(Int_SF (FF l1 g) l1)``.
-Intros; Induction l1; [Simpl; Ring | Induction l1; Simpl; [Ring | Simpl in Hrecl1; Rewrite Hrecl1; Ring]].
+Lemma StepFun_P19 :
+ forall (l1:Rlist) (f g:R -> R) (l:R),
+ Int_SF (FF l1 (fun x:R => f x + l * g x)) l1 =
+ Int_SF (FF l1 f) l1 + l * Int_SF (FF l1 g) l1.
+intros; induction l1 as [| r l1 Hrecl1];
+ [ simpl in |- *; ring
+ | induction l1 as [| r0 l1 Hrecl0]; simpl in |- *;
+ [ ring | simpl in Hrecl1; rewrite Hrecl1; ring ] ].
Qed.
-Lemma StepFun_P20 : (l:Rlist;f:R->R) (lt O (Rlength l)) -> (Rlength l)=(S (Rlength (FF l f))).
-Intros l f H; NewInduction l; [Elim (lt_n_n ? H) | Simpl; Rewrite RList_P18; Rewrite RList_P14; Reflexivity].
+Lemma StepFun_P20 :
+ forall (l:Rlist) (f:R -> R),
+ (0 < Rlength l)%nat -> Rlength l = S (Rlength (FF l f)).
+intros l f H; induction l;
+ [ elim (lt_irrefl _ H)
+ | simpl in |- *; rewrite RList_P18; rewrite RList_P14; reflexivity ].
Qed.
-Lemma StepFun_P21 : (a,b:R;f:R->R;l:Rlist) (is_subdivision f a b l) -> (adapted_couple f a b l (FF l f)).
-Intros; Unfold adapted_couple; Unfold is_subdivision in X; Unfold adapted_couple in X; Elim X; Clear X; Intros; Decompose [and] p; Clear p; Repeat Split; Try Assumption.
-Apply StepFun_P20; Rewrite H2; Apply lt_O_Sn.
-Intros; Assert H5 := (H4 ? H3); Unfold constant_D_eq open_interval in H5; Unfold constant_D_eq open_interval; Intros; Induction l.
-Discriminate.
-Unfold FF; Rewrite RList_P12.
-Simpl; Change (f x0)==(f (pos_Rl (mid_Rlist (cons r l) r) (S i))); Rewrite RList_P13; Try Assumption; Rewrite (H5 x0 H6); Rewrite H5.
-Reflexivity.
-Split.
-Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Elim H6; Intros; Apply Rlt_trans with x0; Assumption | DiscrR]].
-Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Rewrite (Rplus_sym (pos_Rl (cons r l) i)); Apply Rlt_compatibility; Elim H6; Intros; Apply Rlt_trans with x0; Assumption | DiscrR]].
-Rewrite RList_P14; Simpl in H3; Apply H3.
+Lemma StepFun_P21 :
+ forall (a b:R) (f:R -> R) (l:Rlist),
+ is_subdivision f a b l -> adapted_couple f a b l (FF l f).
+intros; unfold adapted_couple in |- *; unfold is_subdivision in X;
+ unfold adapted_couple in X; elim X; clear X; intros;
+ decompose [and] p; clear p; repeat split; try assumption.
+apply StepFun_P20; rewrite H2; apply lt_O_Sn.
+intros; assert (H5 := H4 _ H3); unfold constant_D_eq, open_interval in H5;
+ unfold constant_D_eq, open_interval in |- *; intros;
+ induction l as [| r l Hrecl].
+discriminate.
+unfold FF in |- *; rewrite RList_P12.
+simpl in |- *;
+ change (f x0 = f (pos_Rl (mid_Rlist (cons r l) r) (S i))) in |- *;
+ rewrite RList_P13; try assumption; rewrite (H5 x0 H6);
+ rewrite H5.
+reflexivity.
+split.
+apply Rmult_lt_reg_l with 2;
+ [ prove_sup0
+ | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+ rewrite <- Rinv_r_sym;
+ [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; elim H6;
+ intros; apply Rlt_trans with x0; assumption
+ | discrR ] ].
+apply Rmult_lt_reg_l with 2;
+ [ prove_sup0
+ | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+ rewrite <- Rinv_r_sym;
+ [ rewrite Rmult_1_l; rewrite double;
+ rewrite (Rplus_comm (pos_Rl (cons r l) i));
+ apply Rplus_lt_compat_l; elim H6; intros; apply Rlt_trans with x0;
+ assumption
+ | discrR ] ].
+rewrite RList_P14; simpl in H3; apply H3.
Qed.
-Lemma StepFun_P22 : (a,b:R;f,g:R->R;lf,lg:Rlist) ``a<=b`` -> (is_subdivision f a b lf) -> (is_subdivision g a b lg) -> (is_subdivision f a b (cons_ORlist lf lg)).
-Unfold is_subdivision; Intros a b f g lf lg Hyp X X0; Elim X; Elim X0; Clear X X0; Intros lg0 p lf0 p0; Assert Hyp_min : (Rmin a b)==a.
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Assert Hyp_max : (Rmax a b)==b.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Apply existTT with (FF (cons_ORlist lf lg) f); Unfold adapted_couple in p p0; Decompose [and] p; Decompose [and] p0; Clear p p0; Rewrite Hyp_min in H6; Rewrite Hyp_min in H1; Rewrite Hyp_max in H0; Rewrite Hyp_max in H5; Unfold adapted_couple; Repeat Split.
-Apply RList_P2; Assumption.
-Rewrite Hyp_min; Symmetry; Apply Rle_antisym.
-Induction lf.
-Simpl; Right; Symmetry; Assumption.
-Assert H10 : (In (pos_Rl (cons_ORlist (cons r lf) lg) (0)) (cons_ORlist (cons r lf) lg)).
-Elim (RList_P3 (cons_ORlist (cons r lf) lg) (pos_Rl (cons_ORlist (cons r lf) lg) (0))); Intros _ H10; Apply H10; Exists O; Split; [Reflexivity | Rewrite RList_P11; Simpl; Apply lt_O_Sn].
-Elim (RList_P9 (cons r lf) lg (pos_Rl (cons_ORlist (cons r lf) lg) (0))); Intros H12 _; Assert H13 := (H12 H10); Elim H13; Intro.
-Elim (RList_P3 (cons r lf) (pos_Rl (cons_ORlist (cons r lf) lg) (0))); Intros H11 _; Assert H14 := (H11 H8); Elim H14; Intros; Elim H15; Clear H15; Intros; Rewrite H15; Rewrite <- H6; Elim (RList_P6 (cons r lf)); Intros; Apply H17; [Assumption | Apply le_O_n | Assumption].
-Elim (RList_P3 lg (pos_Rl (cons_ORlist (cons r lf) lg) (0))); Intros H11 _; Assert H14 := (H11 H8); Elim H14; Intros; Elim H15; Clear H15; Intros; Rewrite H15; Rewrite <- H1; Elim (RList_P6 lg); Intros; Apply H17; [Assumption | Apply le_O_n | Assumption].
-Induction lf.
-Simpl; Right; Assumption.
-Assert H8 : (In a (cons_ORlist (cons r lf) lg)).
-Elim (RList_P9 (cons r lf) lg a); Intros; Apply H10; Left; Elim (RList_P3 (cons r lf) a); Intros; Apply H12; Exists O; Split; [Symmetry; Assumption | Simpl; Apply lt_O_Sn].
-Apply RList_P5; [Apply RList_P2; Assumption | Assumption].
-Rewrite Hyp_max; Apply Rle_antisym.
-Induction lf.
-Simpl; Right; Assumption.
-Assert H8 : (In (pos_Rl (cons_ORlist (cons r lf) lg) (pred (Rlength (cons_ORlist (cons r lf) lg)))) (cons_ORlist (cons r lf) lg)).
-Elim (RList_P3 (cons_ORlist (cons r lf) lg) (pos_Rl (cons_ORlist (cons r lf) lg) (pred (Rlength (cons_ORlist (cons r lf) lg))))); Intros _ H10; Apply H10; Exists (pred (Rlength (cons_ORlist (cons r lf) lg))); Split; [Reflexivity | Rewrite RList_P11; Simpl; Apply lt_n_Sn].
-Elim (RList_P9 (cons r lf) lg (pos_Rl (cons_ORlist (cons r lf) lg) (pred (Rlength (cons_ORlist (cons r lf) lg))))); Intros H10 _.
-Assert H11 := (H10 H8); Elim H11; Intro.
-Elim (RList_P3 (cons r lf) (pos_Rl (cons_ORlist (cons r lf) lg) (pred (Rlength (cons_ORlist (cons r lf) lg))))); Intros H13 _; Assert H14 := (H13 H12); Elim H14; Intros; Elim H15; Clear H15; Intros; Rewrite H15; Rewrite <- H5; Elim (RList_P6 (cons r lf)); Intros; Apply H17; [Assumption | Simpl; Simpl in H14; Apply lt_n_Sm_le; Assumption | Simpl; Apply lt_n_Sn].
-Elim (RList_P3 lg (pos_Rl (cons_ORlist (cons r lf) lg) (pred (Rlength (cons_ORlist (cons r lf) lg))))); Intros H13 _; Assert H14 := (H13 H12); Elim H14; Intros; Elim H15; Clear H15; Intros.
-Rewrite H15; Assert H17 : (Rlength lg)=(S (pred (Rlength lg))).
-Apply S_pred with O; Apply neq_O_lt; Red; Intro; Rewrite <- H17 in H16; Elim (lt_n_O ? H16).
-Rewrite <- H0; Elim (RList_P6 lg); Intros; Apply H18; [Assumption | Rewrite H17 in H16; Apply lt_n_Sm_le; Assumption | Apply lt_pred_n_n; Rewrite H17; Apply lt_O_Sn].
-Induction lf.
-Simpl; Right; Symmetry; Assumption.
-Assert H8 : (In b (cons_ORlist (cons r lf) lg)).
-Elim (RList_P9 (cons r lf) lg b); Intros; Apply H10; Left; Elim (RList_P3 (cons r lf) b); Intros; Apply H12; Exists (pred (Rlength (cons r lf))); Split; [Symmetry; Assumption | Simpl; Apply lt_n_Sn].
-Apply RList_P7; [Apply RList_P2; Assumption | Assumption].
-Apply StepFun_P20; Rewrite RList_P11; Rewrite H2; Rewrite H7; Simpl; Apply lt_O_Sn.
-Intros; Unfold constant_D_eq open_interval; Intros; Cut (EXT l:R | (constant_D_eq f (open_interval (pos_Rl (cons_ORlist lf lg) i) (pos_Rl (cons_ORlist lf lg) (S i))) l)).
-Intros; Elim H11; Clear H11; Intros; Assert H12 := H11; Assert Hyp_cons : (EXT r:R | (EXT r0:Rlist | (cons_ORlist lf lg)==(cons r r0))).
-Apply RList_P19; Red; Intro; Rewrite H13 in H8; Elim (lt_n_O ? H8).
-Elim Hyp_cons; Clear Hyp_cons; Intros r [r0 Hyp_cons]; Rewrite Hyp_cons; Unfold FF; Rewrite RList_P12.
-Change (f x)==(f (pos_Rl (mid_Rlist (cons r r0) r) (S i))); Rewrite <- Hyp_cons; Rewrite RList_P13.
-Assert H13 := (RList_P2 ? ? H ? H8); Elim H13; Intro.
-Unfold constant_D_eq open_interval in H11 H12; Rewrite (H11 x H10); Assert H15 : ``(pos_Rl (cons_ORlist lf lg) i)<((pos_Rl (cons_ORlist lf lg) i)+(pos_Rl (cons_ORlist lf lg) (S i)))/2<(pos_Rl (cons_ORlist lf lg) (S i))``.
-Split.
-Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
-Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Rewrite (Rplus_sym (pos_Rl (cons_ORlist lf lg) i)); Apply Rlt_compatibility; Assumption | DiscrR]].
-Rewrite (H11 ? H15); Reflexivity.
-Elim H10; Intros; Rewrite H14 in H15; Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H16 H15)).
-Apply H8.
-Rewrite RList_P14; Rewrite Hyp_cons in H8; Simpl in H8; Apply H8.
-Assert H11 : ``a<b``.
-Apply Rle_lt_trans with (pos_Rl (cons_ORlist lf lg) i).
-Rewrite <- H6; Rewrite <- (RList_P15 lf lg).
-Elim (RList_P6 (cons_ORlist lf lg)); Intros; Apply H11.
-Apply RList_P2; Assumption.
-Apply le_O_n.
-Apply lt_trans with (pred (Rlength (cons_ORlist lf lg))); [Assumption | Apply lt_pred_n_n; Apply neq_O_lt; Red; Intro; Rewrite <- H13 in H8; Elim (lt_n_O ? H8)].
-Assumption.
-Assumption.
-Rewrite H1; Assumption.
-Apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)).
-Elim H10; Intros; Apply Rlt_trans with x; Assumption.
-Rewrite <- H5; Rewrite <- (RList_P16 lf lg); Try Assumption.
-Elim (RList_P6 (cons_ORlist lf lg)); Intros; Apply H11.
-Apply RList_P2; Assumption.
-Apply lt_n_Sm_le; Apply lt_n_S; Assumption.
-Apply lt_pred_n_n; Apply neq_O_lt; Red; Intro; Rewrite <- H13 in H8; Elim (lt_n_O ? H8).
-Rewrite H0; Assumption.
-Pose I := [j:nat]``(pos_Rl lf j)<=(pos_Rl (cons_ORlist lf lg) i)``/\(lt j (Rlength lf)); Assert H12 : (Nbound I).
-Unfold Nbound; Exists (Rlength lf); Intros; Unfold I in H12; Elim H12; Intros; Apply lt_le_weak; Assumption.
-Assert H13 : (EX n:nat | (I n)).
-Exists O; Unfold I; Split.
-Apply Rle_trans with (pos_Rl (cons_ORlist lf lg) O).
-Right; Symmetry.
-Apply RList_P15; Try Assumption; Rewrite H1; Assumption.
-Elim (RList_P6 (cons_ORlist lf lg)); Intros; Apply H13.
-Apply RList_P2; Assumption.
-Apply le_O_n.
-Apply lt_trans with (pred (Rlength (cons_ORlist lf lg))).
-Assumption.
-Apply lt_pred_n_n; Apply neq_O_lt; Red; Intro; Rewrite <- H15 in H8; Elim (lt_n_O ? H8).
-Apply neq_O_lt; Red; Intro; Rewrite <- H13 in H5; Rewrite <- H6 in H11; Rewrite <- H5 in H11; Elim (Rlt_antirefl ? H11).
-Assert H14 := (Nzorn H13 H12); Elim H14; Clear H14; Intros x0 H14; Exists (pos_Rl lf0 x0); Unfold constant_D_eq open_interval; Intros; Assert H16 := (H9 x0); Assert H17 : (lt x0 (pred (Rlength lf))).
-Elim H14; Clear H14; Intros; Unfold I in H14; Elim H14; Clear H14; Intros; Apply lt_S_n; Replace (S (pred (Rlength lf))) with (Rlength lf).
-Inversion H18.
-2:Apply lt_n_S; Assumption.
-Cut x0=(pred (Rlength lf)).
-Intro; Rewrite H19 in H14; Rewrite H5 in H14; Cut ``(pos_Rl (cons_ORlist lf lg) i)<b``.
-Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H14 H21)).
-Apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)).
-Elim H10; Intros; Apply Rlt_trans with x; Assumption.
-Rewrite <- H5; Apply Rle_trans with (pos_Rl (cons_ORlist lf lg) (pred (Rlength (cons_ORlist lf lg)))).
-Elim (RList_P6 (cons_ORlist lf lg)); Intros; Apply H21.
-Apply RList_P2; Assumption.
-Apply lt_n_Sm_le; Apply lt_n_S; Assumption.
-Apply lt_pred_n_n; Apply neq_O_lt; Red; Intro; Rewrite <- H23 in H8; Elim (lt_n_O ? H8).
-Right; Apply RList_P16; Try Assumption; Rewrite H0; Assumption.
-Rewrite <- H20; Reflexivity.
-Apply S_pred with O; Apply neq_O_lt; Red; Intro; Rewrite <- H19 in H18; Elim (lt_n_O ? H18).
-Assert H18 := (H16 H17); Unfold constant_D_eq open_interval in H18; Rewrite (H18 x1).
-Reflexivity.
-Elim H15; Clear H15; Intros; Elim H14; Clear H14; Intros; Unfold I in H14; Elim H14; Clear H14; Intros; Split.
-Apply Rle_lt_trans with (pos_Rl (cons_ORlist lf lg) i); Assumption.
-Apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)); Try Assumption.
-Assert H22 : (lt (S x0) (Rlength lf)).
-Replace (Rlength lf) with (S (pred (Rlength lf))); [Apply lt_n_S; Assumption | Symmetry; Apply S_pred with O; Apply neq_O_lt; Red; Intro; Rewrite <- H22 in H21; Elim (lt_n_O ? H21)].
-Elim (total_order_Rle (pos_Rl lf (S x0)) (pos_Rl (cons_ORlist lf lg) i)); Intro.
-Assert H23 : (le (S x0) x0).
-Apply H20; Unfold I; Split; Assumption.
-Elim (le_Sn_n ? H23).
-Assert H23 : ``(pos_Rl (cons_ORlist lf lg) i)<(pos_Rl lf (S x0))``.
-Auto with real.
-Clear b0; Apply RList_P17; Try Assumption.
-Apply RList_P2; Assumption.
-Elim (RList_P9 lf lg (pos_Rl lf (S x0))); Intros; Apply H25; Left; Elim (RList_P3 lf (pos_Rl lf (S x0))); Intros; Apply H27; Exists (S x0); Split; [Reflexivity | Apply H22].
+Lemma StepFun_P22 :
+ forall (a b:R) (f g:R -> R) (lf lg:Rlist),
+ a <= b ->
+ is_subdivision f a b lf ->
+ is_subdivision g a b lg -> is_subdivision f a b (cons_ORlist lf lg).
+unfold is_subdivision in |- *; intros a b f g lf lg Hyp X X0; elim X; elim X0;
+ clear X X0; intros lg0 p lf0 p0; assert (Hyp_min : Rmin a b = a).
+unfold Rmin in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n; assumption ].
+assert (Hyp_max : Rmax a b = b).
+unfold Rmax in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n; assumption ].
+apply existT with (FF (cons_ORlist lf lg) f); unfold adapted_couple in p, p0;
+ decompose [and] p; decompose [and] p0; clear p p0;
+ rewrite Hyp_min in H6; rewrite Hyp_min in H1; rewrite Hyp_max in H0;
+ rewrite Hyp_max in H5; unfold adapted_couple in |- *;
+ repeat split.
+apply RList_P2; assumption.
+rewrite Hyp_min; symmetry in |- *; apply Rle_antisym.
+induction lf as [| r lf Hreclf].
+simpl in |- *; right; symmetry in |- *; assumption.
+assert
+ (H10 :
+ In (pos_Rl (cons_ORlist (cons r lf) lg) 0) (cons_ORlist (cons r lf) lg)).
+elim
+ (RList_P3 (cons_ORlist (cons r lf) lg)
+ (pos_Rl (cons_ORlist (cons r lf) lg) 0)); intros _ H10;
+ apply H10; exists 0%nat; split;
+ [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_O_Sn ].
+elim (RList_P9 (cons r lf) lg (pos_Rl (cons_ORlist (cons r lf) lg) 0));
+ intros H12 _; assert (H13 := H12 H10); elim H13; intro.
+elim (RList_P3 (cons r lf) (pos_Rl (cons_ORlist (cons r lf) lg) 0));
+ intros H11 _; assert (H14 := H11 H8); elim H14; intros;
+ elim H15; clear H15; intros; rewrite H15; rewrite <- H6;
+ elim (RList_P6 (cons r lf)); intros; apply H17;
+ [ assumption | apply le_O_n | assumption ].
+elim (RList_P3 lg (pos_Rl (cons_ORlist (cons r lf) lg) 0)); intros H11 _;
+ assert (H14 := H11 H8); elim H14; intros; elim H15;
+ clear H15; intros; rewrite H15; rewrite <- H1; elim (RList_P6 lg);
+ intros; apply H17; [ assumption | apply le_O_n | assumption ].
+induction lf as [| r lf Hreclf].
+simpl in |- *; right; assumption.
+assert (H8 : In a (cons_ORlist (cons r lf) lg)).
+elim (RList_P9 (cons r lf) lg a); intros; apply H10; left;
+ elim (RList_P3 (cons r lf) a); intros; apply H12;
+ exists 0%nat; split;
+ [ symmetry in |- *; assumption | simpl in |- *; apply lt_O_Sn ].
+apply RList_P5; [ apply RList_P2; assumption | assumption ].
+rewrite Hyp_max; apply Rle_antisym.
+induction lf as [| r lf Hreclf].
+simpl in |- *; right; assumption.
+assert
+ (H8 :
+ In
+ (pos_Rl (cons_ORlist (cons r lf) lg)
+ (pred (Rlength (cons_ORlist (cons r lf) lg))))
+ (cons_ORlist (cons r lf) lg)).
+elim
+ (RList_P3 (cons_ORlist (cons r lf) lg)
+ (pos_Rl (cons_ORlist (cons r lf) lg)
+ (pred (Rlength (cons_ORlist (cons r lf) lg)))));
+ intros _ H10; apply H10;
+ exists (pred (Rlength (cons_ORlist (cons r lf) lg)));
+ split; [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_n_Sn ].
+elim
+ (RList_P9 (cons r lf) lg
+ (pos_Rl (cons_ORlist (cons r lf) lg)
+ (pred (Rlength (cons_ORlist (cons r lf) lg)))));
+ intros H10 _.
+assert (H11 := H10 H8); elim H11; intro.
+elim
+ (RList_P3 (cons r lf)
+ (pos_Rl (cons_ORlist (cons r lf) lg)
+ (pred (Rlength (cons_ORlist (cons r lf) lg)))));
+ intros H13 _; assert (H14 := H13 H12); elim H14; intros;
+ elim H15; clear H15; intros; rewrite H15; rewrite <- H5;
+ elim (RList_P6 (cons r lf)); intros; apply H17;
+ [ assumption
+ | simpl in |- *; simpl in H14; apply lt_n_Sm_le; assumption
+ | simpl in |- *; apply lt_n_Sn ].
+elim
+ (RList_P3 lg
+ (pos_Rl (cons_ORlist (cons r lf) lg)
+ (pred (Rlength (cons_ORlist (cons r lf) lg)))));
+ intros H13 _; assert (H14 := H13 H12); elim H14; intros;
+ elim H15; clear H15; intros.
+rewrite H15; assert (H17 : Rlength lg = S (pred (Rlength lg))).
+apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro;
+ rewrite <- H17 in H16; elim (lt_n_O _ H16).
+rewrite <- H0; elim (RList_P6 lg); intros; apply H18;
+ [ assumption
+ | rewrite H17 in H16; apply lt_n_Sm_le; assumption
+ | apply lt_pred_n_n; rewrite H17; apply lt_O_Sn ].
+induction lf as [| r lf Hreclf].
+simpl in |- *; right; symmetry in |- *; assumption.
+assert (H8 : In b (cons_ORlist (cons r lf) lg)).
+elim (RList_P9 (cons r lf) lg b); intros; apply H10; left;
+ elim (RList_P3 (cons r lf) b); intros; apply H12;
+ exists (pred (Rlength (cons r lf))); split;
+ [ symmetry in |- *; assumption | simpl in |- *; apply lt_n_Sn ].
+apply RList_P7; [ apply RList_P2; assumption | assumption ].
+apply StepFun_P20; rewrite RList_P11; rewrite H2; rewrite H7; simpl in |- *;
+ apply lt_O_Sn.
+intros; unfold constant_D_eq, open_interval in |- *; intros;
+ cut
+ ( exists l : R
+ | constant_D_eq f
+ (open_interval (pos_Rl (cons_ORlist lf lg) i)
+ (pos_Rl (cons_ORlist lf lg) (S i))) l).
+intros; elim H11; clear H11; intros; assert (H12 := H11);
+ assert
+ (Hyp_cons :
+ exists r : R | ( exists r0 : Rlist | cons_ORlist lf lg = cons r r0)).
+apply RList_P19; red in |- *; intro; rewrite H13 in H8; elim (lt_n_O _ H8).
+elim Hyp_cons; clear Hyp_cons; intros r [r0 Hyp_cons]; rewrite Hyp_cons;
+ unfold FF in |- *; rewrite RList_P12.
+change (f x = f (pos_Rl (mid_Rlist (cons r r0) r) (S i))) in |- *;
+ rewrite <- Hyp_cons; rewrite RList_P13.
+assert (H13 := RList_P2 _ _ H _ H8); elim H13; intro.
+unfold constant_D_eq, open_interval in H11, H12; rewrite (H11 x H10);
+ assert
+ (H15 :
+ pos_Rl (cons_ORlist lf lg) i <
+ (pos_Rl (cons_ORlist lf lg) i + pos_Rl (cons_ORlist lf lg) (S i)) / 2 <
+ pos_Rl (cons_ORlist lf lg) (S i)).
+split.
+apply Rmult_lt_reg_l with 2;
+ [ prove_sup0
+ | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+ rewrite <- Rinv_r_sym;
+ [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption
+ | discrR ] ].
+apply Rmult_lt_reg_l with 2;
+ [ prove_sup0
+ | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+ rewrite <- Rinv_r_sym;
+ [ rewrite Rmult_1_l; rewrite double;
+ rewrite (Rplus_comm (pos_Rl (cons_ORlist lf lg) i));
+ apply Rplus_lt_compat_l; assumption
+ | discrR ] ].
+rewrite (H11 _ H15); reflexivity.
+elim H10; intros; rewrite H14 in H15;
+ elim (Rlt_irrefl _ (Rlt_trans _ _ _ H16 H15)).
+apply H8.
+rewrite RList_P14; rewrite Hyp_cons in H8; simpl in H8; apply H8.
+assert (H11 : a < b).
+apply Rle_lt_trans with (pos_Rl (cons_ORlist lf lg) i).
+rewrite <- H6; rewrite <- (RList_P15 lf lg).
+elim (RList_P6 (cons_ORlist lf lg)); intros; apply H11.
+apply RList_P2; assumption.
+apply le_O_n.
+apply lt_trans with (pred (Rlength (cons_ORlist lf lg)));
+ [ assumption
+ | apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro;
+ rewrite <- H13 in H8; elim (lt_n_O _ H8) ].
+assumption.
+assumption.
+rewrite H1; assumption.
+apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)).
+elim H10; intros; apply Rlt_trans with x; assumption.
+rewrite <- H5; rewrite <- (RList_P16 lf lg); try assumption.
+elim (RList_P6 (cons_ORlist lf lg)); intros; apply H11.
+apply RList_P2; assumption.
+apply lt_n_Sm_le; apply lt_n_S; assumption.
+apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H8;
+ elim (lt_n_O _ H8).
+rewrite H0; assumption.
+pose
+ (I :=
+ fun j:nat =>
+ pos_Rl lf j <= pos_Rl (cons_ORlist lf lg) i /\ (j < Rlength lf)%nat);
+ assert (H12 : Nbound I).
+unfold Nbound in |- *; exists (Rlength lf); intros; unfold I in H12; elim H12;
+ intros; apply lt_le_weak; assumption.
+assert (H13 : exists n : nat | I n).
+exists 0%nat; unfold I in |- *; split.
+apply Rle_trans with (pos_Rl (cons_ORlist lf lg) 0).
+right; symmetry in |- *.
+apply RList_P15; try assumption; rewrite H1; assumption.
+elim (RList_P6 (cons_ORlist lf lg)); intros; apply H13.
+apply RList_P2; assumption.
+apply le_O_n.
+apply lt_trans with (pred (Rlength (cons_ORlist lf lg))).
+assumption.
+apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H15 in H8;
+ elim (lt_n_O _ H8).
+apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H5;
+ rewrite <- H6 in H11; rewrite <- H5 in H11; elim (Rlt_irrefl _ H11).
+assert (H14 := Nzorn H13 H12); elim H14; clear H14; intros x0 H14;
+ exists (pos_Rl lf0 x0); unfold constant_D_eq, open_interval in |- *;
+ intros; assert (H16 := H9 x0); assert (H17 : (x0 < pred (Rlength lf))%nat).
+elim H14; clear H14; intros; unfold I in H14; elim H14; clear H14; intros;
+ apply lt_S_n; replace (S (pred (Rlength lf))) with (Rlength lf).
+inversion H18.
+2: apply lt_n_S; assumption.
+cut (x0 = pred (Rlength lf)).
+intro; rewrite H19 in H14; rewrite H5 in H14;
+ cut (pos_Rl (cons_ORlist lf lg) i < b).
+intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H14 H21)).
+apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)).
+elim H10; intros; apply Rlt_trans with x; assumption.
+rewrite <- H5;
+ apply Rle_trans with
+ (pos_Rl (cons_ORlist lf lg) (pred (Rlength (cons_ORlist lf lg)))).
+elim (RList_P6 (cons_ORlist lf lg)); intros; apply H21.
+apply RList_P2; assumption.
+apply lt_n_Sm_le; apply lt_n_S; assumption.
+apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H23 in H8;
+ elim (lt_n_O _ H8).
+right; apply RList_P16; try assumption; rewrite H0; assumption.
+rewrite <- H20; reflexivity.
+apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro;
+ rewrite <- H19 in H18; elim (lt_n_O _ H18).
+assert (H18 := H16 H17); unfold constant_D_eq, open_interval in H18;
+ rewrite (H18 x1).
+reflexivity.
+elim H15; clear H15; intros; elim H14; clear H14; intros; unfold I in H14;
+ elim H14; clear H14; intros; split.
+apply Rle_lt_trans with (pos_Rl (cons_ORlist lf lg) i); assumption.
+apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)); try assumption.
+assert (H22 : (S x0 < Rlength lf)%nat).
+replace (Rlength lf) with (S (pred (Rlength lf)));
+ [ apply lt_n_S; assumption
+ | symmetry in |- *; apply S_pred with 0%nat; apply neq_O_lt; red in |- *;
+ intro; rewrite <- H22 in H21; elim (lt_n_O _ H21) ].
+elim (Rle_dec (pos_Rl lf (S x0)) (pos_Rl (cons_ORlist lf lg) i)); intro.
+assert (H23 : (S x0 <= x0)%nat).
+apply H20; unfold I in |- *; split; assumption.
+elim (le_Sn_n _ H23).
+assert (H23 : pos_Rl (cons_ORlist lf lg) i < pos_Rl lf (S x0)).
+auto with real.
+clear b0; apply RList_P17; try assumption.
+apply RList_P2; assumption.
+elim (RList_P9 lf lg (pos_Rl lf (S x0))); intros; apply H25; left;
+ elim (RList_P3 lf (pos_Rl lf (S x0))); intros; apply H27;
+ exists (S x0); split; [ reflexivity | apply H22 ].
Qed.
-Lemma StepFun_P23 : (a,b:R;f,g:R->R;lf,lg:Rlist) (is_subdivision f a b lf) -> (is_subdivision g a b lg) -> (is_subdivision f a b (cons_ORlist lf lg)).
-Intros; Case (total_order_Rle a b); Intro; [Apply StepFun_P22 with g; Assumption | Apply StepFun_P5; Apply StepFun_P22 with g; [Auto with real | Apply StepFun_P5; Assumption | Apply StepFun_P5; Assumption]].
+Lemma StepFun_P23 :
+ forall (a b:R) (f g:R -> R) (lf lg:Rlist),
+ is_subdivision f a b lf ->
+ is_subdivision g a b lg -> is_subdivision f a b (cons_ORlist lf lg).
+intros; case (Rle_dec a b); intro;
+ [ apply StepFun_P22 with g; assumption
+ | apply StepFun_P5; apply StepFun_P22 with g;
+ [ auto with real
+ | apply StepFun_P5; assumption
+ | apply StepFun_P5; assumption ] ].
Qed.
-Lemma StepFun_P24 : (a,b:R;f,g:R->R;lf,lg:Rlist) ``a<=b`` -> (is_subdivision f a b lf) -> (is_subdivision g a b lg) -> (is_subdivision g a b (cons_ORlist lf lg)).
-Unfold is_subdivision; Intros a b f g lf lg Hyp X X0; Elim X; Elim X0; Clear X X0; Intros lg0 p lf0 p0; Assert Hyp_min : (Rmin a b)==a.
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Assert Hyp_max : (Rmax a b)==b.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Apply existTT with (FF (cons_ORlist lf lg) g); Unfold adapted_couple in p p0; Decompose [and] p; Decompose [and] p0; Clear p p0; Rewrite Hyp_min in H1; Rewrite Hyp_min in H6; Rewrite Hyp_max in H0; Rewrite Hyp_max in H5; Unfold adapted_couple; Repeat Split.
-Apply RList_P2; Assumption.
-Rewrite Hyp_min; Symmetry; Apply Rle_antisym.
-Induction lf.
-Simpl; Right; Symmetry; Assumption.
-Assert H10 : (In (pos_Rl (cons_ORlist (cons r lf) lg) (0)) (cons_ORlist (cons r lf) lg)).
-Elim (RList_P3 (cons_ORlist (cons r lf) lg) (pos_Rl (cons_ORlist (cons r lf) lg) (0))); Intros _ H10; Apply H10; Exists O; Split; [Reflexivity | Rewrite RList_P11; Simpl; Apply lt_O_Sn].
-Elim (RList_P9 (cons r lf) lg (pos_Rl (cons_ORlist (cons r lf) lg) (0))); Intros H12 _; Assert H13 := (H12 H10); Elim H13; Intro.
-Elim (RList_P3 (cons r lf) (pos_Rl (cons_ORlist (cons r lf) lg) (0))); Intros H11 _; Assert H14 := (H11 H8); Elim H14; Intros; Elim H15; Clear H15; Intros; Rewrite H15; Rewrite <- H6; Elim (RList_P6 (cons r lf)); Intros; Apply H17; [Assumption | Apply le_O_n | Assumption].
-Elim (RList_P3 lg (pos_Rl (cons_ORlist (cons r lf) lg) (0))); Intros H11 _; Assert H14 := (H11 H8); Elim H14; Intros; Elim H15; Clear H15; Intros; Rewrite H15; Rewrite <- H1; Elim (RList_P6 lg); Intros; Apply H17; [Assumption | Apply le_O_n | Assumption].
-Induction lf.
-Simpl; Right; Assumption.
-Assert H8 : (In a (cons_ORlist (cons r lf) lg)).
-Elim (RList_P9 (cons r lf) lg a); Intros; Apply H10; Left; Elim (RList_P3 (cons r lf) a); Intros; Apply H12; Exists O; Split; [Symmetry; Assumption | Simpl; Apply lt_O_Sn].
-Apply RList_P5; [Apply RList_P2; Assumption | Assumption].
-Rewrite Hyp_max; Apply Rle_antisym.
-Induction lf.
-Simpl; Right; Assumption.
-Assert H8 : (In (pos_Rl (cons_ORlist (cons r lf) lg) (pred (Rlength (cons_ORlist (cons r lf) lg)))) (cons_ORlist (cons r lf) lg)).
-Elim (RList_P3 (cons_ORlist (cons r lf) lg) (pos_Rl (cons_ORlist (cons r lf) lg) (pred (Rlength (cons_ORlist (cons r lf) lg))))); Intros _ H10; Apply H10; Exists (pred (Rlength (cons_ORlist (cons r lf) lg))); Split; [Reflexivity | Rewrite RList_P11; Simpl; Apply lt_n_Sn].
-Elim (RList_P9 (cons r lf) lg (pos_Rl (cons_ORlist (cons r lf) lg) (pred (Rlength (cons_ORlist (cons r lf) lg))))); Intros H10 _; Assert H11 := (H10 H8); Elim H11; Intro.
-Elim (RList_P3 (cons r lf) (pos_Rl (cons_ORlist (cons r lf) lg) (pred (Rlength (cons_ORlist (cons r lf) lg))))); Intros H13 _; Assert H14 := (H13 H12); Elim H14; Intros; Elim H15; Clear H15; Intros; Rewrite H15; Rewrite <- H5; Elim (RList_P6 (cons r lf)); Intros; Apply H17; [Assumption | Simpl; Simpl in H14; Apply lt_n_Sm_le; Assumption | Simpl; Apply lt_n_Sn].
-Elim (RList_P3 lg (pos_Rl (cons_ORlist (cons r lf) lg) (pred (Rlength (cons_ORlist (cons r lf) lg))))); Intros H13 _; Assert H14 := (H13 H12); Elim H14; Intros; Elim H15; Clear H15; Intros; Rewrite H15; Assert H17 : (Rlength lg)=(S (pred (Rlength lg))).
-Apply S_pred with O; Apply neq_O_lt; Red; Intro; Rewrite <- H17 in H16; Elim (lt_n_O ? H16).
-Rewrite <- H0; Elim (RList_P6 lg); Intros; Apply H18; [Assumption | Rewrite H17 in H16; Apply lt_n_Sm_le; Assumption | Apply lt_pred_n_n; Rewrite H17; Apply lt_O_Sn].
-Induction lf.
-Simpl; Right; Symmetry; Assumption.
-Assert H8 : (In b (cons_ORlist (cons r lf) lg)).
-Elim (RList_P9 (cons r lf) lg b); Intros; Apply H10; Left; Elim (RList_P3 (cons r lf) b); Intros; Apply H12; Exists (pred (Rlength (cons r lf))); Split; [Symmetry; Assumption | Simpl; Apply lt_n_Sn].
-Apply RList_P7; [Apply RList_P2; Assumption | Assumption].
-Apply StepFun_P20; Rewrite RList_P11; Rewrite H7; Rewrite H2; Simpl; Apply lt_O_Sn.
-Unfold constant_D_eq open_interval; Intros; Cut (EXT l:R | (constant_D_eq g (open_interval (pos_Rl (cons_ORlist lf lg) i) (pos_Rl (cons_ORlist lf lg) (S i))) l)).
-Intros; Elim H11; Clear H11; Intros; Assert H12 := H11; Assert Hyp_cons : (EXT r:R | (EXT r0:Rlist | (cons_ORlist lf lg)==(cons r r0))).
-Apply RList_P19; Red; Intro; Rewrite H13 in H8; Elim (lt_n_O ? H8).
-Elim Hyp_cons; Clear Hyp_cons; Intros r [r0 Hyp_cons]; Rewrite Hyp_cons; Unfold FF; Rewrite RList_P12.
-Change (g x)==(g (pos_Rl (mid_Rlist (cons r r0) r) (S i))); Rewrite <- Hyp_cons; Rewrite RList_P13.
-Assert H13 := (RList_P2 ? ? H ? H8); Elim H13; Intro.
-Unfold constant_D_eq open_interval in H11 H12; Rewrite (H11 x H10); Assert H15 : ``(pos_Rl (cons_ORlist lf lg) i)<((pos_Rl (cons_ORlist lf lg) i)+(pos_Rl (cons_ORlist lf lg) (S i)))/2<(pos_Rl (cons_ORlist lf lg) (S i))``.
-Split.
-Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
-Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Rewrite (Rplus_sym (pos_Rl (cons_ORlist lf lg) i)); Apply Rlt_compatibility; Assumption | DiscrR]].
-Rewrite (H11 ? H15); Reflexivity.
-Elim H10; Intros; Rewrite H14 in H15; Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H16 H15)).
-Apply H8.
-Rewrite RList_P14; Rewrite Hyp_cons in H8; Simpl in H8; Apply H8.
-Assert H11 : ``a<b``.
-Apply Rle_lt_trans with (pos_Rl (cons_ORlist lf lg) i).
-Rewrite <- H6; Rewrite <- (RList_P15 lf lg); Try Assumption.
-Elim (RList_P6 (cons_ORlist lf lg)); Intros; Apply H11.
-Apply RList_P2; Assumption.
-Apply le_O_n.
-Apply lt_trans with (pred (Rlength (cons_ORlist lf lg))); [Assumption | Apply lt_pred_n_n; Apply neq_O_lt; Red; Intro; Rewrite <- H13 in H8; Elim (lt_n_O ? H8)].
-Rewrite H1; Assumption.
-Apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)).
-Elim H10; Intros; Apply Rlt_trans with x; Assumption.
-Rewrite <- H5; Rewrite <- (RList_P16 lf lg); Try Assumption.
-Elim (RList_P6 (cons_ORlist lf lg)); Intros; Apply H11.
-Apply RList_P2; Assumption.
-Apply lt_n_Sm_le; Apply lt_n_S; Assumption.
-Apply lt_pred_n_n; Apply neq_O_lt; Red; Intro; Rewrite <- H13 in H8; Elim (lt_n_O ? H8).
-Rewrite H0; Assumption.
-Pose I := [j:nat]``(pos_Rl lg j)<=(pos_Rl (cons_ORlist lf lg) i)``/\(lt j (Rlength lg)); Assert H12 : (Nbound I).
-Unfold Nbound; Exists (Rlength lg); Intros; Unfold I in H12; Elim H12; Intros; Apply lt_le_weak; Assumption.
-Assert H13 : (EX n:nat | (I n)).
-Exists O; Unfold I; Split.
-Apply Rle_trans with (pos_Rl (cons_ORlist lf lg) O).
-Right; Symmetry; Rewrite H1; Rewrite <- H6; Apply RList_P15; Try Assumption; Rewrite H1; Assumption.
-Elim (RList_P6 (cons_ORlist lf lg)); Intros; Apply H13; [Apply RList_P2; Assumption | Apply le_O_n | Apply lt_trans with (pred (Rlength (cons_ORlist lf lg))); [Assumption | Apply lt_pred_n_n; Apply neq_O_lt; Red; Intro; Rewrite <- H15 in H8; Elim (lt_n_O ? H8)]].
-Apply neq_O_lt; Red; Intro; Rewrite <- H13 in H0; Rewrite <- H1 in H11; Rewrite <- H0 in H11; Elim (Rlt_antirefl ? H11).
-Assert H14 := (Nzorn H13 H12); Elim H14; Clear H14; Intros x0 H14; Exists (pos_Rl lg0 x0); Unfold constant_D_eq open_interval; Intros; Assert H16 := (H4 x0); Assert H17 : (lt x0 (pred (Rlength lg))).
-Elim H14; Clear H14; Intros; Unfold I in H14; Elim H14; Clear H14; Intros; Apply lt_S_n; Replace (S (pred (Rlength lg))) with (Rlength lg).
-Inversion H18.
-2:Apply lt_n_S; Assumption.
-Cut x0=(pred (Rlength lg)).
-Intro; Rewrite H19 in H14; Rewrite H0 in H14; Cut ``(pos_Rl (cons_ORlist lf lg) i)<b``.
-Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H14 H21)).
-Apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)).
-Elim H10; Intros; Apply Rlt_trans with x; Assumption.
-Rewrite <- H0; Apply Rle_trans with (pos_Rl (cons_ORlist lf lg) (pred (Rlength (cons_ORlist lf lg)))).
-Elim (RList_P6 (cons_ORlist lf lg)); Intros; Apply H21.
-Apply RList_P2; Assumption.
-Apply lt_n_Sm_le; Apply lt_n_S; Assumption.
-Apply lt_pred_n_n; Apply neq_O_lt; Red; Intro; Rewrite <- H23 in H8; Elim (lt_n_O ? H8).
-Right; Rewrite H0; Rewrite <- H5; Apply RList_P16; Try Assumption.
-Rewrite H0; Assumption.
-Rewrite <- H20; Reflexivity.
-Apply S_pred with O; Apply neq_O_lt; Red; Intro; Rewrite <- H19 in H18; Elim (lt_n_O ? H18).
-Assert H18 := (H16 H17); Unfold constant_D_eq open_interval in H18; Rewrite (H18 x1).
-Reflexivity.
-Elim H15; Clear H15; Intros; Elim H14; Clear H14; Intros; Unfold I in H14; Elim H14; Clear H14; Intros; Split.
-Apply Rle_lt_trans with (pos_Rl (cons_ORlist lf lg) i); Assumption.
-Apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)); Try Assumption.
-Assert H22 : (lt (S x0) (Rlength lg)).
-Replace (Rlength lg) with (S (pred (Rlength lg))).
-Apply lt_n_S; Assumption.
-Symmetry; Apply S_pred with O; Apply neq_O_lt; Red; Intro; Rewrite <- H22 in H21; Elim (lt_n_O ? H21).
-Elim (total_order_Rle (pos_Rl lg (S x0)) (pos_Rl (cons_ORlist lf lg) i)); Intro.
-Assert H23 : (le (S x0) x0); [Apply H20; Unfold I; Split; Assumption | Elim (le_Sn_n ? H23)].
-Assert H23 : ``(pos_Rl (cons_ORlist lf lg) i)<(pos_Rl lg (S x0))``.
-Auto with real.
-Clear b0; Apply RList_P17; Try Assumption; [Apply RList_P2; Assumption | Elim (RList_P9 lf lg (pos_Rl lg (S x0))); Intros; Apply H25; Right; Elim (RList_P3 lg (pos_Rl lg (S x0))); Intros; Apply H27; Exists (S x0); Split; [Reflexivity | Apply H22]].
+Lemma StepFun_P24 :
+ forall (a b:R) (f g:R -> R) (lf lg:Rlist),
+ a <= b ->
+ is_subdivision f a b lf ->
+ is_subdivision g a b lg -> is_subdivision g a b (cons_ORlist lf lg).
+unfold is_subdivision in |- *; intros a b f g lf lg Hyp X X0; elim X; elim X0;
+ clear X X0; intros lg0 p lf0 p0; assert (Hyp_min : Rmin a b = a).
+unfold Rmin in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n; assumption ].
+assert (Hyp_max : Rmax a b = b).
+unfold Rmax in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n; assumption ].
+apply existT with (FF (cons_ORlist lf lg) g); unfold adapted_couple in p, p0;
+ decompose [and] p; decompose [and] p0; clear p p0;
+ rewrite Hyp_min in H1; rewrite Hyp_min in H6; rewrite Hyp_max in H0;
+ rewrite Hyp_max in H5; unfold adapted_couple in |- *;
+ repeat split.
+apply RList_P2; assumption.
+rewrite Hyp_min; symmetry in |- *; apply Rle_antisym.
+induction lf as [| r lf Hreclf].
+simpl in |- *; right; symmetry in |- *; assumption.
+assert
+ (H10 :
+ In (pos_Rl (cons_ORlist (cons r lf) lg) 0) (cons_ORlist (cons r lf) lg)).
+elim
+ (RList_P3 (cons_ORlist (cons r lf) lg)
+ (pos_Rl (cons_ORlist (cons r lf) lg) 0)); intros _ H10;
+ apply H10; exists 0%nat; split;
+ [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_O_Sn ].
+elim (RList_P9 (cons r lf) lg (pos_Rl (cons_ORlist (cons r lf) lg) 0));
+ intros H12 _; assert (H13 := H12 H10); elim H13; intro.
+elim (RList_P3 (cons r lf) (pos_Rl (cons_ORlist (cons r lf) lg) 0));
+ intros H11 _; assert (H14 := H11 H8); elim H14; intros;
+ elim H15; clear H15; intros; rewrite H15; rewrite <- H6;
+ elim (RList_P6 (cons r lf)); intros; apply H17;
+ [ assumption | apply le_O_n | assumption ].
+elim (RList_P3 lg (pos_Rl (cons_ORlist (cons r lf) lg) 0)); intros H11 _;
+ assert (H14 := H11 H8); elim H14; intros; elim H15;
+ clear H15; intros; rewrite H15; rewrite <- H1; elim (RList_P6 lg);
+ intros; apply H17; [ assumption | apply le_O_n | assumption ].
+induction lf as [| r lf Hreclf].
+simpl in |- *; right; assumption.
+assert (H8 : In a (cons_ORlist (cons r lf) lg)).
+elim (RList_P9 (cons r lf) lg a); intros; apply H10; left;
+ elim (RList_P3 (cons r lf) a); intros; apply H12;
+ exists 0%nat; split;
+ [ symmetry in |- *; assumption | simpl in |- *; apply lt_O_Sn ].
+apply RList_P5; [ apply RList_P2; assumption | assumption ].
+rewrite Hyp_max; apply Rle_antisym.
+induction lf as [| r lf Hreclf].
+simpl in |- *; right; assumption.
+assert
+ (H8 :
+ In
+ (pos_Rl (cons_ORlist (cons r lf) lg)
+ (pred (Rlength (cons_ORlist (cons r lf) lg))))
+ (cons_ORlist (cons r lf) lg)).
+elim
+ (RList_P3 (cons_ORlist (cons r lf) lg)
+ (pos_Rl (cons_ORlist (cons r lf) lg)
+ (pred (Rlength (cons_ORlist (cons r lf) lg)))));
+ intros _ H10; apply H10;
+ exists (pred (Rlength (cons_ORlist (cons r lf) lg)));
+ split; [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_n_Sn ].
+elim
+ (RList_P9 (cons r lf) lg
+ (pos_Rl (cons_ORlist (cons r lf) lg)
+ (pred (Rlength (cons_ORlist (cons r lf) lg)))));
+ intros H10 _; assert (H11 := H10 H8); elim H11; intro.
+elim
+ (RList_P3 (cons r lf)
+ (pos_Rl (cons_ORlist (cons r lf) lg)
+ (pred (Rlength (cons_ORlist (cons r lf) lg)))));
+ intros H13 _; assert (H14 := H13 H12); elim H14; intros;
+ elim H15; clear H15; intros; rewrite H15; rewrite <- H5;
+ elim (RList_P6 (cons r lf)); intros; apply H17;
+ [ assumption
+ | simpl in |- *; simpl in H14; apply lt_n_Sm_le; assumption
+ | simpl in |- *; apply lt_n_Sn ].
+elim
+ (RList_P3 lg
+ (pos_Rl (cons_ORlist (cons r lf) lg)
+ (pred (Rlength (cons_ORlist (cons r lf) lg)))));
+ intros H13 _; assert (H14 := H13 H12); elim H14; intros;
+ elim H15; clear H15; intros; rewrite H15;
+ assert (H17 : Rlength lg = S (pred (Rlength lg))).
+apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro;
+ rewrite <- H17 in H16; elim (lt_n_O _ H16).
+rewrite <- H0; elim (RList_P6 lg); intros; apply H18;
+ [ assumption
+ | rewrite H17 in H16; apply lt_n_Sm_le; assumption
+ | apply lt_pred_n_n; rewrite H17; apply lt_O_Sn ].
+induction lf as [| r lf Hreclf].
+simpl in |- *; right; symmetry in |- *; assumption.
+assert (H8 : In b (cons_ORlist (cons r lf) lg)).
+elim (RList_P9 (cons r lf) lg b); intros; apply H10; left;
+ elim (RList_P3 (cons r lf) b); intros; apply H12;
+ exists (pred (Rlength (cons r lf))); split;
+ [ symmetry in |- *; assumption | simpl in |- *; apply lt_n_Sn ].
+apply RList_P7; [ apply RList_P2; assumption | assumption ].
+apply StepFun_P20; rewrite RList_P11; rewrite H7; rewrite H2; simpl in |- *;
+ apply lt_O_Sn.
+unfold constant_D_eq, open_interval in |- *; intros;
+ cut
+ ( exists l : R
+ | constant_D_eq g
+ (open_interval (pos_Rl (cons_ORlist lf lg) i)
+ (pos_Rl (cons_ORlist lf lg) (S i))) l).
+intros; elim H11; clear H11; intros; assert (H12 := H11);
+ assert
+ (Hyp_cons :
+ exists r : R | ( exists r0 : Rlist | cons_ORlist lf lg = cons r r0)).
+apply RList_P19; red in |- *; intro; rewrite H13 in H8; elim (lt_n_O _ H8).
+elim Hyp_cons; clear Hyp_cons; intros r [r0 Hyp_cons]; rewrite Hyp_cons;
+ unfold FF in |- *; rewrite RList_P12.
+change (g x = g (pos_Rl (mid_Rlist (cons r r0) r) (S i))) in |- *;
+ rewrite <- Hyp_cons; rewrite RList_P13.
+assert (H13 := RList_P2 _ _ H _ H8); elim H13; intro.
+unfold constant_D_eq, open_interval in H11, H12; rewrite (H11 x H10);
+ assert
+ (H15 :
+ pos_Rl (cons_ORlist lf lg) i <
+ (pos_Rl (cons_ORlist lf lg) i + pos_Rl (cons_ORlist lf lg) (S i)) / 2 <
+ pos_Rl (cons_ORlist lf lg) (S i)).
+split.
+apply Rmult_lt_reg_l with 2;
+ [ prove_sup0
+ | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+ rewrite <- Rinv_r_sym;
+ [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption
+ | discrR ] ].
+apply Rmult_lt_reg_l with 2;
+ [ prove_sup0
+ | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+ rewrite <- Rinv_r_sym;
+ [ rewrite Rmult_1_l; rewrite double;
+ rewrite (Rplus_comm (pos_Rl (cons_ORlist lf lg) i));
+ apply Rplus_lt_compat_l; assumption
+ | discrR ] ].
+rewrite (H11 _ H15); reflexivity.
+elim H10; intros; rewrite H14 in H15;
+ elim (Rlt_irrefl _ (Rlt_trans _ _ _ H16 H15)).
+apply H8.
+rewrite RList_P14; rewrite Hyp_cons in H8; simpl in H8; apply H8.
+assert (H11 : a < b).
+apply Rle_lt_trans with (pos_Rl (cons_ORlist lf lg) i).
+rewrite <- H6; rewrite <- (RList_P15 lf lg); try assumption.
+elim (RList_P6 (cons_ORlist lf lg)); intros; apply H11.
+apply RList_P2; assumption.
+apply le_O_n.
+apply lt_trans with (pred (Rlength (cons_ORlist lf lg)));
+ [ assumption
+ | apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro;
+ rewrite <- H13 in H8; elim (lt_n_O _ H8) ].
+rewrite H1; assumption.
+apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)).
+elim H10; intros; apply Rlt_trans with x; assumption.
+rewrite <- H5; rewrite <- (RList_P16 lf lg); try assumption.
+elim (RList_P6 (cons_ORlist lf lg)); intros; apply H11.
+apply RList_P2; assumption.
+apply lt_n_Sm_le; apply lt_n_S; assumption.
+apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H8;
+ elim (lt_n_O _ H8).
+rewrite H0; assumption.
+pose
+ (I :=
+ fun j:nat =>
+ pos_Rl lg j <= pos_Rl (cons_ORlist lf lg) i /\ (j < Rlength lg)%nat);
+ assert (H12 : Nbound I).
+unfold Nbound in |- *; exists (Rlength lg); intros; unfold I in H12; elim H12;
+ intros; apply lt_le_weak; assumption.
+assert (H13 : exists n : nat | I n).
+exists 0%nat; unfold I in |- *; split.
+apply Rle_trans with (pos_Rl (cons_ORlist lf lg) 0).
+right; symmetry in |- *; rewrite H1; rewrite <- H6; apply RList_P15;
+ try assumption; rewrite H1; assumption.
+elim (RList_P6 (cons_ORlist lf lg)); intros; apply H13;
+ [ apply RList_P2; assumption
+ | apply le_O_n
+ | apply lt_trans with (pred (Rlength (cons_ORlist lf lg)));
+ [ assumption
+ | apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro;
+ rewrite <- H15 in H8; elim (lt_n_O _ H8) ] ].
+apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H0;
+ rewrite <- H1 in H11; rewrite <- H0 in H11; elim (Rlt_irrefl _ H11).
+assert (H14 := Nzorn H13 H12); elim H14; clear H14; intros x0 H14;
+ exists (pos_Rl lg0 x0); unfold constant_D_eq, open_interval in |- *;
+ intros; assert (H16 := H4 x0); assert (H17 : (x0 < pred (Rlength lg))%nat).
+elim H14; clear H14; intros; unfold I in H14; elim H14; clear H14; intros;
+ apply lt_S_n; replace (S (pred (Rlength lg))) with (Rlength lg).
+inversion H18.
+2: apply lt_n_S; assumption.
+cut (x0 = pred (Rlength lg)).
+intro; rewrite H19 in H14; rewrite H0 in H14;
+ cut (pos_Rl (cons_ORlist lf lg) i < b).
+intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H14 H21)).
+apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)).
+elim H10; intros; apply Rlt_trans with x; assumption.
+rewrite <- H0;
+ apply Rle_trans with
+ (pos_Rl (cons_ORlist lf lg) (pred (Rlength (cons_ORlist lf lg)))).
+elim (RList_P6 (cons_ORlist lf lg)); intros; apply H21.
+apply RList_P2; assumption.
+apply lt_n_Sm_le; apply lt_n_S; assumption.
+apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H23 in H8;
+ elim (lt_n_O _ H8).
+right; rewrite H0; rewrite <- H5; apply RList_P16; try assumption.
+rewrite H0; assumption.
+rewrite <- H20; reflexivity.
+apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro;
+ rewrite <- H19 in H18; elim (lt_n_O _ H18).
+assert (H18 := H16 H17); unfold constant_D_eq, open_interval in H18;
+ rewrite (H18 x1).
+reflexivity.
+elim H15; clear H15; intros; elim H14; clear H14; intros; unfold I in H14;
+ elim H14; clear H14; intros; split.
+apply Rle_lt_trans with (pos_Rl (cons_ORlist lf lg) i); assumption.
+apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)); try assumption.
+assert (H22 : (S x0 < Rlength lg)%nat).
+replace (Rlength lg) with (S (pred (Rlength lg))).
+apply lt_n_S; assumption.
+symmetry in |- *; apply S_pred with 0%nat; apply neq_O_lt; red in |- *;
+ intro; rewrite <- H22 in H21; elim (lt_n_O _ H21).
+elim (Rle_dec (pos_Rl lg (S x0)) (pos_Rl (cons_ORlist lf lg) i)); intro.
+assert (H23 : (S x0 <= x0)%nat);
+ [ apply H20; unfold I in |- *; split; assumption | elim (le_Sn_n _ H23) ].
+assert (H23 : pos_Rl (cons_ORlist lf lg) i < pos_Rl lg (S x0)).
+auto with real.
+clear b0; apply RList_P17; try assumption;
+ [ apply RList_P2; assumption
+ | elim (RList_P9 lf lg (pos_Rl lg (S x0))); intros; apply H25; right;
+ elim (RList_P3 lg (pos_Rl lg (S x0))); intros;
+ apply H27; exists (S x0); split; [ reflexivity | apply H22 ] ].
Qed.
-Lemma StepFun_P25 : (a,b:R;f,g:R->R;lf,lg:Rlist) (is_subdivision f a b lf) -> (is_subdivision g a b lg) -> (is_subdivision g a b (cons_ORlist lf lg)).
-Intros a b f g lf lg H H0; Case (total_order_Rle a b); Intro; [Apply StepFun_P24 with f; Assumption | Apply StepFun_P5; Apply StepFun_P24 with f; [Auto with real | Apply StepFun_P5; Assumption | Apply StepFun_P5; Assumption]].
+Lemma StepFun_P25 :
+ forall (a b:R) (f g:R -> R) (lf lg:Rlist),
+ is_subdivision f a b lf ->
+ is_subdivision g a b lg -> is_subdivision g a b (cons_ORlist lf lg).
+intros a b f g lf lg H H0; case (Rle_dec a b); intro;
+ [ apply StepFun_P24 with f; assumption
+ | apply StepFun_P5; apply StepFun_P24 with f;
+ [ auto with real
+ | apply StepFun_P5; assumption
+ | apply StepFun_P5; assumption ] ].
Qed.
-Lemma StepFun_P26 : (a,b,l:R;f,g:R->R;l1:Rlist) (is_subdivision f a b l1) -> (is_subdivision g a b l1) -> (is_subdivision [x:R]``(f x)+l*(g x)`` a b l1).
-Intros a b l f g l1; Unfold is_subdivision; Intros; Elim X; Elim X0; Intros; Clear X X0; Unfold adapted_couple in p p0; Decompose [and] p; Decompose [and] p0; Clear p p0; Apply existTT with (FF l1 [x:R]``(f x)+l*(g x)``); Unfold adapted_couple; Repeat Split; Try Assumption.
-Apply StepFun_P20; Apply neq_O_lt; Red; Intro; Rewrite <- H8 in H7; Discriminate.
-Intros; Unfold constant_D_eq open_interval; Unfold constant_D_eq open_interval in H9 H4; Intros; Rewrite (H9 ? H8 ? H10); Rewrite (H4 ? H8 ? H10); Assert H11 : ~l1==nil.
-Red; Intro; Rewrite H11 in H8; Elim (lt_n_O ? H8).
-Assert H12 := (RList_P19 ? H11); Elim H12; Clear H12; Intros r [r0 H12]; Rewrite H12; Unfold FF; Change ``(pos_Rl x0 i)+l*(pos_Rl x i)`` == (pos_Rl (app_Rlist (mid_Rlist (cons r r0) r) [x2:R]``(f x2)+l*(g x2)``) (S i)); Rewrite RList_P12.
-Rewrite RList_P13.
-Rewrite <- H12; Rewrite (H9 ? H8); Try Rewrite (H4 ? H8); Reflexivity Orelse (Elim H10; Clear H10; Intros; Split; [Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Apply Rlt_trans with x1; Assumption | DiscrR]] | Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Rewrite (Rplus_sym (pos_Rl l1 i)); Apply Rlt_compatibility; Apply Rlt_trans with x1; Assumption | DiscrR]]]).
-Rewrite <- H12; Assumption.
-Rewrite RList_P14; Simpl; Rewrite H12 in H8; Simpl in H8; Apply lt_n_S; Apply H8.
+Lemma StepFun_P26 :
+ forall (a b l:R) (f g:R -> R) (l1:Rlist),
+ is_subdivision f a b l1 ->
+ is_subdivision g a b l1 ->
+ is_subdivision (fun x:R => f x + l * g x) a b l1.
+intros a b l f g l1; unfold is_subdivision in |- *; intros; elim X; elim X0;
+ intros; clear X X0; unfold adapted_couple in p, p0;
+ decompose [and] p; decompose [and] p0; clear p p0;
+ apply existT with (FF l1 (fun x:R => f x + l * g x));
+ unfold adapted_couple in |- *; repeat split; try assumption.
+apply StepFun_P20; apply neq_O_lt; red in |- *; intro; rewrite <- H8 in H7;
+ discriminate.
+intros; unfold constant_D_eq, open_interval in |- *;
+ unfold constant_D_eq, open_interval in H9, H4; intros;
+ rewrite (H9 _ H8 _ H10); rewrite (H4 _ H8 _ H10);
+ assert (H11 : l1 <> nil).
+red in |- *; intro; rewrite H11 in H8; elim (lt_n_O _ H8).
+assert (H12 := RList_P19 _ H11); elim H12; clear H12; intros r [r0 H12];
+ rewrite H12; unfold FF in |- *;
+ change
+ (pos_Rl x0 i + l * pos_Rl x i =
+ pos_Rl
+ (app_Rlist (mid_Rlist (cons r r0) r) (fun x2:R => f x2 + l * g x2))
+ (S i)) in |- *; rewrite RList_P12.
+rewrite RList_P13.
+rewrite <- H12; rewrite (H9 _ H8); try rewrite (H4 _ H8);
+ reflexivity ||
+ (elim H10; clear H10; intros; split;
+ [ apply Rmult_lt_reg_l with 2;
+ [ prove_sup0
+ | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2));
+ rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym;
+ [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l;
+ apply Rlt_trans with x1; assumption
+ | discrR ] ]
+ | apply Rmult_lt_reg_l with 2;
+ [ prove_sup0
+ | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2));
+ rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym;
+ [ rewrite Rmult_1_l; rewrite double;
+ rewrite (Rplus_comm (pos_Rl l1 i)); apply Rplus_lt_compat_l;
+ apply Rlt_trans with x1; assumption
+ | discrR ] ] ]).
+rewrite <- H12; assumption.
+rewrite RList_P14; simpl in |- *; rewrite H12 in H8; simpl in H8;
+ apply lt_n_S; apply H8.
Qed.
-Lemma StepFun_P27 : (a,b,l:R;f,g:R->R;lf,lg:Rlist) (is_subdivision f a b lf) -> (is_subdivision g a b lg) -> (is_subdivision [x:R]``(f x)+l*(g x)`` a b (cons_ORlist lf lg)).
-Intros a b l f g lf lg H H0; Apply StepFun_P26; [Apply StepFun_P23 with g; Assumption | Apply StepFun_P25 with f; Assumption].
+Lemma StepFun_P27 :
+ forall (a b l:R) (f g:R -> R) (lf lg:Rlist),
+ is_subdivision f a b lf ->
+ is_subdivision g a b lg ->
+ is_subdivision (fun x:R => f x + l * g x) a b (cons_ORlist lf lg).
+intros a b l f g lf lg H H0; apply StepFun_P26;
+ [ apply StepFun_P23 with g; assumption
+ | apply StepFun_P25 with f; assumption ].
Qed.
(* The set of step functions on [a,b] is a vectorial space *)
-Lemma StepFun_P28 : (a,b,l:R;f,g:(StepFun a b)) (IsStepFun [x:R]``(f x)+l*(g x)`` a b).
-Intros a b l f g; Unfold IsStepFun; Assert H := (pre f); Assert H0 := (pre g); Unfold IsStepFun in H H0; Elim H; Elim H0; Intros; Apply Specif.existT with (cons_ORlist x0 x); Apply StepFun_P27; Assumption.
+Lemma StepFun_P28 :
+ forall (a b l:R) (f g:StepFun a b), IsStepFun (fun x:R => f x + l * g x) a b.
+intros a b l f g; unfold IsStepFun in |- *; assert (H := pre f);
+ assert (H0 := pre g); unfold IsStepFun in H, H0; elim H;
+ elim H0; intros; apply existT with (cons_ORlist x0 x);
+ apply StepFun_P27; assumption.
Qed.
-Lemma StepFun_P29 : (a,b:R;f:(StepFun a b)) (is_subdivision f a b (subdivision f)).
-Intros a b f; Unfold is_subdivision; Apply existTT with (subdivision_val f); Apply StepFun_P1.
+Lemma StepFun_P29 :
+ forall (a b:R) (f:StepFun a b), is_subdivision f a b (subdivision f).
+intros a b f; unfold is_subdivision in |- *;
+ apply existT with (subdivision_val f); apply StepFun_P1.
Qed.
-Lemma StepFun_P30 : (a,b,l:R;f,g:(StepFun a b)) ``(RiemannInt_SF (mkStepFun (StepFun_P28 l f g)))==(RiemannInt_SF f)+l*(RiemannInt_SF g)``.
-Intros a b l f g; Unfold RiemannInt_SF; Case (total_order_Rle a b); (Intro; Replace ``(Int_SF (subdivision_val (mkStepFun (StepFun_P28 l f g))) (subdivision (mkStepFun (StepFun_P28 l f g))))`` with (Int_SF (FF (cons_ORlist (subdivision f) (subdivision g)) [x:R]``(f x)+l*(g x)``) (cons_ORlist (subdivision f) (subdivision g))); [Rewrite StepFun_P19; Replace (Int_SF (FF (cons_ORlist (subdivision f) (subdivision g)) f) (cons_ORlist (subdivision f) (subdivision g))) with (Int_SF (subdivision_val f) (subdivision f)); [Replace (Int_SF (FF (cons_ORlist (subdivision f) (subdivision g)) g) (cons_ORlist (subdivision f) (subdivision g))) with (Int_SF (subdivision_val g) (subdivision g)); [Ring | Apply StepFun_P17 with (fe g) a b; [Apply StepFun_P1 | Apply StepFun_P21; Apply StepFun_P25 with (fe f); Apply StepFun_P29]] | Apply StepFun_P17 with (fe f) a b; [Apply StepFun_P1 | Apply StepFun_P21; Apply StepFun_P23 with (fe g); Apply StepFun_P29]] | Apply StepFun_P17 with [x:R]``(f x)+l*(g x)`` a b; [Apply StepFun_P21; Apply StepFun_P27; Apply StepFun_P29 | Apply (StepFun_P1 (mkStepFun (StepFun_P28 l f g)))]]).
+Lemma StepFun_P30 :
+ forall (a b l:R) (f g:StepFun a b),
+ RiemannInt_SF (mkStepFun (StepFun_P28 l f g)) =
+ RiemannInt_SF f + l * RiemannInt_SF g.
+intros a b l f g; unfold RiemannInt_SF in |- *; case (Rle_dec a b);
+ (intro;
+ replace
+ (Int_SF (subdivision_val (mkStepFun (StepFun_P28 l f g)))
+ (subdivision (mkStepFun (StepFun_P28 l f g)))) with
+ (Int_SF
+ (FF (cons_ORlist (subdivision f) (subdivision g))
+ (fun x:R => f x + l * g x))
+ (cons_ORlist (subdivision f) (subdivision g)));
+ [ rewrite StepFun_P19;
+ replace
+ (Int_SF (FF (cons_ORlist (subdivision f) (subdivision g)) f)
+ (cons_ORlist (subdivision f) (subdivision g))) with
+ (Int_SF (subdivision_val f) (subdivision f));
+ [ replace
+ (Int_SF (FF (cons_ORlist (subdivision f) (subdivision g)) g)
+ (cons_ORlist (subdivision f) (subdivision g))) with
+ (Int_SF (subdivision_val g) (subdivision g));
+ [ ring
+ | apply StepFun_P17 with (fe g) a b;
+ [ apply StepFun_P1
+ | apply StepFun_P21; apply StepFun_P25 with (fe f);
+ apply StepFun_P29 ] ]
+ | apply StepFun_P17 with (fe f) a b;
+ [ apply StepFun_P1
+ | apply StepFun_P21; apply StepFun_P23 with (fe g);
+ apply StepFun_P29 ] ]
+ | apply StepFun_P17 with (fun x:R => f x + l * g x) a b;
+ [ apply StepFun_P21; apply StepFun_P27; apply StepFun_P29
+ | apply (StepFun_P1 (mkStepFun (StepFun_P28 l f g))) ] ]).
Qed.
-Lemma StepFun_P31 : (a,b:R;f:R->R;l,lf:Rlist) (adapted_couple f a b l lf) -> (adapted_couple [x:R](Rabsolu (f x)) a b l (app_Rlist lf Rabsolu)).
-Unfold adapted_couple; Intros; Decompose [and] H; Clear H; Repeat Split; Try Assumption.
-Symmetry; Rewrite H3; Rewrite RList_P18; Reflexivity.
-Intros; Unfold constant_D_eq open_interval; Unfold constant_D_eq open_interval in H5; Intros; Rewrite (H5 ? H ? H4); Rewrite RList_P12; [Reflexivity | Rewrite H3 in H; Simpl in H; Apply H].
+Lemma StepFun_P31 :
+ forall (a b:R) (f:R -> R) (l lf:Rlist),
+ adapted_couple f a b l lf ->
+ adapted_couple (fun x:R => Rabs (f x)) a b l (app_Rlist lf Rabs).
+unfold adapted_couple in |- *; intros; decompose [and] H; clear H;
+ repeat split; try assumption.
+symmetry in |- *; rewrite H3; rewrite RList_P18; reflexivity.
+intros; unfold constant_D_eq, open_interval in |- *;
+ unfold constant_D_eq, open_interval in H5; intros;
+ rewrite (H5 _ H _ H4); rewrite RList_P12;
+ [ reflexivity | rewrite H3 in H; simpl in H; apply H ].
Qed.
-Lemma StepFun_P32 : (a,b:R;f:(StepFun a b)) (IsStepFun [x:R](Rabsolu (f x)) a b).
-Intros a b f; Unfold IsStepFun; Apply Specif.existT with (subdivision f); Unfold is_subdivision; Apply existTT with (app_Rlist (subdivision_val f) Rabsolu); Apply StepFun_P31; Apply StepFun_P1.
+Lemma StepFun_P32 :
+ forall (a b:R) (f:StepFun a b), IsStepFun (fun x:R => Rabs (f x)) a b.
+intros a b f; unfold IsStepFun in |- *; apply existT with (subdivision f);
+ unfold is_subdivision in |- *;
+ apply existT with (app_Rlist (subdivision_val f) Rabs);
+ apply StepFun_P31; apply StepFun_P1.
Qed.
-Lemma StepFun_P33 : (l2,l1:Rlist) (ordered_Rlist l1) -> ``(Rabsolu (Int_SF l2 l1))<=(Int_SF (app_Rlist l2 Rabsolu) l1)``.
-Induction l2; Intros.
-Simpl; Rewrite Rabsolu_R0; Right; Reflexivity.
-Simpl; Induction l1.
-Rewrite Rabsolu_R0; Right; Reflexivity.
-Induction l1.
-Rewrite Rabsolu_R0; Right; Reflexivity.
-Apply Rle_trans with ``(Rabsolu (r*(r2-r1)))+(Rabsolu (Int_SF r0 (cons r2 l1)))``.
-Apply Rabsolu_triang.
-Rewrite Rabsolu_mult; Rewrite (Rabsolu_right ``r2-r1``); [Apply Rle_compatibility; Apply H; Apply RList_P4 with r1; Assumption | Apply Rge_minus; Apply Rle_sym1; Apply (H0 O); Simpl; Apply lt_O_Sn].
+Lemma StepFun_P33 :
+ forall l2 l1:Rlist,
+ ordered_Rlist l1 -> Rabs (Int_SF l2 l1) <= Int_SF (app_Rlist l2 Rabs) l1.
+simple induction l2; intros.
+simpl in |- *; rewrite Rabs_R0; right; reflexivity.
+simpl in |- *; induction l1 as [| r1 l1 Hrecl1].
+rewrite Rabs_R0; right; reflexivity.
+induction l1 as [| r2 l1 Hrecl0].
+rewrite Rabs_R0; right; reflexivity.
+apply Rle_trans with (Rabs (r * (r2 - r1)) + Rabs (Int_SF r0 (cons r2 l1))).
+apply Rabs_triang.
+rewrite Rabs_mult; rewrite (Rabs_right (r2 - r1));
+ [ apply Rplus_le_compat_l; apply H; apply RList_P4 with r1; assumption
+ | apply Rge_minus; apply Rle_ge; apply (H0 0%nat); simpl in |- *;
+ apply lt_O_Sn ].
Qed.
-Lemma StepFun_P34 : (a,b:R;f:(StepFun a b)) ``a<=b`` -> ``(Rabsolu (RiemannInt_SF f))<=(RiemannInt_SF (mkStepFun (StepFun_P32 f)))``.
-Intros; Unfold RiemannInt_SF; Case (total_order_Rle a b); Intro.
-Replace (Int_SF (subdivision_val (mkStepFun (StepFun_P32 f))) (subdivision (mkStepFun (StepFun_P32 f)))) with (Int_SF (app_Rlist (subdivision_val f) Rabsolu) (subdivision f)).
-Apply StepFun_P33; Assert H0 := (StepFun_P29 f); Unfold is_subdivision in H0; Elim H0; Intros; Unfold adapted_couple in p; Decompose [and] p; Assumption.
-Apply StepFun_P17 with [x:R](Rabsolu (f x)) a b; [Apply StepFun_P31; Apply StepFun_P1 | Apply (StepFun_P1 (mkStepFun (StepFun_P32 f)))].
-Elim n; Assumption.
+Lemma StepFun_P34 :
+ forall (a b:R) (f:StepFun a b),
+ a <= b ->
+ Rabs (RiemannInt_SF f) <= RiemannInt_SF (mkStepFun (StepFun_P32 f)).
+intros; unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro.
+replace
+ (Int_SF (subdivision_val (mkStepFun (StepFun_P32 f)))
+ (subdivision (mkStepFun (StepFun_P32 f)))) with
+ (Int_SF (app_Rlist (subdivision_val f) Rabs) (subdivision f)).
+apply StepFun_P33; assert (H0 := StepFun_P29 f); unfold is_subdivision in H0;
+ elim H0; intros; unfold adapted_couple in p; decompose [and] p;
+ assumption.
+apply StepFun_P17 with (fun x:R => Rabs (f x)) a b;
+ [ apply StepFun_P31; apply StepFun_P1
+ | apply (StepFun_P1 (mkStepFun (StepFun_P32 f))) ].
+elim n; assumption.
Qed.
-Lemma StepFun_P35 : (l:Rlist;a,b:R;f,g:R->R) (ordered_Rlist l) -> (pos_Rl l O)==a -> (pos_Rl l (pred (Rlength l)))==b -> ((x:R)``a<x<b``->``(f x)<=(g x)``) -> ``(Int_SF (FF l f) l)<=(Int_SF (FF l g) l)``.
-Induction l; Intros.
-Right; Reflexivity.
-Simpl; Induction r0.
-Right; Reflexivity.
-Simpl; Apply Rplus_le.
-Case (Req_EM r r0); Intro.
-Rewrite H4; Right; Ring.
-Do 2 Rewrite <- (Rmult_sym ``r0-r``); Apply Rle_monotony.
-Apply Rle_sym2; Apply Rge_minus; Apply Rle_sym1; Apply (H0 O); Simpl; Apply lt_O_Sn.
-Apply H3; Split.
-Apply Rlt_monotony_contra with ``2``.
-Sup0.
-Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
-Assert H5 : r==a.
-Apply H1.
-Rewrite H5; Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility.
-Assert H6 := (H0 O (lt_O_Sn ?)).
-Simpl in H6.
-Elim H6; Intro.
-Rewrite H5 in H7; Apply H7.
-Elim H4; Assumption.
-DiscrR.
-Apply Rlt_monotony_contra with ``2``.
-Sup0.
-Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1l; Rewrite double; Assert H5 : ``r0<=b``.
-Replace b with (pos_Rl (cons r (cons r0 r1)) (pred (Rlength (cons r (cons r0 r1))))).
-Replace r0 with (pos_Rl (cons r (cons r0 r1)) (S O)).
-Elim (RList_P6 (cons r (cons r0 r1))); Intros; Apply H5.
-Assumption.
-Simpl; Apply le_n_S.
-Apply le_O_n.
-Simpl; Apply lt_n_Sn.
-Reflexivity.
-Apply Rle_lt_trans with ``r+b``.
-Apply Rle_compatibility; Assumption.
-Rewrite (Rplus_sym r); Apply Rlt_compatibility.
-Apply Rlt_le_trans with r0.
-Assert H6 := (H0 O (lt_O_Sn ?)).
-Simpl in H6.
-Elim H6; Intro.
-Apply H7.
-Elim H4; Assumption.
-Assumption.
-DiscrR.
-Simpl in H; Apply H with r0 b.
-Apply RList_P4 with r; Assumption.
-Reflexivity.
-Rewrite <- H2; Reflexivity.
-Intros; Apply H3; Elim H4; Intros; Split; Try Assumption.
-Apply Rle_lt_trans with r0; Try Assumption.
-Rewrite <- H1.
-Simpl; Apply (H0 O); Simpl; Apply lt_O_Sn.
+Lemma StepFun_P35 :
+ forall (l:Rlist) (a b:R) (f g:R -> R),
+ ordered_Rlist l ->
+ pos_Rl l 0 = a ->
+ pos_Rl l (pred (Rlength l)) = b ->
+ (forall x:R, a < x < b -> f x <= g x) ->
+ Int_SF (FF l f) l <= Int_SF (FF l g) l.
+simple induction l; intros.
+right; reflexivity.
+simpl in |- *; induction r0 as [| r0 r1 Hrecr0].
+right; reflexivity.
+simpl in |- *; apply Rplus_le_compat.
+case (Req_dec r r0); intro.
+rewrite H4; right; ring.
+do 2 rewrite <- (Rmult_comm (r0 - r)); apply Rmult_le_compat_l.
+apply Rge_le; apply Rge_minus; apply Rle_ge; apply (H0 0%nat); simpl in |- *;
+ apply lt_O_Sn.
+apply H3; split.
+apply Rmult_lt_reg_l with 2.
+prove_sup0.
+unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+ rewrite <- Rinv_r_sym.
+assert (H5 : r = a).
+apply H1.
+rewrite H5; rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l.
+assert (H6 := H0 0%nat (lt_O_Sn _)).
+simpl in H6.
+elim H6; intro.
+rewrite H5 in H7; apply H7.
+elim H4; assumption.
+discrR.
+apply Rmult_lt_reg_l with 2.
+prove_sup0.
+unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+ rewrite <- Rinv_r_sym.
+rewrite Rmult_1_l; rewrite double; assert (H5 : r0 <= b).
+replace b with
+ (pos_Rl (cons r (cons r0 r1)) (pred (Rlength (cons r (cons r0 r1))))).
+replace r0 with (pos_Rl (cons r (cons r0 r1)) 1).
+elim (RList_P6 (cons r (cons r0 r1))); intros; apply H5.
+assumption.
+simpl in |- *; apply le_n_S.
+apply le_O_n.
+simpl in |- *; apply lt_n_Sn.
+reflexivity.
+apply Rle_lt_trans with (r + b).
+apply Rplus_le_compat_l; assumption.
+rewrite (Rplus_comm r); apply Rplus_lt_compat_l.
+apply Rlt_le_trans with r0.
+assert (H6 := H0 0%nat (lt_O_Sn _)).
+simpl in H6.
+elim H6; intro.
+apply H7.
+elim H4; assumption.
+assumption.
+discrR.
+simpl in H; apply H with r0 b.
+apply RList_P4 with r; assumption.
+reflexivity.
+rewrite <- H2; reflexivity.
+intros; apply H3; elim H4; intros; split; try assumption.
+apply Rle_lt_trans with r0; try assumption.
+rewrite <- H1.
+simpl in |- *; apply (H0 0%nat); simpl in |- *; apply lt_O_Sn.
Qed.
-Lemma StepFun_P36 : (a,b:R;f,g:(StepFun a b);l:Rlist) ``a<=b`` -> (is_subdivision f a b l) -> (is_subdivision g a b l) -> ((x:R)``a<x<b``->``(f x)<=(g x)``) -> ``(RiemannInt_SF f) <= (RiemannInt_SF g)``.
-Intros; Unfold RiemannInt_SF; Case (total_order_Rle a b); Intro.
-Replace (Int_SF (subdivision_val f) (subdivision f)) with (Int_SF (FF l f) l).
-Replace (Int_SF (subdivision_val g) (subdivision g)) with (Int_SF (FF l g) l).
-Unfold is_subdivision in X; Elim X; Clear X; Intros; Unfold adapted_couple in p; Decompose [and] p; Clear p; Assert H5 : (Rmin a b)==a; [Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption] | Assert H7 : (Rmax a b)==b; [Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption] | Rewrite H5 in H3; Rewrite H7 in H2; EApply StepFun_P35 with a b; Assumption]].
-Apply StepFun_P17 with (fe g) a b; [Apply StepFun_P21; Assumption | Apply StepFun_P1].
-Apply StepFun_P17 with (fe f) a b; [Apply StepFun_P21; Assumption | Apply StepFun_P1].
-Elim n; Assumption.
+Lemma StepFun_P36 :
+ forall (a b:R) (f g:StepFun a b) (l:Rlist),
+ a <= b ->
+ is_subdivision f a b l ->
+ is_subdivision g a b l ->
+ (forall x:R, a < x < b -> f x <= g x) ->
+ RiemannInt_SF f <= RiemannInt_SF g.
+intros; unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro.
+replace (Int_SF (subdivision_val f) (subdivision f)) with (Int_SF (FF l f) l).
+replace (Int_SF (subdivision_val g) (subdivision g)) with (Int_SF (FF l g) l).
+unfold is_subdivision in X; elim X; clear X; intros;
+ unfold adapted_couple in p; decompose [and] p; clear p;
+ assert (H5 : Rmin a b = a);
+ [ unfold Rmin in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n; assumption ]
+ | assert (H7 : Rmax a b = b);
+ [ unfold Rmax in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n; assumption ]
+ | rewrite H5 in H3; rewrite H7 in H2; eapply StepFun_P35 with a b;
+ assumption ] ].
+apply StepFun_P17 with (fe g) a b;
+ [ apply StepFun_P21; assumption | apply StepFun_P1 ].
+apply StepFun_P17 with (fe f) a b;
+ [ apply StepFun_P21; assumption | apply StepFun_P1 ].
+elim n; assumption.
Qed.
-Lemma StepFun_P37 : (a,b:R;f,g:(StepFun a b)) ``a<=b`` -> ((x:R)``a<x<b``->``(f x)<=(g x)``) -> ``(RiemannInt_SF f) <= (RiemannInt_SF g)``.
-Intros; EApply StepFun_P36; Try Assumption.
-EApply StepFun_P25; Apply StepFun_P29.
-EApply StepFun_P23; Apply StepFun_P29.
+Lemma StepFun_P37 :
+ forall (a b:R) (f g:StepFun a b),
+ a <= b ->
+ (forall x:R, a < x < b -> f x <= g x) ->
+ RiemannInt_SF f <= RiemannInt_SF g.
+intros; eapply StepFun_P36; try assumption.
+eapply StepFun_P25; apply StepFun_P29.
+eapply StepFun_P23; apply StepFun_P29.
Qed.
-Lemma StepFun_P38 : (l:Rlist;a,b:R;f:R->R) (ordered_Rlist l) -> (pos_Rl l O)==a -> (pos_Rl l (pred (Rlength l)))==b -> (sigTT ? [g:(StepFun a b)](g b)==(f b)/\(i:nat)(lt i (pred (Rlength l)))->(constant_D_eq g (co_interval (pos_Rl l i) (pos_Rl l (S i))) (f (pos_Rl l i)))).
-Intros l a b f; Generalize a; Clear a; NewInduction l.
-Intros a H H0 H1; Simpl in H0; Simpl in H1; Exists (mkStepFun (StepFun_P4 a b (f b))); Split.
-Reflexivity.
-Intros; Elim (lt_n_O ? H2).
-Intros; NewDestruct l as [|r1 l].
-Simpl in H1; Simpl in H0; Exists (mkStepFun (StepFun_P4 a b (f b))); Split.
-Reflexivity.
-Intros i H2; Elim (lt_n_O ? H2).
-Intros; Assert H2 : (ordered_Rlist (cons r1 l)).
-Apply RList_P4 with r; Assumption.
-Assert H3 : (pos_Rl (cons r1 l) O)==r1.
-Reflexivity.
-Assert H4 : (pos_Rl (cons r1 l) (pred (Rlength (cons r1 l))))==b.
-Rewrite <- H1; Reflexivity.
-Elim (IHl r1 H2 H3 H4); Intros g [H5 H6].
-Pose g' := [x:R]Cases (total_order_Rle r1 x) of
- | (leftT _) => (g x)
- | (rightT _) => (f a) end.
-Assert H7 : ``r1<=b``.
-Rewrite <- H4; Apply RList_P7; [Assumption | Left; Reflexivity].
-Assert H8 : (IsStepFun g' a b).
-Unfold IsStepFun; Assert H8 := (pre g); Unfold IsStepFun in H8; Elim H8; Intros lg H9; Unfold is_subdivision in H9; Elim H9; Clear H9; Intros lg2 H9; Split with (cons a lg); Unfold is_subdivision; Split with (cons (f a) lg2); Unfold adapted_couple in H9; Decompose [and] H9; Clear H9; Unfold adapted_couple; Repeat Split.
-Unfold ordered_Rlist; Intros; Simpl in H9; Induction i.
-Simpl; Rewrite H12; Replace (Rmin r1 b) with r1.
-Simpl in H0; Rewrite <- H0; Apply (H O); Simpl; Apply lt_O_Sn.
-Unfold Rmin; Case (total_order_Rle r1 b); Intro; [Reflexivity | Elim n; Assumption].
-Apply (H10 i); Apply lt_S_n.
-Replace (S (pred (Rlength lg))) with (Rlength lg).
-Apply H9.
-Apply S_pred with O; Apply neq_O_lt; Intro; Rewrite <- H14 in H9; Elim (lt_n_O ? H9).
-Simpl; Assert H14 : ``a<=b``.
-Rewrite <- H1; Simpl in H0; Rewrite <- H0; Apply RList_P7; [Assumption | Left; Reflexivity].
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Assert H14 : ``a<=b``.
-Rewrite <- H1; Simpl in H0; Rewrite <- H0; Apply RList_P7; [Assumption | Left; Reflexivity].
-Replace (Rmax a b) with (Rmax r1 b).
-Rewrite <- H11; Induction lg.
-Simpl in H13; Discriminate.
-Reflexivity.
-Unfold Rmax; Case (total_order_Rle a b); Case (total_order_Rle r1 b); Intros; Reflexivity Orelse Elim n; Assumption.
-Simpl; Rewrite H13; Reflexivity.
-Intros; Simpl in H9; Induction i.
-Unfold constant_D_eq open_interval; Simpl; Intros; Assert H16 : (Rmin r1 b)==r1.
-Unfold Rmin; Case (total_order_Rle r1 b); Intro; [Reflexivity | Elim n; Assumption].
-Rewrite H16 in H12; Rewrite H12 in H14; Elim H14; Clear H14; Intros _ H14; Unfold g'; Case (total_order_Rle r1 x); Intro r3.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r3 H14)).
-Reflexivity.
-Change (constant_D_eq g' (open_interval (pos_Rl lg i) (pos_Rl lg (S i))) (pos_Rl lg2 i)); Clear Hreci; Assert H16 := (H15 i); Assert H17 : (lt i (pred (Rlength lg))).
-Apply lt_S_n.
-Replace (S (pred (Rlength lg))) with (Rlength lg).
-Assumption.
-Apply S_pred with O; Apply neq_O_lt; Red; Intro; Rewrite <- H14 in H9; Elim (lt_n_O ? H9).
-Assert H18 := (H16 H17); Unfold constant_D_eq open_interval in H18; Unfold constant_D_eq open_interval; Intros; Assert H19 := (H18 ? H14); Rewrite <- H19; Unfold g'; Case (total_order_Rle r1 x); Intro.
-Reflexivity.
-Elim n; Replace r1 with (Rmin r1 b).
-Rewrite <- H12; Elim H14; Clear H14; Intros H14 _; Left; Apply Rle_lt_trans with (pos_Rl lg i); Try Assumption.
-Apply RList_P5.
-Assumption.
-Elim (RList_P3 lg (pos_Rl lg i)); Intros; Apply H21; Exists i; Split.
-Reflexivity.
-Apply lt_trans with (pred (Rlength lg)); Try Assumption.
-Apply lt_pred_n_n; Apply neq_O_lt; Red; Intro; Rewrite <- H22 in H17; Elim (lt_n_O ? H17).
-Unfold Rmin; Case (total_order_Rle r1 b); Intro; [Reflexivity | Elim n0; Assumption].
-Exists (mkStepFun H8); Split.
-Simpl; Unfold g'; Case (total_order_Rle r1 b); Intro.
-Assumption.
-Elim n; Assumption.
-Intros; Simpl in H9; Induction i.
-Unfold constant_D_eq co_interval; Simpl; Intros; Simpl in H0; Rewrite H0; Elim H10; Clear H10; Intros; Unfold g'; Case (total_order_Rle r1 x); Intro r3.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r3 H11)).
-Reflexivity.
-Clear Hreci; Change (constant_D_eq (mkStepFun H8) (co_interval (pos_Rl (cons r1 l) i) (pos_Rl (cons r1 l) (S i))) (f (pos_Rl (cons r1 l) i))); Assert H10 := (H6 i); Assert H11 : (lt i (pred (Rlength (cons r1 l)))).
-Simpl; Apply lt_S_n; Assumption.
-Assert H12 := (H10 H11); Unfold constant_D_eq co_interval in H12; Unfold constant_D_eq co_interval; Intros; Rewrite <- (H12 ? H13); Simpl; Unfold g'; Case (total_order_Rle r1 x); Intro.
-Reflexivity.
-Elim n; Elim H13; Clear H13; Intros; Apply Rle_trans with (pos_Rl (cons r1 l) i); Try Assumption; Change ``(pos_Rl (cons r1 l) O)<=(pos_Rl (cons r1 l) i)``; Elim (RList_P6 (cons r1 l)); Intros; Apply H15; [Assumption | Apply le_O_n | Simpl; Apply lt_trans with (Rlength l); [Apply lt_S_n; Assumption | Apply lt_n_Sn]].
+Lemma StepFun_P38 :
+ forall (l:Rlist) (a b:R) (f:R -> R),
+ ordered_Rlist l ->
+ pos_Rl l 0 = a ->
+ pos_Rl l (pred (Rlength l)) = b ->
+ sigT
+ (fun g:StepFun a b =>
+ g b = f b /\
+ (forall i:nat,
+ (i < pred (Rlength l))%nat ->
+ constant_D_eq g (co_interval (pos_Rl l i) (pos_Rl l (S i)))
+ (f (pos_Rl l i)))).
+intros l a b f; generalize a; clear a; induction l.
+intros a H H0 H1; simpl in H0; simpl in H1;
+ exists (mkStepFun (StepFun_P4 a b (f b))); split.
+reflexivity.
+intros; elim (lt_n_O _ H2).
+intros; destruct l as [| r1 l].
+simpl in H1; simpl in H0; exists (mkStepFun (StepFun_P4 a b (f b))); split.
+reflexivity.
+intros i H2; elim (lt_n_O _ H2).
+intros; assert (H2 : ordered_Rlist (cons r1 l)).
+apply RList_P4 with r; assumption.
+assert (H3 : pos_Rl (cons r1 l) 0 = r1).
+reflexivity.
+assert (H4 : pos_Rl (cons r1 l) (pred (Rlength (cons r1 l))) = b).
+rewrite <- H1; reflexivity.
+elim (IHl r1 H2 H3 H4); intros g [H5 H6].
+pose
+ (g' :=
+ fun x:R => match Rle_dec r1 x with
+ | left _ => g x
+ | right _ => f a
+ end).
+assert (H7 : r1 <= b).
+rewrite <- H4; apply RList_P7; [ assumption | left; reflexivity ].
+assert (H8 : IsStepFun g' a b).
+unfold IsStepFun in |- *; assert (H8 := pre g); unfold IsStepFun in H8;
+ elim H8; intros lg H9; unfold is_subdivision in H9;
+ elim H9; clear H9; intros lg2 H9; split with (cons a lg);
+ unfold is_subdivision in |- *; split with (cons (f a) lg2);
+ unfold adapted_couple in H9; decompose [and] H9; clear H9;
+ unfold adapted_couple in |- *; repeat split.
+unfold ordered_Rlist in |- *; intros; simpl in H9;
+ induction i as [| i Hreci].
+simpl in |- *; rewrite H12; replace (Rmin r1 b) with r1.
+simpl in H0; rewrite <- H0; apply (H 0%nat); simpl in |- *; apply lt_O_Sn.
+unfold Rmin in |- *; case (Rle_dec r1 b); intro;
+ [ reflexivity | elim n; assumption ].
+apply (H10 i); apply lt_S_n.
+replace (S (pred (Rlength lg))) with (Rlength lg).
+apply H9.
+apply S_pred with 0%nat; apply neq_O_lt; intro; rewrite <- H14 in H9;
+ elim (lt_n_O _ H9).
+simpl in |- *; assert (H14 : a <= b).
+rewrite <- H1; simpl in H0; rewrite <- H0; apply RList_P7;
+ [ assumption | left; reflexivity ].
+unfold Rmin in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n; assumption ].
+assert (H14 : a <= b).
+rewrite <- H1; simpl in H0; rewrite <- H0; apply RList_P7;
+ [ assumption | left; reflexivity ].
+replace (Rmax a b) with (Rmax r1 b).
+rewrite <- H11; induction lg as [| r0 lg Hreclg].
+simpl in H13; discriminate.
+reflexivity.
+unfold Rmax in |- *; case (Rle_dec a b); case (Rle_dec r1 b); intros;
+ reflexivity || elim n; assumption.
+simpl in |- *; rewrite H13; reflexivity.
+intros; simpl in H9; induction i as [| i Hreci].
+unfold constant_D_eq, open_interval in |- *; simpl in |- *; intros;
+ assert (H16 : Rmin r1 b = r1).
+unfold Rmin in |- *; case (Rle_dec r1 b); intro;
+ [ reflexivity | elim n; assumption ].
+rewrite H16 in H12; rewrite H12 in H14; elim H14; clear H14; intros _ H14;
+ unfold g' in |- *; case (Rle_dec r1 x); intro r3.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r3 H14)).
+reflexivity.
+change
+ (constant_D_eq g' (open_interval (pos_Rl lg i) (pos_Rl lg (S i)))
+ (pos_Rl lg2 i)) in |- *; clear Hreci; assert (H16 := H15 i);
+ assert (H17 : (i < pred (Rlength lg))%nat).
+apply lt_S_n.
+replace (S (pred (Rlength lg))) with (Rlength lg).
+assumption.
+apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro;
+ rewrite <- H14 in H9; elim (lt_n_O _ H9).
+assert (H18 := H16 H17); unfold constant_D_eq, open_interval in H18;
+ unfold constant_D_eq, open_interval in |- *; intros;
+ assert (H19 := H18 _ H14); rewrite <- H19; unfold g' in |- *;
+ case (Rle_dec r1 x); intro.
+reflexivity.
+elim n; replace r1 with (Rmin r1 b).
+rewrite <- H12; elim H14; clear H14; intros H14 _; left;
+ apply Rle_lt_trans with (pos_Rl lg i); try assumption.
+apply RList_P5.
+assumption.
+elim (RList_P3 lg (pos_Rl lg i)); intros; apply H21; exists i; split.
+reflexivity.
+apply lt_trans with (pred (Rlength lg)); try assumption.
+apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H22 in H17;
+ elim (lt_n_O _ H17).
+unfold Rmin in |- *; case (Rle_dec r1 b); intro;
+ [ reflexivity | elim n0; assumption ].
+exists (mkStepFun H8); split.
+simpl in |- *; unfold g' in |- *; case (Rle_dec r1 b); intro.
+assumption.
+elim n; assumption.
+intros; simpl in H9; induction i as [| i Hreci].
+unfold constant_D_eq, co_interval in |- *; simpl in |- *; intros; simpl in H0;
+ rewrite H0; elim H10; clear H10; intros; unfold g' in |- *;
+ case (Rle_dec r1 x); intro r3.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r3 H11)).
+reflexivity.
+clear Hreci;
+ change
+ (constant_D_eq (mkStepFun H8)
+ (co_interval (pos_Rl (cons r1 l) i) (pos_Rl (cons r1 l) (S i)))
+ (f (pos_Rl (cons r1 l) i))) in |- *; assert (H10 := H6 i);
+ assert (H11 : (i < pred (Rlength (cons r1 l)))%nat).
+simpl in |- *; apply lt_S_n; assumption.
+assert (H12 := H10 H11); unfold constant_D_eq, co_interval in H12;
+ unfold constant_D_eq, co_interval in |- *; intros;
+ rewrite <- (H12 _ H13); simpl in |- *; unfold g' in |- *;
+ case (Rle_dec r1 x); intro.
+reflexivity.
+elim n; elim H13; clear H13; intros;
+ apply Rle_trans with (pos_Rl (cons r1 l) i); try assumption;
+ change (pos_Rl (cons r1 l) 0 <= pos_Rl (cons r1 l) i) in |- *;
+ elim (RList_P6 (cons r1 l)); intros; apply H15;
+ [ assumption
+ | apply le_O_n
+ | simpl in |- *; apply lt_trans with (Rlength l);
+ [ apply lt_S_n; assumption | apply lt_n_Sn ] ].
Qed.
-Lemma StepFun_P39 : (a,b:R;f:(StepFun a b)) (RiemannInt_SF f)==(Ropp (RiemannInt_SF (mkStepFun (StepFun_P6 (pre f))))).
-Intros; Unfold RiemannInt_SF; Case (total_order_Rle a b); Case (total_order_Rle b a); Intros.
-Assert H : (adapted_couple f a b (subdivision f) (subdivision_val f)); [Apply StepFun_P1 | Assert H0 : (adapted_couple (mkStepFun (StepFun_P6 (pre f))) b a (subdivision (mkStepFun (StepFun_P6 (pre f)))) (subdivision_val (mkStepFun (StepFun_P6 (pre f))))); [Apply StepFun_P1 | Assert H1 : a==b; [Apply Rle_antisym; Assumption | Rewrite (StepFun_P8 H H1); Assert H2 : b==a; [Symmetry; Apply H1 | Rewrite (StepFun_P8 H0 H2); Ring]]]].
-Rewrite Ropp_Ropp; EApply StepFun_P17; [Apply StepFun_P1 | Apply StepFun_P2; Assert H := (StepFun_P6 (pre f)); Unfold IsStepFun in H; Elim H; Intros; Unfold is_subdivision; Elim p; Intros; Apply p0].
-Apply eq_Ropp; EApply StepFun_P17; [Apply StepFun_P1 | Apply StepFun_P2; Assert H := (StepFun_P6 (pre f)); Unfold IsStepFun in H; Elim H; Intros; Unfold is_subdivision; Elim p; Intros; Apply p0].
-Assert H : ``a<b``; [Auto with real | Assert H0 : ``b<a``; [Auto with real | Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H H0))]].
+Lemma StepFun_P39 :
+ forall (a b:R) (f:StepFun a b),
+ RiemannInt_SF f = - RiemannInt_SF (mkStepFun (StepFun_P6 (pre f))).
+intros; unfold RiemannInt_SF in |- *; case (Rle_dec a b); case (Rle_dec b a);
+ intros.
+assert (H : adapted_couple f a b (subdivision f) (subdivision_val f));
+ [ apply StepFun_P1
+ | assert
+ (H0 :
+ adapted_couple (mkStepFun (StepFun_P6 (pre f))) b a
+ (subdivision (mkStepFun (StepFun_P6 (pre f))))
+ (subdivision_val (mkStepFun (StepFun_P6 (pre f)))));
+ [ apply StepFun_P1
+ | assert (H1 : a = b);
+ [ apply Rle_antisym; assumption
+ | rewrite (StepFun_P8 H H1); assert (H2 : b = a);
+ [ symmetry in |- *; apply H1 | rewrite (StepFun_P8 H0 H2); ring ] ] ] ].
+rewrite Ropp_involutive; eapply StepFun_P17;
+ [ apply StepFun_P1
+ | apply StepFun_P2; assert (H := StepFun_P6 (pre f)); unfold IsStepFun in H;
+ elim H; intros; unfold is_subdivision in |- *;
+ elim p; intros; apply p0 ].
+apply Ropp_eq_compat; eapply StepFun_P17;
+ [ apply StepFun_P1
+ | apply StepFun_P2; assert (H := StepFun_P6 (pre f)); unfold IsStepFun in H;
+ elim H; intros; unfold is_subdivision in |- *;
+ elim p; intros; apply p0 ].
+assert (H : a < b);
+ [ auto with real
+ | assert (H0 : b < a);
+ [ auto with real | elim (Rlt_irrefl _ (Rlt_trans _ _ _ H H0)) ] ].
Qed.
-Lemma StepFun_P40 : (f:R->R;a,b,c:R;l1,l2,lf1,lf2:Rlist) ``a<b`` -> ``b<c`` -> (adapted_couple f a b l1 lf1) -> (adapted_couple f b c l2 lf2) -> (adapted_couple f a c (cons_Rlist l1 l2) (FF (cons_Rlist l1 l2) f)).
-Intros f a b c l1 l2 lf1 lf2 H H0 H1 H2; Unfold adapted_couple in H1 H2; Unfold adapted_couple; Decompose [and] H1; Decompose [and] H2; Clear H1 H2; Repeat Split.
-Apply RList_P25; Try Assumption.
-Rewrite H10; Rewrite H4; Unfold Rmin Rmax; Case (total_order_Rle a b); Case (total_order_Rle b c); Intros; (Right; Reflexivity) Orelse (Elim n; Left; Assumption).
-Rewrite RList_P22.
-Rewrite H5; Unfold Rmin Rmax; Case (total_order_Rle a b); Case (total_order_Rle a c); Intros; [Reflexivity | Elim n; Apply Rle_trans with b; Left; Assumption | Elim n; Left; Assumption | Elim n0; Left; Assumption].
-Red; Intro; Rewrite H1 in H6; Discriminate.
-Rewrite RList_P24.
-Rewrite H9; Unfold Rmin Rmax; Case (total_order_Rle b c); Case (total_order_Rle a c); Intros; [Reflexivity | Elim n; Apply Rle_trans with b; Left; Assumption | Elim n; Left; Assumption | Elim n0; Left; Assumption].
-Red; Intro; Rewrite H1 in H11; Discriminate.
-Apply StepFun_P20.
-Rewrite RList_P23; Apply neq_O_lt; Red; Intro.
-Assert H2 : (plus (Rlength l1) (Rlength l2))=O.
-Symmetry; Apply H1.
-Elim (plus_is_O ? ? H2); Intros; Rewrite H12 in H6; Discriminate.
-Unfold constant_D_eq open_interval; Intros; Elim (le_or_lt (S (S i)) (Rlength l1)); Intro.
-Assert H14 : (pos_Rl (cons_Rlist l1 l2) i) == (pos_Rl l1 i).
-Apply RList_P26; Apply lt_S_n; Apply le_lt_n_Sm; Apply le_S_n; Apply le_trans with (Rlength l1); [Assumption | Apply le_n_Sn].
-Assert H15 : (pos_Rl (cons_Rlist l1 l2) (S i))==(pos_Rl l1 (S i)).
-Apply RList_P26; Apply lt_S_n; Apply le_lt_n_Sm; Assumption.
-Rewrite H14 in H2; Rewrite H15 in H2; Assert H16 : (le (2) (Rlength l1)).
-Apply le_trans with (S (S i)); [Repeat Apply le_n_S; Apply le_O_n | Assumption].
-Elim (RList_P20 ? H16); Intros r1 [r2 [r3 H17]]; Rewrite H17; Change (f x)==(pos_Rl (app_Rlist (mid_Rlist (cons_Rlist (cons r2 r3) l2) r1) f) i); Rewrite RList_P12.
-Induction i.
-Simpl; Assert H18 := (H8 O); Unfold constant_D_eq open_interval in H18; Assert H19 : (lt O (pred (Rlength l1))).
-Rewrite H17; Simpl; Apply lt_O_Sn.
-Assert H20 := (H18 H19); Repeat Rewrite H20.
-Reflexivity.
-Assert H21 : ``r1<=r2``.
-Rewrite H17 in H3; Apply (H3 O).
-Simpl; Apply lt_O_Sn.
-Elim H21; Intro.
-Split.
-Rewrite H17; Simpl; Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
-Rewrite H17; Simpl; Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite (Rplus_sym r1); Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
-Elim H2; Intros; Rewrite H17 in H23; Rewrite H17 in H24; Simpl in H24; Simpl in H23; Rewrite H22 in H23; Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H23 H24)).
-Assumption.
-Clear Hreci; Rewrite RList_P13.
-Rewrite H17 in H14; Rewrite H17 in H15; Change (pos_Rl (cons_Rlist (cons r2 r3) l2) i)== (pos_Rl (cons r1 (cons r2 r3)) (S i)) in H14; Rewrite H14; Change (pos_Rl (cons_Rlist (cons r2 r3) l2) (S i))==(pos_Rl (cons r1 (cons r2 r3)) (S (S i))) in H15; Rewrite H15; Assert H18 := (H8 (S i)); Unfold constant_D_eq open_interval in H18; Assert H19 : (lt (S i) (pred (Rlength l1))).
-Apply lt_pred; Apply lt_S_n; Apply le_lt_n_Sm; Assumption.
-Assert H20 := (H18 H19); Repeat Rewrite H20.
-Reflexivity.
-Rewrite <- H17; Assert H21 : ``(pos_Rl l1 (S i))<=(pos_Rl l1 (S (S i)))``.
-Apply (H3 (S i)); Apply lt_pred; Apply lt_S_n; Apply le_lt_n_Sm; Assumption.
-Elim H21; Intro.
-Split.
-Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
-Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite (Rplus_sym (pos_Rl l1 (S i))); Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
-Elim H2; Intros; Rewrite H22 in H23; Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H23 H24)).
-Assumption.
-Simpl; Rewrite H17 in H1; Simpl in H1; Apply lt_S_n; Assumption.
-Rewrite RList_P14; Rewrite H17 in H1; Simpl in H1; Apply H1.
-Inversion H12.
-Assert H16 : (pos_Rl (cons_Rlist l1 l2) (S i))==b.
-Rewrite RList_P29.
-Rewrite H15; Rewrite <- minus_n_n; Rewrite H10; Unfold Rmin; Case (total_order_Rle b c); Intro; [Reflexivity | Elim n; Left; Assumption].
-Rewrite H15; Apply le_n.
-Induction l1.
-Simpl in H15; Discriminate.
-Clear Hrecl1; Simpl in H1; Simpl; Apply lt_n_S; Assumption.
-Assert H17 : (pos_Rl (cons_Rlist l1 l2) i)==b.
-Rewrite RList_P26.
-Replace i with (pred (Rlength l1)); [Rewrite H4; Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Left; Assumption] | Rewrite H15; Reflexivity].
-Rewrite H15; Apply lt_n_Sn.
-Rewrite H16 in H2; Rewrite H17 in H2; Elim H2; Intros; Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H14 H18)).
-Assert H16 : (pos_Rl (cons_Rlist l1 l2) i) == (pos_Rl l2 (minus i (Rlength l1))).
-Apply RList_P29.
-Apply le_S_n; Assumption.
-Apply lt_le_trans with (pred (Rlength (cons_Rlist l1 l2))); [Assumption | Apply le_pred_n].
-Assert H17 : (pos_Rl (cons_Rlist l1 l2) (S i))==(pos_Rl l2 (S (minus i (Rlength l1)))).
-Replace (S (minus i (Rlength l1))) with (minus (S i) (Rlength l1)).
-Apply RList_P29.
-Apply le_S_n; Apply le_trans with (S i); [Assumption | Apply le_n_Sn].
-Induction l1.
-Simpl in H6; Discriminate.
-Clear Hrecl1; Simpl in H1; Simpl; Apply lt_n_S; Assumption.
-Symmetry; Apply minus_Sn_m; Apply le_S_n; Assumption.
-Assert H18 : (le (2) (Rlength l1)).
-Clear f c l2 lf2 H0 H3 H8 H7 H10 H9 H11 H13 i H1 x H2 H12 m H14 H15 H16 H17; Induction l1.
-Discriminate.
-Clear Hrecl1; Induction l1.
-Simpl in H5; Simpl in H4; Assert H0 : ``(Rmin a b)<(Rmax a b)``.
-Unfold Rmin Rmax; Case (total_order_Rle a b); Intro; [Assumption | Elim n; Left; Assumption].
-Rewrite <- H5 in H0; Rewrite <- H4 in H0; Elim (Rlt_antirefl ? H0).
-Clear Hrecl1; Simpl; Repeat Apply le_n_S; Apply le_O_n.
-Elim (RList_P20 ? H18); Intros r1 [r2 [r3 H19]]; Rewrite H19; Change (f x)==(pos_Rl (app_Rlist (mid_Rlist (cons_Rlist (cons r2 r3) l2) r1) f) i); Rewrite RList_P12.
-Induction i.
-Assert H20 := (le_S_n ? ? H15); Assert H21 := (le_trans ? ? ? H18 H20); Elim (le_Sn_O ? H21).
-Clear Hreci; Rewrite RList_P13.
-Rewrite H19 in H16; Rewrite H19 in H17; Change (pos_Rl (cons_Rlist (cons r2 r3) l2) i)== (pos_Rl l2 (minus (S i) (Rlength (cons r1 (cons r2 r3))))) in H16; Rewrite H16; Change (pos_Rl (cons_Rlist (cons r2 r3) l2) (S i))== (pos_Rl l2 (S (minus (S i) (Rlength (cons r1 (cons r2 r3)))))) in H17; Rewrite H17; Assert H20 := (H13 (minus (S i) (Rlength l1))); Unfold constant_D_eq open_interval in H20; Assert H21 : (lt (minus (S i) (Rlength l1)) (pred (Rlength l2))).
-Apply lt_pred; Rewrite minus_Sn_m.
-Apply simpl_lt_plus_l with (Rlength l1); Rewrite <- le_plus_minus.
-Rewrite H19 in H1; Simpl in H1; Rewrite H19; Simpl; Rewrite RList_P23 in H1; Apply lt_n_S; Assumption.
-Apply le_trans with (S i); [Apply le_S_n; Assumption | Apply le_n_Sn].
-Apply le_S_n; Assumption.
-Assert H22 := (H20 H21); Repeat Rewrite H22.
-Reflexivity.
-Rewrite <- H19; Assert H23 : ``(pos_Rl l2 (minus (S i) (Rlength l1)))<=(pos_Rl l2 (S (minus (S i) (Rlength l1))))``.
-Apply H7; Apply lt_pred.
-Rewrite minus_Sn_m.
-Apply simpl_lt_plus_l with (Rlength l1); Rewrite <- le_plus_minus.
-Rewrite H19 in H1; Simpl in H1; Rewrite H19; Simpl; Rewrite RList_P23 in H1; Apply lt_n_S; Assumption.
-Apply le_trans with (S i); [Apply le_S_n; Assumption | Apply le_n_Sn].
-Apply le_S_n; Assumption.
-Elim H23; Intro.
-Split.
-Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
-Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite (Rplus_sym (pos_Rl l2 (minus (S i) (Rlength l1)))); Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
-Rewrite <- H19 in H16; Rewrite <- H19 in H17; Elim H2; Intros; Rewrite H19 in H25; Rewrite H19 in H26; Simpl in H25; Simpl in H16; Rewrite H16 in H25; Simpl in H26; Simpl in H17; Rewrite H17 in H26; Simpl in H24; Rewrite H24 in H25; Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H25 H26)).
-Assert H23 : (pos_Rl (cons_Rlist l1 l2) (S i))==(pos_Rl l2 (minus (S i) (Rlength l1))).
-Rewrite H19; Simpl; Simpl in H16; Apply H16.
-Assert H24 : (pos_Rl (cons_Rlist l1 l2) (S (S i)))==(pos_Rl l2 (S (minus (S i) (Rlength l1)))).
-Rewrite H19; Simpl; Simpl in H17; Apply H17.
-Rewrite <- H23; Rewrite <- H24; Assumption.
-Simpl; Rewrite H19 in H1; Simpl in H1; Apply lt_S_n; Assumption.
-Rewrite RList_P14; Rewrite H19 in H1; Simpl in H1; Simpl; Apply H1.
+Lemma StepFun_P40 :
+ forall (f:R -> R) (a b c:R) (l1 l2 lf1 lf2:Rlist),
+ a < b ->
+ b < c ->
+ adapted_couple f a b l1 lf1 ->
+ adapted_couple f b c l2 lf2 ->
+ adapted_couple f a c (cons_Rlist l1 l2) (FF (cons_Rlist l1 l2) f).
+intros f a b c l1 l2 lf1 lf2 H H0 H1 H2; unfold adapted_couple in H1, H2;
+ unfold adapted_couple in |- *; decompose [and] H1;
+ decompose [and] H2; clear H1 H2; repeat split.
+apply RList_P25; try assumption.
+rewrite H10; rewrite H4; unfold Rmin, Rmax in |- *; case (Rle_dec a b);
+ case (Rle_dec b c); intros;
+ (right; reflexivity) || (elim n; left; assumption).
+rewrite RList_P22.
+rewrite H5; unfold Rmin, Rmax in |- *; case (Rle_dec a b); case (Rle_dec a c);
+ intros;
+ [ reflexivity
+ | elim n; apply Rle_trans with b; left; assumption
+ | elim n; left; assumption
+ | elim n0; left; assumption ].
+red in |- *; intro; rewrite H1 in H6; discriminate.
+rewrite RList_P24.
+rewrite H9; unfold Rmin, Rmax in |- *; case (Rle_dec b c); case (Rle_dec a c);
+ intros;
+ [ reflexivity
+ | elim n; apply Rle_trans with b; left; assumption
+ | elim n; left; assumption
+ | elim n0; left; assumption ].
+red in |- *; intro; rewrite H1 in H11; discriminate.
+apply StepFun_P20.
+rewrite RList_P23; apply neq_O_lt; red in |- *; intro.
+assert (H2 : (Rlength l1 + Rlength l2)%nat = 0%nat).
+symmetry in |- *; apply H1.
+elim (plus_is_O _ _ H2); intros; rewrite H12 in H6; discriminate.
+unfold constant_D_eq, open_interval in |- *; intros;
+ elim (le_or_lt (S (S i)) (Rlength l1)); intro.
+assert (H14 : pos_Rl (cons_Rlist l1 l2) i = pos_Rl l1 i).
+apply RList_P26; apply lt_S_n; apply le_lt_n_Sm; apply le_S_n;
+ apply le_trans with (Rlength l1); [ assumption | apply le_n_Sn ].
+assert (H15 : pos_Rl (cons_Rlist l1 l2) (S i) = pos_Rl l1 (S i)).
+apply RList_P26; apply lt_S_n; apply le_lt_n_Sm; assumption.
+rewrite H14 in H2; rewrite H15 in H2; assert (H16 : (2 <= Rlength l1)%nat).
+apply le_trans with (S (S i));
+ [ repeat apply le_n_S; apply le_O_n | assumption ].
+elim (RList_P20 _ H16); intros r1 [r2 [r3 H17]]; rewrite H17;
+ change
+ (f x = pos_Rl (app_Rlist (mid_Rlist (cons_Rlist (cons r2 r3) l2) r1) f) i)
+ in |- *; rewrite RList_P12.
+induction i as [| i Hreci].
+simpl in |- *; assert (H18 := H8 0%nat);
+ unfold constant_D_eq, open_interval in H18;
+ assert (H19 : (0 < pred (Rlength l1))%nat).
+rewrite H17; simpl in |- *; apply lt_O_Sn.
+assert (H20 := H18 H19); repeat rewrite H20.
+reflexivity.
+assert (H21 : r1 <= r2).
+rewrite H17 in H3; apply (H3 0%nat).
+simpl in |- *; apply lt_O_Sn.
+elim H21; intro.
+split.
+rewrite H17; simpl in |- *; apply Rmult_lt_reg_l with 2;
+ [ prove_sup0
+ | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+ rewrite <- Rinv_r_sym;
+ [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption
+ | discrR ] ].
+rewrite H17; simpl in |- *; apply Rmult_lt_reg_l with 2;
+ [ prove_sup0
+ | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+ rewrite <- Rinv_r_sym;
+ [ rewrite Rmult_1_l; rewrite (Rplus_comm r1); rewrite double;
+ apply Rplus_lt_compat_l; assumption
+ | discrR ] ].
+elim H2; intros; rewrite H17 in H23; rewrite H17 in H24; simpl in H24;
+ simpl in H23; rewrite H22 in H23;
+ elim (Rlt_irrefl _ (Rlt_trans _ _ _ H23 H24)).
+assumption.
+clear Hreci; rewrite RList_P13.
+rewrite H17 in H14; rewrite H17 in H15;
+ change
+ (pos_Rl (cons_Rlist (cons r2 r3) l2) i =
+ pos_Rl (cons r1 (cons r2 r3)) (S i)) in H14; rewrite H14;
+ change
+ (pos_Rl (cons_Rlist (cons r2 r3) l2) (S i) =
+ pos_Rl (cons r1 (cons r2 r3)) (S (S i))) in H15;
+ rewrite H15; assert (H18 := H8 (S i));
+ unfold constant_D_eq, open_interval in H18;
+ assert (H19 : (S i < pred (Rlength l1))%nat).
+apply lt_pred; apply lt_S_n; apply le_lt_n_Sm; assumption.
+assert (H20 := H18 H19); repeat rewrite H20.
+reflexivity.
+rewrite <- H17; assert (H21 : pos_Rl l1 (S i) <= pos_Rl l1 (S (S i))).
+apply (H3 (S i)); apply lt_pred; apply lt_S_n; apply le_lt_n_Sm; assumption.
+elim H21; intro.
+split.
+apply Rmult_lt_reg_l with 2;
+ [ prove_sup0
+ | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+ rewrite <- Rinv_r_sym;
+ [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption
+ | discrR ] ].
+apply Rmult_lt_reg_l with 2;
+ [ prove_sup0
+ | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+ rewrite <- Rinv_r_sym;
+ [ rewrite Rmult_1_l; rewrite (Rplus_comm (pos_Rl l1 (S i)));
+ rewrite double; apply Rplus_lt_compat_l; assumption
+ | discrR ] ].
+elim H2; intros; rewrite H22 in H23;
+ elim (Rlt_irrefl _ (Rlt_trans _ _ _ H23 H24)).
+assumption.
+simpl in |- *; rewrite H17 in H1; simpl in H1; apply lt_S_n; assumption.
+rewrite RList_P14; rewrite H17 in H1; simpl in H1; apply H1.
+inversion H12.
+assert (H16 : pos_Rl (cons_Rlist l1 l2) (S i) = b).
+rewrite RList_P29.
+rewrite H15; rewrite <- minus_n_n; rewrite H10; unfold Rmin in |- *;
+ case (Rle_dec b c); intro; [ reflexivity | elim n; left; assumption ].
+rewrite H15; apply le_n.
+induction l1 as [| r l1 Hrecl1].
+simpl in H15; discriminate.
+clear Hrecl1; simpl in H1; simpl in |- *; apply lt_n_S; assumption.
+assert (H17 : pos_Rl (cons_Rlist l1 l2) i = b).
+rewrite RList_P26.
+replace i with (pred (Rlength l1));
+ [ rewrite H4; unfold Rmax in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n; left; assumption ]
+ | rewrite H15; reflexivity ].
+rewrite H15; apply lt_n_Sn.
+rewrite H16 in H2; rewrite H17 in H2; elim H2; intros;
+ elim (Rlt_irrefl _ (Rlt_trans _ _ _ H14 H18)).
+assert (H16 : pos_Rl (cons_Rlist l1 l2) i = pos_Rl l2 (i - Rlength l1)).
+apply RList_P29.
+apply le_S_n; assumption.
+apply lt_le_trans with (pred (Rlength (cons_Rlist l1 l2)));
+ [ assumption | apply le_pred_n ].
+assert
+ (H17 : pos_Rl (cons_Rlist l1 l2) (S i) = pos_Rl l2 (S (i - Rlength l1))).
+replace (S (i - Rlength l1)) with (S i - Rlength l1)%nat.
+apply RList_P29.
+apply le_S_n; apply le_trans with (S i); [ assumption | apply le_n_Sn ].
+induction l1 as [| r l1 Hrecl1].
+simpl in H6; discriminate.
+clear Hrecl1; simpl in H1; simpl in |- *; apply lt_n_S; assumption.
+symmetry in |- *; apply minus_Sn_m; apply le_S_n; assumption.
+assert (H18 : (2 <= Rlength l1)%nat).
+clear f c l2 lf2 H0 H3 H8 H7 H10 H9 H11 H13 i H1 x H2 H12 m H14 H15 H16 H17;
+ induction l1 as [| r l1 Hrecl1].
+discriminate.
+clear Hrecl1; induction l1 as [| r0 l1 Hrecl1].
+simpl in H5; simpl in H4; assert (H0 : Rmin a b < Rmax a b).
+unfold Rmin, Rmax in |- *; case (Rle_dec a b); intro;
+ [ assumption | elim n; left; assumption ].
+rewrite <- H5 in H0; rewrite <- H4 in H0; elim (Rlt_irrefl _ H0).
+clear Hrecl1; simpl in |- *; repeat apply le_n_S; apply le_O_n.
+elim (RList_P20 _ H18); intros r1 [r2 [r3 H19]]; rewrite H19;
+ change
+ (f x = pos_Rl (app_Rlist (mid_Rlist (cons_Rlist (cons r2 r3) l2) r1) f) i)
+ in |- *; rewrite RList_P12.
+induction i as [| i Hreci].
+assert (H20 := le_S_n _ _ H15); assert (H21 := le_trans _ _ _ H18 H20);
+ elim (le_Sn_O _ H21).
+clear Hreci; rewrite RList_P13.
+rewrite H19 in H16; rewrite H19 in H17;
+ change
+ (pos_Rl (cons_Rlist (cons r2 r3) l2) i =
+ pos_Rl l2 (S i - Rlength (cons r1 (cons r2 r3))))
+ in H16; rewrite H16;
+ change
+ (pos_Rl (cons_Rlist (cons r2 r3) l2) (S i) =
+ pos_Rl l2 (S (S i - Rlength (cons r1 (cons r2 r3)))))
+ in H17; rewrite H17; assert (H20 := H13 (S i - Rlength l1)%nat);
+ unfold constant_D_eq, open_interval in H20;
+ assert (H21 : (S i - Rlength l1 < pred (Rlength l2))%nat).
+apply lt_pred; rewrite minus_Sn_m.
+apply plus_lt_reg_l with (Rlength l1); rewrite <- le_plus_minus.
+rewrite H19 in H1; simpl in H1; rewrite H19; simpl in |- *;
+ rewrite RList_P23 in H1; apply lt_n_S; assumption.
+apply le_trans with (S i); [ apply le_S_n; assumption | apply le_n_Sn ].
+apply le_S_n; assumption.
+assert (H22 := H20 H21); repeat rewrite H22.
+reflexivity.
+rewrite <- H19;
+ assert
+ (H23 : pos_Rl l2 (S i - Rlength l1) <= pos_Rl l2 (S (S i - Rlength l1))).
+apply H7; apply lt_pred.
+rewrite minus_Sn_m.
+apply plus_lt_reg_l with (Rlength l1); rewrite <- le_plus_minus.
+rewrite H19 in H1; simpl in H1; rewrite H19; simpl in |- *;
+ rewrite RList_P23 in H1; apply lt_n_S; assumption.
+apply le_trans with (S i); [ apply le_S_n; assumption | apply le_n_Sn ].
+apply le_S_n; assumption.
+elim H23; intro.
+split.
+apply Rmult_lt_reg_l with 2;
+ [ prove_sup0
+ | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+ rewrite <- Rinv_r_sym;
+ [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption
+ | discrR ] ].
+apply Rmult_lt_reg_l with 2;
+ [ prove_sup0
+ | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+ rewrite <- Rinv_r_sym;
+ [ rewrite Rmult_1_l; rewrite (Rplus_comm (pos_Rl l2 (S i - Rlength l1)));
+ rewrite double; apply Rplus_lt_compat_l; assumption
+ | discrR ] ].
+rewrite <- H19 in H16; rewrite <- H19 in H17; elim H2; intros;
+ rewrite H19 in H25; rewrite H19 in H26; simpl in H25;
+ simpl in H16; rewrite H16 in H25; simpl in H26; simpl in H17;
+ rewrite H17 in H26; simpl in H24; rewrite H24 in H25;
+ elim (Rlt_irrefl _ (Rlt_trans _ _ _ H25 H26)).
+assert (H23 : pos_Rl (cons_Rlist l1 l2) (S i) = pos_Rl l2 (S i - Rlength l1)).
+rewrite H19; simpl in |- *; simpl in H16; apply H16.
+assert
+ (H24 :
+ pos_Rl (cons_Rlist l1 l2) (S (S i)) = pos_Rl l2 (S (S i - Rlength l1))).
+rewrite H19; simpl in |- *; simpl in H17; apply H17.
+rewrite <- H23; rewrite <- H24; assumption.
+simpl in |- *; rewrite H19 in H1; simpl in H1; apply lt_S_n; assumption.
+rewrite RList_P14; rewrite H19 in H1; simpl in H1; simpl in |- *; apply H1.
Qed.
-Lemma StepFun_P41 : (f:R->R;a,b,c:R) ``a<=b``->``b<=c``->(IsStepFun f a b) -> (IsStepFun f b c) -> (IsStepFun f a c).
-Unfold IsStepFun; Unfold is_subdivision; Intros; Elim X; Clear X; Intros l1 [lf1 H1]; Elim X0; Clear X0; Intros l2 [lf2 H2]; Case (total_order_T a b); Intro.
-Elim s; Intro.
-Case (total_order_T b c); Intro.
-Elim s0; Intro.
-Split with (cons_Rlist l1 l2); Split with (FF (cons_Rlist l1 l2) f); Apply StepFun_P40 with b lf1 lf2; Assumption.
-Split with l1; Split with lf1; Rewrite b0 in H1; Assumption.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H0 r)).
-Split with l2; Split with lf2; Rewrite <- b0 in H2; Assumption.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r)).
+Lemma StepFun_P41 :
+ forall (f:R -> R) (a b c:R),
+ a <= b -> b <= c -> IsStepFun f a b -> IsStepFun f b c -> IsStepFun f a c.
+unfold IsStepFun in |- *; unfold is_subdivision in |- *; intros; elim X;
+ clear X; intros l1 [lf1 H1]; elim X0; clear X0; intros l2 [lf2 H2];
+ case (total_order_T a b); intro.
+elim s; intro.
+case (total_order_T b c); intro.
+elim s0; intro.
+split with (cons_Rlist l1 l2); split with (FF (cons_Rlist l1 l2) f);
+ apply StepFun_P40 with b lf1 lf2; assumption.
+split with l1; split with lf1; rewrite b0 in H1; assumption.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 r)).
+split with l2; split with lf2; rewrite <- b0 in H2; assumption.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)).
Qed.
-Lemma StepFun_P42 : (l1,l2:Rlist;f:R->R) (pos_Rl l1 (pred (Rlength l1)))==(pos_Rl l2 O) -> ``(Int_SF (FF (cons_Rlist l1 l2) f) (cons_Rlist l1 l2)) == (Int_SF (FF l1 f) l1) + (Int_SF (FF l2 f) l2)``.
-Intros l1 l2 f; NewInduction l1 as [|r l1 IHl1]; Intros H; [ Simpl; Ring | NewDestruct l1; [Simpl in H; Simpl; NewDestruct l2; [Simpl; Ring | Simpl; Simpl in H; Rewrite H; Ring] | Simpl; Rewrite Rplus_assoc; Apply Rplus_plus_r; Apply IHl1; Rewrite <- H; Reflexivity]].
+Lemma StepFun_P42 :
+ forall (l1 l2:Rlist) (f:R -> R),
+ pos_Rl l1 (pred (Rlength l1)) = pos_Rl l2 0 ->
+ Int_SF (FF (cons_Rlist l1 l2) f) (cons_Rlist l1 l2) =
+ Int_SF (FF l1 f) l1 + Int_SF (FF l2 f) l2.
+intros l1 l2 f; induction l1 as [| r l1 IHl1]; intros H;
+ [ simpl in |- *; ring
+ | destruct l1 as [| r0 r1];
+ [ simpl in H; simpl in |- *; destruct l2 as [| r0 r1];
+ [ simpl in |- *; ring | simpl in |- *; simpl in H; rewrite H; ring ]
+ | simpl in |- *; rewrite Rplus_assoc; apply Rplus_eq_compat_l; apply IHl1;
+ rewrite <- H; reflexivity ] ].
Qed.
-Lemma StepFun_P43 : (f:R->R;a,b,c:R;pr1:(IsStepFun f a b);pr2:(IsStepFun f b c);pr3:(IsStepFun f a c)) ``(RiemannInt_SF (mkStepFun pr1))+(RiemannInt_SF (mkStepFun pr2))==(RiemannInt_SF (mkStepFun pr3))``.
-Intros f; Intros; Assert H1 : (SigT ? [l:Rlist](sigTT ? [l0:Rlist](adapted_couple f a b l l0))).
-Apply pr1.
-Assert H2 : (SigT ? [l:Rlist](sigTT ? [l0:Rlist](adapted_couple f b c l l0))).
-Apply pr2.
-Assert H3 : (SigT ? [l:Rlist](sigTT ? [l0:Rlist](adapted_couple f a c l l0))).
-Apply pr3.
-Elim H1; Clear H1; Intros l1 [lf1 H1]; Elim H2; Clear H2; Intros l2 [lf2 H2]; Elim H3; Clear H3; Intros l3 [lf3 H3].
-Replace (RiemannInt_SF (mkStepFun pr1)) with (Cases (total_order_Rle a b) of (leftT _) => (Int_SF lf1 l1) | (rightT _) => ``-(Int_SF lf1 l1)`` end).
-Replace (RiemannInt_SF (mkStepFun pr2)) with (Cases (total_order_Rle b c) of (leftT _) => (Int_SF lf2 l2) | (rightT _) => ``-(Int_SF lf2 l2)`` end).
-Replace (RiemannInt_SF (mkStepFun pr3)) with (Cases (total_order_Rle a c) of (leftT _) => (Int_SF lf3 l3) | (rightT _) => ``-(Int_SF lf3 l3)`` end).
-Case (total_order_Rle a b); Case (total_order_Rle b c); Case (total_order_Rle a c); Intros.
-Elim r1; Intro.
-Elim r0; Intro.
-Replace (Int_SF lf3 l3) with (Int_SF (FF (cons_Rlist l1 l2) f) (cons_Rlist l1 l2)).
-Replace (Int_SF lf1 l1) with (Int_SF (FF l1 f) l1).
-Replace (Int_SF lf2 l2) with (Int_SF (FF l2 f) l2).
-Symmetry; Apply StepFun_P42.
-Unfold adapted_couple in H1 H2; Decompose [and] H1; Decompose [and] H2; Clear H1 H2; Rewrite H11; Rewrite H5; Unfold Rmax Rmin; Case (total_order_Rle a b); Case (total_order_Rle b c); Intros; Reflexivity Orelse Elim n; Assumption.
-EApply StepFun_P17; [Apply StepFun_P21; Unfold is_subdivision; Split with lf2; Apply H2; Assumption | Assumption].
-EApply StepFun_P17; [Apply StepFun_P21; Unfold is_subdivision; Split with lf1; Apply H1 | Assumption].
-EApply StepFun_P17; [Apply (StepFun_P40 H H0 H1 H2) | Apply H3].
-Replace (Int_SF lf2 l2) with R0.
-Rewrite Rplus_Or; EApply StepFun_P17; [Apply H1 | Rewrite <- H0 in H3; Apply H3].
-Symmetry; EApply StepFun_P8; [Apply H2 | Assumption].
-Replace (Int_SF lf1 l1) with R0.
-Rewrite Rplus_Ol; EApply StepFun_P17; [Apply H2 | Rewrite H in H3; Apply H3].
-Symmetry; EApply StepFun_P8; [Apply H1 | Assumption].
-Elim n; Apply Rle_trans with b; Assumption.
-Apply r_Rplus_plus with (Int_SF lf2 l2); Replace ``(Int_SF lf2 l2)+((Int_SF lf1 l1)+ -(Int_SF lf2 l2))`` with (Int_SF lf1 l1); [Idtac | Ring].
-Assert H : ``c<b``.
-Auto with real.
-Elim r; Intro.
-Rewrite Rplus_sym; Replace (Int_SF lf1 l1) with (Int_SF (FF (cons_Rlist l3 l2) f) (cons_Rlist l3 l2)).
-Replace (Int_SF lf3 l3) with (Int_SF (FF l3 f) l3).
-Replace (Int_SF lf2 l2) with (Int_SF (FF l2 f) l2).
-Apply StepFun_P42.
-Unfold adapted_couple in H2 H3; Decompose [and] H2; Decompose [and] H3; Clear H3 H2; Rewrite H10; Rewrite H6; Unfold Rmax Rmin; Case (total_order_Rle a c); Case (total_order_Rle b c); Intros; [Elim n; Assumption | Reflexivity | Elim n0; Assumption | Elim n1; Assumption].
-EApply StepFun_P17; [Apply StepFun_P21; Unfold is_subdivision; Split with lf2; Apply H2 | Assumption].
-EApply StepFun_P17; [Apply StepFun_P21; Unfold is_subdivision; Split with lf3; Apply H3 | Assumption].
-EApply StepFun_P17; [Apply (StepFun_P40 H0 H H3 (StepFun_P2 H2)) | Apply H1].
-Replace (Int_SF lf3 l3) with R0.
-Rewrite Rplus_Or; EApply StepFun_P17; [Apply H1 | Apply StepFun_P2; Rewrite <- H0 in H2; Apply H2].
-Symmetry; EApply StepFun_P8; [Apply H3 | Assumption].
-Replace (Int_SF lf2 l2) with ``(Int_SF lf3 l3)+(Int_SF lf1 l1)``.
-Ring.
-Elim r; Intro.
-Replace (Int_SF lf2 l2) with (Int_SF (FF (cons_Rlist l3 l1) f) (cons_Rlist l3 l1)).
-Replace (Int_SF lf3 l3) with (Int_SF (FF l3 f) l3).
-Replace (Int_SF lf1 l1) with (Int_SF (FF l1 f) l1).
-Symmetry; Apply StepFun_P42.
-Unfold adapted_couple in H1 H3; Decompose [and] H1; Decompose [and] H3; Clear H3 H1; Rewrite H9; Rewrite H5; Unfold Rmax Rmin; Case (total_order_Rle a c); Case (total_order_Rle a b); Intros; [Elim n; Assumption | Elim n1; Assumption | Reflexivity | Elim n1; Assumption].
-EApply StepFun_P17; [Apply StepFun_P21; Unfold is_subdivision; Split with lf1; Apply H1 | Assumption].
-EApply StepFun_P17; [Apply StepFun_P21; Unfold is_subdivision; Split with lf3; Apply H3 | Assumption].
-EApply StepFun_P17.
-Assert H0 : ``c<a``.
-Auto with real.
-Apply (StepFun_P40 H0 H (StepFun_P2 H3) H1).
-Apply StepFun_P2; Apply H2.
-Replace (Int_SF lf1 l1) with R0.
-Rewrite Rplus_Or; EApply StepFun_P17; [Apply H3 | Rewrite <- H in H2; Apply H2].
-Symmetry; EApply StepFun_P8; [Apply H1 | Assumption].
-Assert H : ``b<a``.
-Auto with real.
-Replace (Int_SF lf2 l2) with ``(Int_SF lf3 l3)+(Int_SF lf1 l1)``.
-Ring.
-Rewrite Rplus_sym; Elim r; Intro.
-Replace (Int_SF lf2 l2) with (Int_SF (FF (cons_Rlist l1 l3) f) (cons_Rlist l1 l3)).
-Replace (Int_SF lf3 l3) with (Int_SF (FF l3 f) l3).
-Replace (Int_SF lf1 l1) with (Int_SF (FF l1 f) l1).
-Symmetry; Apply StepFun_P42.
-Unfold adapted_couple in H1 H3; Decompose [and] H1; Decompose [and] H3; Clear H3 H1; Rewrite H11; Rewrite H5; Unfold Rmax Rmin; Case (total_order_Rle a c); Case (total_order_Rle a b); Intros; [Elim n; Assumption | Reflexivity | Elim n0; Assumption | Elim n1; Assumption].
-EApply StepFun_P17; [Apply StepFun_P21; Unfold is_subdivision; Split with lf1; Apply H1 | Assumption].
-EApply StepFun_P17; [Apply StepFun_P21; Unfold is_subdivision; Split with lf3; Apply H3 | Assumption].
-EApply StepFun_P17.
-Apply (StepFun_P40 H H0 (StepFun_P2 H1) H3).
-Apply H2.
-Replace (Int_SF lf3 l3) with R0.
-Rewrite Rplus_Or; EApply StepFun_P17; [Apply H1 | Rewrite <- H0 in H2; Apply StepFun_P2; Apply H2].
-Symmetry; EApply StepFun_P8; [Apply H3 | Assumption].
-Assert H : ``c<a``.
-Auto with real.
-Replace (Int_SF lf1 l1) with ``(Int_SF lf2 l2)+(Int_SF lf3 l3)``.
-Ring.
-Elim r; Intro.
-Replace (Int_SF lf1 l1) with (Int_SF (FF (cons_Rlist l2 l3) f) (cons_Rlist l2 l3)).
-Replace (Int_SF lf3 l3) with (Int_SF (FF l3 f) l3).
-Replace (Int_SF lf2 l2) with (Int_SF (FF l2 f) l2).
-Symmetry; Apply StepFun_P42.
-Unfold adapted_couple in H2 H3; Decompose [and] H2; Decompose [and] H3; Clear H3 H2; Rewrite H11; Rewrite H5; Unfold Rmax Rmin; Case (total_order_Rle a c); Case (total_order_Rle b c); Intros; [Elim n; Assumption | Elim n1; Assumption | Reflexivity | Elim n1; Assumption].
-EApply StepFun_P17; [Apply StepFun_P21; Unfold is_subdivision; Split with lf2; Apply H2 | Assumption].
-EApply StepFun_P17; [Apply StepFun_P21; Unfold is_subdivision; Split with lf3; Apply H3 | Assumption].
-EApply StepFun_P17.
-Apply (StepFun_P40 H0 H H2 (StepFun_P2 H3)).
-Apply StepFun_P2; Apply H1.
-Replace (Int_SF lf2 l2) with R0.
-Rewrite Rplus_Ol; EApply StepFun_P17; [Apply H3 | Rewrite H0 in H1; Apply H1].
-Symmetry; EApply StepFun_P8; [Apply H2 | Assumption].
-Elim n; Apply Rle_trans with a; Try Assumption.
-Auto with real.
-Assert H : ``c<b``.
-Auto with real.
-Assert H0 : ``b<a``.
-Auto with real.
-Replace (Int_SF lf3 l3) with ``(Int_SF lf2 l2)+(Int_SF lf1 l1)``.
-Ring.
-Replace (Int_SF lf3 l3) with (Int_SF (FF (cons_Rlist l2 l1) f) (cons_Rlist l2 l1)).
-Replace (Int_SF lf1 l1) with (Int_SF (FF l1 f) l1).
-Replace (Int_SF lf2 l2) with (Int_SF (FF l2 f) l2).
-Symmetry; Apply StepFun_P42.
-Unfold adapted_couple in H2 H1; Decompose [and] H2; Decompose [and] H1; Clear H1 H2; Rewrite H11; Rewrite H5; Unfold Rmax Rmin; Case (total_order_Rle a b); Case (total_order_Rle b c); Intros; [Elim n1; Assumption | Elim n1; Assumption | Elim n0; Assumption | Reflexivity].
-EApply StepFun_P17; [Apply StepFun_P21; Unfold is_subdivision; Split with lf2; Apply H2 | Assumption].
-EApply StepFun_P17; [Apply StepFun_P21; Unfold is_subdivision; Split with lf1; Apply H1 | Assumption].
-EApply StepFun_P17.
-Apply (StepFun_P40 H H0 (StepFun_P2 H2) (StepFun_P2 H1)).
-Apply StepFun_P2; Apply H3.
-Unfold RiemannInt_SF; Case (total_order_Rle a c); Intro.
-EApply StepFun_P17.
-Apply H3.
-Change (adapted_couple (mkStepFun pr3) a c (subdivision (mkStepFun 1!a 2!c 3!f pr3)) (subdivision_val (mkStepFun 1!a 2!c 3!f pr3))); Apply StepFun_P1.
-Apply eq_Ropp; EApply StepFun_P17.
-Apply H3.
-Change (adapted_couple (mkStepFun pr3) a c (subdivision (mkStepFun 1!a 2!c 3!f pr3)) (subdivision_val (mkStepFun 1!a 2!c 3!f pr3))); Apply StepFun_P1.
-Unfold RiemannInt_SF; Case (total_order_Rle b c); Intro.
-EApply StepFun_P17.
-Apply H2.
-Change (adapted_couple (mkStepFun pr2) b c (subdivision (mkStepFun 1!b 2!c 3!f pr2)) (subdivision_val (mkStepFun 1!b 2!c 3!f pr2))); Apply StepFun_P1.
-Apply eq_Ropp; EApply StepFun_P17.
-Apply H2.
-Change (adapted_couple (mkStepFun pr2) b c (subdivision (mkStepFun 1!b 2!c 3!f pr2)) (subdivision_val (mkStepFun 1!b 2!c 3!f pr2))); Apply StepFun_P1.
-Unfold RiemannInt_SF; Case (total_order_Rle a b); Intro.
-EApply StepFun_P17.
-Apply H1.
-Change (adapted_couple (mkStepFun pr1) a b (subdivision (mkStepFun 1!a 2!b 3!f pr1)) (subdivision_val (mkStepFun 1!a 2!b 3!f pr1))); Apply StepFun_P1.
-Apply eq_Ropp; EApply StepFun_P17.
-Apply H1.
-Change (adapted_couple (mkStepFun pr1) a b (subdivision (mkStepFun 1!a 2!b 3!f pr1)) (subdivision_val (mkStepFun 1!a 2!b 3!f pr1))); Apply StepFun_P1.
+Lemma StepFun_P43 :
+ forall (f:R -> R) (a b c:R) (pr1:IsStepFun f a b)
+ (pr2:IsStepFun f b c) (pr3:IsStepFun f a c),
+ RiemannInt_SF (mkStepFun pr1) + RiemannInt_SF (mkStepFun pr2) =
+ RiemannInt_SF (mkStepFun pr3).
+intros f; intros;
+ assert
+ (H1 :
+ sigT (fun l:Rlist => sigT (fun l0:Rlist => adapted_couple f a b l l0))).
+apply pr1.
+assert
+ (H2 :
+ sigT (fun l:Rlist => sigT (fun l0:Rlist => adapted_couple f b c l l0))).
+apply pr2.
+assert
+ (H3 :
+ sigT (fun l:Rlist => sigT (fun l0:Rlist => adapted_couple f a c l l0))).
+apply pr3.
+elim H1; clear H1; intros l1 [lf1 H1]; elim H2; clear H2; intros l2 [lf2 H2];
+ elim H3; clear H3; intros l3 [lf3 H3].
+replace (RiemannInt_SF (mkStepFun pr1)) with
+ match Rle_dec a b with
+ | left _ => Int_SF lf1 l1
+ | right _ => - Int_SF lf1 l1
+ end.
+replace (RiemannInt_SF (mkStepFun pr2)) with
+ match Rle_dec b c with
+ | left _ => Int_SF lf2 l2
+ | right _ => - Int_SF lf2 l2
+ end.
+replace (RiemannInt_SF (mkStepFun pr3)) with
+ match Rle_dec a c with
+ | left _ => Int_SF lf3 l3
+ | right _ => - Int_SF lf3 l3
+ end.
+case (Rle_dec a b); case (Rle_dec b c); case (Rle_dec a c); intros.
+elim r1; intro.
+elim r0; intro.
+replace (Int_SF lf3 l3) with
+ (Int_SF (FF (cons_Rlist l1 l2) f) (cons_Rlist l1 l2)).
+replace (Int_SF lf1 l1) with (Int_SF (FF l1 f) l1).
+replace (Int_SF lf2 l2) with (Int_SF (FF l2 f) l2).
+symmetry in |- *; apply StepFun_P42.
+unfold adapted_couple in H1, H2; decompose [and] H1; decompose [and] H2;
+ clear H1 H2; rewrite H11; rewrite H5; unfold Rmax, Rmin in |- *;
+ case (Rle_dec a b); case (Rle_dec b c); intros; reflexivity || elim n;
+ assumption.
+eapply StepFun_P17;
+ [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf2; apply H2;
+ assumption
+ | assumption ].
+eapply StepFun_P17;
+ [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf1; apply H1
+ | assumption ].
+eapply StepFun_P17; [ apply (StepFun_P40 H H0 H1 H2) | apply H3 ].
+replace (Int_SF lf2 l2) with 0.
+rewrite Rplus_0_r; eapply StepFun_P17;
+ [ apply H1 | rewrite <- H0 in H3; apply H3 ].
+symmetry in |- *; eapply StepFun_P8; [ apply H2 | assumption ].
+replace (Int_SF lf1 l1) with 0.
+rewrite Rplus_0_l; eapply StepFun_P17;
+ [ apply H2 | rewrite H in H3; apply H3 ].
+symmetry in |- *; eapply StepFun_P8; [ apply H1 | assumption ].
+elim n; apply Rle_trans with b; assumption.
+apply Rplus_eq_reg_l with (Int_SF lf2 l2);
+ replace (Int_SF lf2 l2 + (Int_SF lf1 l1 + - Int_SF lf2 l2)) with
+ (Int_SF lf1 l1); [ idtac | ring ].
+assert (H : c < b).
+auto with real.
+elim r; intro.
+rewrite Rplus_comm;
+ replace (Int_SF lf1 l1) with
+ (Int_SF (FF (cons_Rlist l3 l2) f) (cons_Rlist l3 l2)).
+replace (Int_SF lf3 l3) with (Int_SF (FF l3 f) l3).
+replace (Int_SF lf2 l2) with (Int_SF (FF l2 f) l2).
+apply StepFun_P42.
+unfold adapted_couple in H2, H3; decompose [and] H2; decompose [and] H3;
+ clear H3 H2; rewrite H10; rewrite H6; unfold Rmax, Rmin in |- *;
+ case (Rle_dec a c); case (Rle_dec b c); intros;
+ [ elim n; assumption
+ | reflexivity
+ | elim n0; assumption
+ | elim n1; assumption ].
+eapply StepFun_P17;
+ [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf2; apply H2
+ | assumption ].
+eapply StepFun_P17;
+ [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf3; apply H3
+ | assumption ].
+eapply StepFun_P17;
+ [ apply (StepFun_P40 H0 H H3 (StepFun_P2 H2)) | apply H1 ].
+replace (Int_SF lf3 l3) with 0.
+rewrite Rplus_0_r; eapply StepFun_P17;
+ [ apply H1 | apply StepFun_P2; rewrite <- H0 in H2; apply H2 ].
+symmetry in |- *; eapply StepFun_P8; [ apply H3 | assumption ].
+replace (Int_SF lf2 l2) with (Int_SF lf3 l3 + Int_SF lf1 l1).
+ring.
+elim r; intro.
+replace (Int_SF lf2 l2) with
+ (Int_SF (FF (cons_Rlist l3 l1) f) (cons_Rlist l3 l1)).
+replace (Int_SF lf3 l3) with (Int_SF (FF l3 f) l3).
+replace (Int_SF lf1 l1) with (Int_SF (FF l1 f) l1).
+symmetry in |- *; apply StepFun_P42.
+unfold adapted_couple in H1, H3; decompose [and] H1; decompose [and] H3;
+ clear H3 H1; rewrite H9; rewrite H5; unfold Rmax, Rmin in |- *;
+ case (Rle_dec a c); case (Rle_dec a b); intros;
+ [ elim n; assumption
+ | elim n1; assumption
+ | reflexivity
+ | elim n1; assumption ].
+eapply StepFun_P17;
+ [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf1; apply H1
+ | assumption ].
+eapply StepFun_P17;
+ [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf3; apply H3
+ | assumption ].
+eapply StepFun_P17.
+assert (H0 : c < a).
+auto with real.
+apply (StepFun_P40 H0 H (StepFun_P2 H3) H1).
+apply StepFun_P2; apply H2.
+replace (Int_SF lf1 l1) with 0.
+rewrite Rplus_0_r; eapply StepFun_P17;
+ [ apply H3 | rewrite <- H in H2; apply H2 ].
+symmetry in |- *; eapply StepFun_P8; [ apply H1 | assumption ].
+assert (H : b < a).
+auto with real.
+replace (Int_SF lf2 l2) with (Int_SF lf3 l3 + Int_SF lf1 l1).
+ring.
+rewrite Rplus_comm; elim r; intro.
+replace (Int_SF lf2 l2) with
+ (Int_SF (FF (cons_Rlist l1 l3) f) (cons_Rlist l1 l3)).
+replace (Int_SF lf3 l3) with (Int_SF (FF l3 f) l3).
+replace (Int_SF lf1 l1) with (Int_SF (FF l1 f) l1).
+symmetry in |- *; apply StepFun_P42.
+unfold adapted_couple in H1, H3; decompose [and] H1; decompose [and] H3;
+ clear H3 H1; rewrite H11; rewrite H5; unfold Rmax, Rmin in |- *;
+ case (Rle_dec a c); case (Rle_dec a b); intros;
+ [ elim n; assumption
+ | reflexivity
+ | elim n0; assumption
+ | elim n1; assumption ].
+eapply StepFun_P17;
+ [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf1; apply H1
+ | assumption ].
+eapply StepFun_P17;
+ [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf3; apply H3
+ | assumption ].
+eapply StepFun_P17.
+apply (StepFun_P40 H H0 (StepFun_P2 H1) H3).
+apply H2.
+replace (Int_SF lf3 l3) with 0.
+rewrite Rplus_0_r; eapply StepFun_P17;
+ [ apply H1 | rewrite <- H0 in H2; apply StepFun_P2; apply H2 ].
+symmetry in |- *; eapply StepFun_P8; [ apply H3 | assumption ].
+assert (H : c < a).
+auto with real.
+replace (Int_SF lf1 l1) with (Int_SF lf2 l2 + Int_SF lf3 l3).
+ring.
+elim r; intro.
+replace (Int_SF lf1 l1) with
+ (Int_SF (FF (cons_Rlist l2 l3) f) (cons_Rlist l2 l3)).
+replace (Int_SF lf3 l3) with (Int_SF (FF l3 f) l3).
+replace (Int_SF lf2 l2) with (Int_SF (FF l2 f) l2).
+symmetry in |- *; apply StepFun_P42.
+unfold adapted_couple in H2, H3; decompose [and] H2; decompose [and] H3;
+ clear H3 H2; rewrite H11; rewrite H5; unfold Rmax, Rmin in |- *;
+ case (Rle_dec a c); case (Rle_dec b c); intros;
+ [ elim n; assumption
+ | elim n1; assumption
+ | reflexivity
+ | elim n1; assumption ].
+eapply StepFun_P17;
+ [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf2; apply H2
+ | assumption ].
+eapply StepFun_P17;
+ [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf3; apply H3
+ | assumption ].
+eapply StepFun_P17.
+apply (StepFun_P40 H0 H H2 (StepFun_P2 H3)).
+apply StepFun_P2; apply H1.
+replace (Int_SF lf2 l2) with 0.
+rewrite Rplus_0_l; eapply StepFun_P17;
+ [ apply H3 | rewrite H0 in H1; apply H1 ].
+symmetry in |- *; eapply StepFun_P8; [ apply H2 | assumption ].
+elim n; apply Rle_trans with a; try assumption.
+auto with real.
+assert (H : c < b).
+auto with real.
+assert (H0 : b < a).
+auto with real.
+replace (Int_SF lf3 l3) with (Int_SF lf2 l2 + Int_SF lf1 l1).
+ring.
+replace (Int_SF lf3 l3) with
+ (Int_SF (FF (cons_Rlist l2 l1) f) (cons_Rlist l2 l1)).
+replace (Int_SF lf1 l1) with (Int_SF (FF l1 f) l1).
+replace (Int_SF lf2 l2) with (Int_SF (FF l2 f) l2).
+symmetry in |- *; apply StepFun_P42.
+unfold adapted_couple in H2, H1; decompose [and] H2; decompose [and] H1;
+ clear H1 H2; rewrite H11; rewrite H5; unfold Rmax, Rmin in |- *;
+ case (Rle_dec a b); case (Rle_dec b c); intros;
+ [ elim n1; assumption
+ | elim n1; assumption
+ | elim n0; assumption
+ | reflexivity ].
+eapply StepFun_P17;
+ [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf2; apply H2
+ | assumption ].
+eapply StepFun_P17;
+ [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf1; apply H1
+ | assumption ].
+eapply StepFun_P17.
+apply (StepFun_P40 H H0 (StepFun_P2 H2) (StepFun_P2 H1)).
+apply StepFun_P2; apply H3.
+unfold RiemannInt_SF in |- *; case (Rle_dec a c); intro.
+eapply StepFun_P17.
+apply H3.
+change
+ (adapted_couple (mkStepFun pr3) a c (subdivision (mkStepFun pr3))
+ (subdivision_val (mkStepFun pr3))) in |- *; apply StepFun_P1.
+apply Ropp_eq_compat; eapply StepFun_P17.
+apply H3.
+change
+ (adapted_couple (mkStepFun pr3) a c (subdivision (mkStepFun pr3))
+ (subdivision_val (mkStepFun pr3))) in |- *; apply StepFun_P1.
+unfold RiemannInt_SF in |- *; case (Rle_dec b c); intro.
+eapply StepFun_P17.
+apply H2.
+change
+ (adapted_couple (mkStepFun pr2) b c (subdivision (mkStepFun pr2))
+ (subdivision_val (mkStepFun pr2))) in |- *; apply StepFun_P1.
+apply Ropp_eq_compat; eapply StepFun_P17.
+apply H2.
+change
+ (adapted_couple (mkStepFun pr2) b c (subdivision (mkStepFun pr2))
+ (subdivision_val (mkStepFun pr2))) in |- *; apply StepFun_P1.
+unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro.
+eapply StepFun_P17.
+apply H1.
+change
+ (adapted_couple (mkStepFun pr1) a b (subdivision (mkStepFun pr1))
+ (subdivision_val (mkStepFun pr1))) in |- *; apply StepFun_P1.
+apply Ropp_eq_compat; eapply StepFun_P17.
+apply H1.
+change
+ (adapted_couple (mkStepFun pr1) a b (subdivision (mkStepFun pr1))
+ (subdivision_val (mkStepFun pr1))) in |- *; apply StepFun_P1.
Qed.
-Lemma StepFun_P44 : (f:R->R;a,b,c:R) (IsStepFun f a b) -> ``a<=c<=b`` -> (IsStepFun f a c).
-Intros f; Intros; Assert H0 : ``a<=b``.
-Elim H; Intros; Apply Rle_trans with c; Assumption.
-Elim H; Clear H; Intros; Unfold IsStepFun in X; Unfold is_subdivision in X; Elim X; Clear X; Intros l1 [lf1 H2]; Cut (l1,lf1:Rlist;a,b,c:R;f:R->R) (adapted_couple f a b l1 lf1) -> ``a<=c<=b`` -> (SigT ? [l:Rlist](sigTT ? [l0:Rlist](adapted_couple f a c l l0))).
-Intros; Unfold IsStepFun; Unfold is_subdivision; EApply X.
-Apply H2.
-Split; Assumption.
-Clear f a b c H0 H H1 H2 l1 lf1; Induction l1.
-Intros; Unfold adapted_couple in H; Decompose [and] H; Clear H; Simpl in H4; Discriminate.
-Induction r0.
-Intros; Assert H1 : ``a==b``.
-Unfold adapted_couple in H; Decompose [and] H; Clear H; Simpl in H3; Simpl in H2; Assert H7 : ``a<=b``.
-Elim H0; Intros; Apply Rle_trans with c; Assumption.
-Replace a with (Rmin a b).
-Pattern 2 b; Replace b with (Rmax a b).
-Rewrite <- H2; Rewrite H3; Reflexivity.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Split with (cons r nil); Split with lf1; Assert H2 : ``c==b``.
-Rewrite H1 in H0; Elim H0; Intros; Apply Rle_antisym; Assumption.
-Rewrite H2; Assumption.
-Intros; Clear X; Induction lf1.
-Unfold adapted_couple in H; Decompose [and] H; Clear H; Simpl in H4; Discriminate.
-Clear Hreclf1; Assert H1 : (sumboolT ``c<=r1`` ``r1<c``).
-Case (total_order_Rle c r1); Intro; [Left; Assumption | Right; Auto with real].
-Elim H1; Intro.
-Split with (cons r (cons c nil)); Split with (cons r3 nil); Unfold adapted_couple in H; Decompose [and] H; Clear H; Assert H6 : ``r==a``.
-Simpl in H4; Rewrite H4; Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Elim H0; Intros; Apply Rle_trans with c; Assumption].
-Elim H0; Clear H0; Intros; Unfold adapted_couple; Repeat Split.
-Rewrite H6; Unfold ordered_Rlist; Intros; Simpl in H8; Inversion H8; [Simpl; Assumption | Elim (le_Sn_O ? H10)].
-Simpl; Unfold Rmin; Case (total_order_Rle a c); Intro; [Assumption | Elim n; Assumption].
-Simpl; Unfold Rmax; Case (total_order_Rle a c); Intro; [Reflexivity | Elim n; Assumption].
-Unfold constant_D_eq open_interval; Intros; Simpl in H8; Inversion H8.
-Simpl; Assert H10 := (H7 O); Assert H12 : (lt (0) (pred (Rlength (cons r (cons r1 r2))))).
-Simpl; Apply lt_O_Sn.
-Apply (H10 H12); Unfold open_interval; Simpl; Rewrite H11 in H9; Simpl in H9; Elim H9; Clear H9; Intros; Split; Try Assumption.
-Apply Rlt_le_trans with c; Assumption.
-Elim (le_Sn_O ? H11).
-Cut (adapted_couple f r1 b (cons r1 r2) lf1).
-Cut ``r1<=c<=b``.
-Intros.
-Elim (X0 ? ? ? ? ? H3 H2); Intros l1' [lf1' H4]; Split with (cons r l1'); Split with (cons r3 lf1'); Unfold adapted_couple in H H4; Decompose [and] H; Decompose [and] H4; Clear H H4 X0; Assert H14 : ``a<=b``.
-Elim H0; Intros; Apply Rle_trans with c; Assumption.
-Assert H16 : ``r==a``.
-Simpl in H7; Rewrite H7; Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Induction l1'.
-Simpl in H13; Discriminate.
-Clear Hrecl1'; Unfold adapted_couple; Repeat Split.
-Unfold ordered_Rlist; Intros; Simpl in H; Induction i.
-Simpl; Replace r4 with r1.
-Apply (H5 O).
-Simpl; Apply lt_O_Sn.
-Simpl in H12; Rewrite H12; Unfold Rmin; Case (total_order_Rle r1 c); Intro; [Reflexivity | Elim n; Left; Assumption].
-Apply (H9 i); Simpl; Apply lt_S_n; Assumption.
-Simpl; Unfold Rmin; Case (total_order_Rle a c); Intro; [Assumption | Elim n; Elim H0; Intros; Assumption].
-Replace (Rmax a c) with (Rmax r1 c).
-Rewrite <- H11; Reflexivity.
-Unfold Rmax; Case (total_order_Rle r1 c); Case (total_order_Rle a c); Intros; [Reflexivity | Elim n; Elim H0; Intros; Assumption | Elim n; Left; Assumption | Elim n0; Left; Assumption].
-Simpl; Simpl in H13; Rewrite H13; Reflexivity.
-Intros; Simpl in H; Unfold constant_D_eq open_interval; Intros; Induction i.
-Simpl; Assert H17 := (H10 O); Assert H18 : (lt (0) (pred (Rlength (cons r (cons r1 r2))))).
-Simpl; Apply lt_O_Sn.
-Apply (H17 H18); Unfold open_interval; Simpl; Simpl in H4; Elim H4; Clear H4; Intros; Split; Try Assumption; Replace r1 with r4.
-Assumption.
-Simpl in H12; Rewrite H12; Unfold Rmin; Case (total_order_Rle r1 c); Intro; [Reflexivity | Elim n; Left; Assumption].
-Clear Hreci; Simpl; Apply H15.
-Simpl; Apply lt_S_n; Assumption.
-Unfold open_interval; Apply H4.
-Split.
-Left; Assumption.
-Elim H0; Intros; Assumption.
-EApply StepFun_P7; [Elim H0; Intros; Apply Rle_trans with c; [Apply H2 | Apply H3] | Apply H].
+Lemma StepFun_P44 :
+ forall (f:R -> R) (a b c:R),
+ IsStepFun f a b -> a <= c <= b -> IsStepFun f a c.
+intros f; intros; assert (H0 : a <= b).
+elim H; intros; apply Rle_trans with c; assumption.
+elim H; clear H; intros; unfold IsStepFun in X; unfold is_subdivision in X;
+ elim X; clear X; intros l1 [lf1 H2];
+ cut
+ (forall (l1 lf1:Rlist) (a b c:R) (f:R -> R),
+ adapted_couple f a b l1 lf1 ->
+ a <= c <= b ->
+ sigT (fun l:Rlist => sigT (fun l0:Rlist => adapted_couple f a c l l0))).
+intros; unfold IsStepFun in |- *; unfold is_subdivision in |- *; eapply X.
+apply H2.
+split; assumption.
+clear f a b c H0 H H1 H2 l1 lf1; simple induction l1.
+intros; unfold adapted_couple in H; decompose [and] H; clear H; simpl in H4;
+ discriminate.
+simple induction r0.
+intros; assert (H1 : a = b).
+unfold adapted_couple in H; decompose [and] H; clear H; simpl in H3;
+ simpl in H2; assert (H7 : a <= b).
+elim H0; intros; apply Rle_trans with c; assumption.
+replace a with (Rmin a b).
+pattern b at 2 in |- *; replace b with (Rmax a b).
+rewrite <- H2; rewrite H3; reflexivity.
+unfold Rmax in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n; assumption ].
+unfold Rmin in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n; assumption ].
+split with (cons r nil); split with lf1; assert (H2 : c = b).
+rewrite H1 in H0; elim H0; intros; apply Rle_antisym; assumption.
+rewrite H2; assumption.
+intros; clear X; induction lf1 as [| r3 lf1 Hreclf1].
+unfold adapted_couple in H; decompose [and] H; clear H; simpl in H4;
+ discriminate.
+clear Hreclf1; assert (H1 : {c <= r1} + {r1 < c}).
+case (Rle_dec c r1); intro; [ left; assumption | right; auto with real ].
+elim H1; intro.
+split with (cons r (cons c nil)); split with (cons r3 nil);
+ unfold adapted_couple in H; decompose [and] H; clear H;
+ assert (H6 : r = a).
+simpl in H4; rewrite H4; unfold Rmin in |- *; case (Rle_dec a b); intro;
+ [ reflexivity
+ | elim n; elim H0; intros; apply Rle_trans with c; assumption ].
+elim H0; clear H0; intros; unfold adapted_couple in |- *; repeat split.
+rewrite H6; unfold ordered_Rlist in |- *; intros; simpl in H8; inversion H8;
+ [ simpl in |- *; assumption | elim (le_Sn_O _ H10) ].
+simpl in |- *; unfold Rmin in |- *; case (Rle_dec a c); intro;
+ [ assumption | elim n; assumption ].
+simpl in |- *; unfold Rmax in |- *; case (Rle_dec a c); intro;
+ [ reflexivity | elim n; assumption ].
+unfold constant_D_eq, open_interval in |- *; intros; simpl in H8;
+ inversion H8.
+simpl in |- *; assert (H10 := H7 0%nat);
+ assert (H12 : (0 < pred (Rlength (cons r (cons r1 r2))))%nat).
+simpl in |- *; apply lt_O_Sn.
+apply (H10 H12); unfold open_interval in |- *; simpl in |- *;
+ rewrite H11 in H9; simpl in H9; elim H9; clear H9;
+ intros; split; try assumption.
+apply Rlt_le_trans with c; assumption.
+elim (le_Sn_O _ H11).
+cut (adapted_couple f r1 b (cons r1 r2) lf1).
+cut (r1 <= c <= b).
+intros.
+elim (X0 _ _ _ _ _ H3 H2); intros l1' [lf1' H4]; split with (cons r l1');
+ split with (cons r3 lf1'); unfold adapted_couple in H, H4;
+ decompose [and] H; decompose [and] H4; clear H H4 X0;
+ assert (H14 : a <= b).
+elim H0; intros; apply Rle_trans with c; assumption.
+assert (H16 : r = a).
+simpl in H7; rewrite H7; unfold Rmin in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n; assumption ].
+induction l1' as [| r4 l1' Hrecl1'].
+simpl in H13; discriminate.
+clear Hrecl1'; unfold adapted_couple in |- *; repeat split.
+unfold ordered_Rlist in |- *; intros; simpl in H; induction i as [| i Hreci].
+simpl in |- *; replace r4 with r1.
+apply (H5 0%nat).
+simpl in |- *; apply lt_O_Sn.
+simpl in H12; rewrite H12; unfold Rmin in |- *; case (Rle_dec r1 c); intro;
+ [ reflexivity | elim n; left; assumption ].
+apply (H9 i); simpl in |- *; apply lt_S_n; assumption.
+simpl in |- *; unfold Rmin in |- *; case (Rle_dec a c); intro;
+ [ assumption | elim n; elim H0; intros; assumption ].
+replace (Rmax a c) with (Rmax r1 c).
+rewrite <- H11; reflexivity.
+unfold Rmax in |- *; case (Rle_dec r1 c); case (Rle_dec a c); intros;
+ [ reflexivity
+ | elim n; elim H0; intros; assumption
+ | elim n; left; assumption
+ | elim n0; left; assumption ].
+simpl in |- *; simpl in H13; rewrite H13; reflexivity.
+intros; simpl in H; unfold constant_D_eq, open_interval in |- *; intros;
+ induction i as [| i Hreci].
+simpl in |- *; assert (H17 := H10 0%nat);
+ assert (H18 : (0 < pred (Rlength (cons r (cons r1 r2))))%nat).
+simpl in |- *; apply lt_O_Sn.
+apply (H17 H18); unfold open_interval in |- *; simpl in |- *; simpl in H4;
+ elim H4; clear H4; intros; split; try assumption;
+ replace r1 with r4.
+assumption.
+simpl in H12; rewrite H12; unfold Rmin in |- *; case (Rle_dec r1 c); intro;
+ [ reflexivity | elim n; left; assumption ].
+clear Hreci; simpl in |- *; apply H15.
+simpl in |- *; apply lt_S_n; assumption.
+unfold open_interval in |- *; apply H4.
+split.
+left; assumption.
+elim H0; intros; assumption.
+eapply StepFun_P7;
+ [ elim H0; intros; apply Rle_trans with c; [ apply H2 | apply H3 ]
+ | apply H ].
Qed.
-Lemma StepFun_P45 : (f:R->R;a,b,c:R) (IsStepFun f a b) -> ``a<=c<=b`` -> (IsStepFun f c b).
-Intros f; Intros; Assert H0 : ``a<=b``.
-Elim H; Intros; Apply Rle_trans with c; Assumption.
-Elim H; Clear H; Intros; Unfold IsStepFun in X; Unfold is_subdivision in X; Elim X; Clear X; Intros l1 [lf1 H2]; Cut (l1,lf1:Rlist;a,b,c:R;f:R->R) (adapted_couple f a b l1 lf1) -> ``a<=c<=b`` -> (SigT ? [l:Rlist](sigTT ? [l0:Rlist](adapted_couple f c b l l0))).
-Intros; Unfold IsStepFun; Unfold is_subdivision; EApply X; [Apply H2 | Split; Assumption].
-Clear f a b c H0 H H1 H2 l1 lf1; Induction l1.
-Intros; Unfold adapted_couple in H; Decompose [and] H; Clear H; Simpl in H4; Discriminate.
-Induction r0.
-Intros; Assert H1 : ``a==b``.
-Unfold adapted_couple in H; Decompose [and] H; Clear H; Simpl in H3; Simpl in H2; Assert H7 : ``a<=b``.
-Elim H0; Intros; Apply Rle_trans with c; Assumption.
-Replace a with (Rmin a b).
-Pattern 2 b; Replace b with (Rmax a b).
-Rewrite <- H2; Rewrite H3; Reflexivity.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Split with (cons r nil); Split with lf1; Assert H2 : ``c==b``.
-Rewrite H1 in H0; Elim H0; Intros; Apply Rle_antisym; Assumption.
-Rewrite <- H2 in H1; Rewrite <- H1; Assumption.
-Intros; Clear X; Induction lf1.
-Unfold adapted_couple in H; Decompose [and] H; Clear H; Simpl in H4; Discriminate.
-Clear Hreclf1; Assert H1 : (sumboolT ``c<=r1`` ``r1<c``).
-Case (total_order_Rle c r1); Intro; [Left; Assumption | Right; Auto with real].
-Elim H1; Intro.
-Split with (cons c (cons r1 r2)); Split with (cons r3 lf1); Unfold adapted_couple in H; Decompose [and] H; Clear H; Unfold adapted_couple; Repeat Split.
-Unfold ordered_Rlist; Intros; Simpl in H; Induction i.
-Simpl; Assumption.
-Clear Hreci; Apply (H2 (S i)); Simpl; Assumption.
-Simpl; Unfold Rmin; Case (total_order_Rle c b); Intro; [Reflexivity | Elim n; Elim H0; Intros; Assumption].
-Replace (Rmax c b) with (Rmax a b).
-Rewrite <- H3; Reflexivity.
-Unfold Rmax; Case (total_order_Rle a b); Case (total_order_Rle c b); Intros; [Reflexivity | Elim n; Elim H0; Intros; Assumption | Elim n; Elim H0; Intros; Apply Rle_trans with c; Assumption | Elim n0; Elim H0; Intros; Apply Rle_trans with c; Assumption].
-Simpl; Simpl in H5; Apply H5.
-Intros; Simpl in H; Induction i.
-Unfold constant_D_eq open_interval; Intros; Simpl; Apply (H7 O).
-Simpl; Apply lt_O_Sn.
-Unfold open_interval; Simpl; Simpl in H6; Elim H6; Clear H6; Intros; Split; Try Assumption; Apply Rle_lt_trans with c; Try Assumption; Replace r with a.
-Elim H0; Intros; Assumption.
-Simpl in H4; Rewrite H4; Unfold Rmin; Case (total_order_Rle a b); Intros; [Reflexivity | Elim n; Elim H0; Intros; Apply Rle_trans with c; Assumption].
-Clear Hreci; Apply (H7 (S i)); Simpl; Assumption.
-Cut (adapted_couple f r1 b (cons r1 r2) lf1).
-Cut ``r1<=c<=b``.
-Intros; Elim (X0 ? ? ? ? ? H3 H2); Intros l1' [lf1' H4]; Split with l1'; Split with lf1'; Assumption.
-Split; [Left; Assumption | Elim H0; Intros; Assumption].
-EApply StepFun_P7; [Elim H0; Intros; Apply Rle_trans with c; [Apply H2 | Apply H3] | Apply H].
+Lemma StepFun_P45 :
+ forall (f:R -> R) (a b c:R),
+ IsStepFun f a b -> a <= c <= b -> IsStepFun f c b.
+intros f; intros; assert (H0 : a <= b).
+elim H; intros; apply Rle_trans with c; assumption.
+elim H; clear H; intros; unfold IsStepFun in X; unfold is_subdivision in X;
+ elim X; clear X; intros l1 [lf1 H2];
+ cut
+ (forall (l1 lf1:Rlist) (a b c:R) (f:R -> R),
+ adapted_couple f a b l1 lf1 ->
+ a <= c <= b ->
+ sigT (fun l:Rlist => sigT (fun l0:Rlist => adapted_couple f c b l l0))).
+intros; unfold IsStepFun in |- *; unfold is_subdivision in |- *; eapply X;
+ [ apply H2 | split; assumption ].
+clear f a b c H0 H H1 H2 l1 lf1; simple induction l1.
+intros; unfold adapted_couple in H; decompose [and] H; clear H; simpl in H4;
+ discriminate.
+simple induction r0.
+intros; assert (H1 : a = b).
+unfold adapted_couple in H; decompose [and] H; clear H; simpl in H3;
+ simpl in H2; assert (H7 : a <= b).
+elim H0; intros; apply Rle_trans with c; assumption.
+replace a with (Rmin a b).
+pattern b at 2 in |- *; replace b with (Rmax a b).
+rewrite <- H2; rewrite H3; reflexivity.
+unfold Rmax in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n; assumption ].
+unfold Rmin in |- *; case (Rle_dec a b); intro;
+ [ reflexivity | elim n; assumption ].
+split with (cons r nil); split with lf1; assert (H2 : c = b).
+rewrite H1 in H0; elim H0; intros; apply Rle_antisym; assumption.
+rewrite <- H2 in H1; rewrite <- H1; assumption.
+intros; clear X; induction lf1 as [| r3 lf1 Hreclf1].
+unfold adapted_couple in H; decompose [and] H; clear H; simpl in H4;
+ discriminate.
+clear Hreclf1; assert (H1 : {c <= r1} + {r1 < c}).
+case (Rle_dec c r1); intro; [ left; assumption | right; auto with real ].
+elim H1; intro.
+split with (cons c (cons r1 r2)); split with (cons r3 lf1);
+ unfold adapted_couple in H; decompose [and] H; clear H;
+ unfold adapted_couple in |- *; repeat split.
+unfold ordered_Rlist in |- *; intros; simpl in H; induction i as [| i Hreci].
+simpl in |- *; assumption.
+clear Hreci; apply (H2 (S i)); simpl in |- *; assumption.
+simpl in |- *; unfold Rmin in |- *; case (Rle_dec c b); intro;
+ [ reflexivity | elim n; elim H0; intros; assumption ].
+replace (Rmax c b) with (Rmax a b).
+rewrite <- H3; reflexivity.
+unfold Rmax in |- *; case (Rle_dec a b); case (Rle_dec c b); intros;
+ [ reflexivity
+ | elim n; elim H0; intros; assumption
+ | elim n; elim H0; intros; apply Rle_trans with c; assumption
+ | elim n0; elim H0; intros; apply Rle_trans with c; assumption ].
+simpl in |- *; simpl in H5; apply H5.
+intros; simpl in H; induction i as [| i Hreci].
+unfold constant_D_eq, open_interval in |- *; intros; simpl in |- *;
+ apply (H7 0%nat).
+simpl in |- *; apply lt_O_Sn.
+unfold open_interval in |- *; simpl in |- *; simpl in H6; elim H6; clear H6;
+ intros; split; try assumption; apply Rle_lt_trans with c;
+ try assumption; replace r with a.
+elim H0; intros; assumption.
+simpl in H4; rewrite H4; unfold Rmin in |- *; case (Rle_dec a b); intros;
+ [ reflexivity
+ | elim n; elim H0; intros; apply Rle_trans with c; assumption ].
+clear Hreci; apply (H7 (S i)); simpl in |- *; assumption.
+cut (adapted_couple f r1 b (cons r1 r2) lf1).
+cut (r1 <= c <= b).
+intros; elim (X0 _ _ _ _ _ H3 H2); intros l1' [lf1' H4]; split with l1';
+ split with lf1'; assumption.
+split; [ left; assumption | elim H0; intros; assumption ].
+eapply StepFun_P7;
+ [ elim H0; intros; apply Rle_trans with c; [ apply H2 | apply H3 ]
+ | apply H ].
Qed.
-Lemma StepFun_P46 : (f:R->R;a,b,c:R) (IsStepFun f a b) -> (IsStepFun f b c) -> (IsStepFun f a c).
-Intros f; Intros; Case (total_order_Rle a b); Case (total_order_Rle b c); Intros.
-Apply StepFun_P41 with b; Assumption.
-Case (total_order_Rle a c); Intro.
-Apply StepFun_P44 with b; Try Assumption.
-Split; [Assumption | Auto with real].
-Apply StepFun_P6; Apply StepFun_P44 with b.
-Apply StepFun_P6; Assumption.
-Split; Auto with real.
-Case (total_order_Rle a c); Intro.
-Apply StepFun_P45 with b; Try Assumption.
-Split; Auto with real.
-Apply StepFun_P6; Apply StepFun_P45 with b.
-Apply StepFun_P6; Assumption.
-Split; [Assumption | Auto with real].
-Apply StepFun_P6; Apply StepFun_P41 with b; Auto with real Orelse Apply StepFun_P6; Assumption.
-Qed.
+Lemma StepFun_P46 :
+ forall (f:R -> R) (a b c:R),
+ IsStepFun f a b -> IsStepFun f b c -> IsStepFun f a c.
+intros f; intros; case (Rle_dec a b); case (Rle_dec b c); intros.
+apply StepFun_P41 with b; assumption.
+case (Rle_dec a c); intro.
+apply StepFun_P44 with b; try assumption.
+split; [ assumption | auto with real ].
+apply StepFun_P6; apply StepFun_P44 with b.
+apply StepFun_P6; assumption.
+split; auto with real.
+case (Rle_dec a c); intro.
+apply StepFun_P45 with b; try assumption.
+split; auto with real.
+apply StepFun_P6; apply StepFun_P45 with b.
+apply StepFun_P6; assumption.
+split; [ assumption | auto with real ].
+apply StepFun_P6; apply StepFun_P41 with b;
+ auto with real || apply StepFun_P6; assumption.
+Qed. \ No newline at end of file
diff --git a/theories/Reals/Rlimit.v b/theories/Reals/Rlimit.v
index 6ad02e50c..5fb50822b 100644
--- a/theories/Reals/Rlimit.v
+++ b/theories/Reals/Rlimit.v
@@ -13,136 +13,124 @@
(* *)
(*********************************************************)
-Require Rbase.
-Require Rfunctions.
-Require Classical_Prop.
-Require Fourier.
-V7only [Import R_scope.]. Open Local Scope R_scope.
+Require Import Rbase.
+Require Import Rfunctions.
+Require Import Classical_Prop.
+Require Import Fourier. Open Local Scope R_scope.
(*******************************)
(* Calculus *)
(*******************************)
(*********)
-Lemma eps2_Rgt_R0:(eps:R)(Rgt eps R0)->
- (Rgt (Rmult eps (Rinv (Rplus R1 R1))) R0).
-Intros;Fourier.
+Lemma eps2_Rgt_R0 : forall eps:R, eps > 0 -> eps * / 2 > 0.
+intros; fourier.
Qed.
(*********)
-Lemma eps2:(eps:R)(Rplus (Rmult eps (Rinv (Rplus R1 R1)))
- (Rmult eps (Rinv (Rplus R1 R1))))==eps.
-Intro esp.
-Assert H := (double_var esp).
-Unfold Rdiv in H.
-Symmetry; Exact H.
+Lemma eps2 : forall eps:R, eps * / 2 + eps * / 2 = eps.
+intro esp.
+assert (H := double_var esp).
+unfold Rdiv in H.
+symmetry in |- *; exact H.
Qed.
(*********)
-Lemma eps4:(eps:R)
- (Rplus (Rmult eps (Rinv (Rplus (Rplus R1 R1) (Rplus R1 R1) )))
- (Rmult eps (Rinv (Rplus (Rplus R1 R1) (Rplus R1 R1) ))))==
- (Rmult eps (Rinv (Rplus R1 R1))).
-Intro eps.
-Replace ``2+2`` with ``2*2``.
-Pattern 3 eps; Rewrite double_var.
-Rewrite (Rmult_Rplus_distrl ``eps/2`` ``eps/2`` ``/2``).
-Unfold Rdiv.
-Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_Rmult.
-Reflexivity.
-DiscrR.
-DiscrR.
-Ring.
+Lemma eps4 : forall eps:R, eps * / (2 + 2) + eps * / (2 + 2) = eps * / 2.
+intro eps.
+replace (2 + 2) with 4.
+pattern eps at 3 in |- *; rewrite double_var.
+rewrite (Rmult_plus_distr_r (eps / 2) (eps / 2) (/ 2)).
+unfold Rdiv in |- *.
+repeat rewrite Rmult_assoc.
+rewrite <- Rinv_mult_distr.
+reflexivity.
+discrR.
+discrR.
+ring.
Qed.
(*********)
-Lemma Rlt_eps2_eps:(eps:R)(Rgt eps R0)->
- (Rlt (Rmult eps (Rinv (Rplus R1 R1))) eps).
-Intros.
-Pattern 2 eps; Rewrite <- Rmult_1r.
-Repeat Rewrite (Rmult_sym eps).
-Apply Rlt_monotony_r.
-Exact H.
-Apply Rlt_monotony_contra with ``2``.
-Fourier.
-Rewrite Rmult_1r; Rewrite <- Rinv_r_sym.
-Fourier.
-DiscrR.
+Lemma Rlt_eps2_eps : forall eps:R, eps > 0 -> eps * / 2 < eps.
+intros.
+pattern eps at 2 in |- *; rewrite <- Rmult_1_r.
+repeat rewrite (Rmult_comm eps).
+apply Rmult_lt_compat_r.
+exact H.
+apply Rmult_lt_reg_l with 2.
+fourier.
+rewrite Rmult_1_r; rewrite <- Rinv_r_sym.
+fourier.
+discrR.
Qed.
(*********)
-Lemma Rlt_eps4_eps:(eps:R)(Rgt eps R0)->
- (Rlt (Rmult eps (Rinv (Rplus (Rplus R1 R1) (Rplus R1 R1)))) eps).
-Intros.
-Replace ``2+2`` with ``4``.
-Pattern 2 eps; Rewrite <- Rmult_1r.
-Repeat Rewrite (Rmult_sym eps).
-Apply Rlt_monotony_r.
-Exact H.
-Apply Rlt_monotony_contra with ``4``.
-Replace ``4`` with ``2*2``.
-Apply Rmult_lt_pos; Fourier.
-Ring.
-Rewrite Rmult_1r; Rewrite <- Rinv_r_sym.
-Fourier.
-DiscrR.
-Ring.
+Lemma Rlt_eps4_eps : forall eps:R, eps > 0 -> eps * / (2 + 2) < eps.
+intros.
+replace (2 + 2) with 4.
+pattern eps at 2 in |- *; rewrite <- Rmult_1_r.
+repeat rewrite (Rmult_comm eps).
+apply Rmult_lt_compat_r.
+exact H.
+apply Rmult_lt_reg_l with 4.
+replace 4 with 4.
+apply Rmult_lt_0_compat; fourier.
+ring.
+rewrite Rmult_1_r; rewrite <- Rinv_r_sym.
+fourier.
+discrR.
+ring.
Qed.
(*********)
-Lemma prop_eps:(r:R)((eps:R)(Rgt eps R0)->(Rlt r eps))->(Rle r R0).
-Intros;Elim (total_order r R0); Intro.
-Apply Rlt_le; Assumption.
-Elim H0; Intro.
-Apply eq_Rle; Assumption.
-Clear H0;Generalize (H r H1); Intro;Generalize (Rlt_antirefl r);
- Intro;ElimType False; Auto.
+Lemma prop_eps : forall r:R, (forall eps:R, eps > 0 -> r < eps) -> r <= 0.
+intros; elim (Rtotal_order r 0); intro.
+apply Rlt_le; assumption.
+elim H0; intro.
+apply Req_le; assumption.
+clear H0; generalize (H r H1); intro; generalize (Rlt_irrefl r); intro;
+ elimtype False; auto.
Qed.
(*********)
-Definition mul_factor := [l,l':R](Rinv (Rplus R1 (Rplus (Rabsolu l)
- (Rabsolu l')))).
+Definition mul_factor (l l':R) := / (1 + (Rabs l + Rabs l')).
(*********)
-Lemma mul_factor_wd : (l,l':R)
- ~(Rplus R1 (Rplus (Rabsolu l) (Rabsolu l')))==R0.
-Intros;Rewrite (Rplus_sym R1 (Rplus (Rabsolu l) (Rabsolu l')));
- Apply tech_Rplus.
-Cut (Rle (Rabsolu (Rplus l l')) (Rplus (Rabsolu l) (Rabsolu l'))).
-Cut (Rle R0 (Rabsolu (Rplus l l'))).
-Exact (Rle_trans ? ? ?).
-Exact (Rabsolu_pos (Rplus l l')).
-Exact (Rabsolu_triang ? ?).
-Exact Rlt_R0_R1.
+Lemma mul_factor_wd : forall l l':R, 1 + (Rabs l + Rabs l') <> 0.
+intros; rewrite (Rplus_comm 1 (Rabs l + Rabs l')); apply tech_Rplus.
+cut (Rabs (l + l') <= Rabs l + Rabs l').
+cut (0 <= Rabs (l + l')).
+exact (Rle_trans _ _ _).
+exact (Rabs_pos (l + l')).
+exact (Rabs_triang _ _).
+exact Rlt_0_1.
Qed.
(*********)
-Lemma mul_factor_gt:(eps:R)(l,l':R)(Rgt eps R0)->
- (Rgt (Rmult eps (mul_factor l l')) R0).
-Intros;Unfold Rgt;Rewrite <- (Rmult_Or eps);Apply Rlt_monotony.
-Assumption.
-Unfold mul_factor;Apply Rlt_Rinv;
- Cut (Rle R1 (Rplus R1 (Rplus (Rabsolu l) (Rabsolu l')))).
-Cut (Rlt R0 R1).
-Exact (Rlt_le_trans ? ? ?).
-Exact Rlt_R0_R1.
-Replace (Rle R1 (Rplus R1 (Rplus (Rabsolu l) (Rabsolu l'))))
- with (Rle (Rplus R1 R0) (Rplus R1 (Rplus (Rabsolu l) (Rabsolu l')))).
-Apply Rle_compatibility.
-Cut (Rle (Rabsolu (Rplus l l')) (Rplus (Rabsolu l) (Rabsolu l'))).
-Cut (Rle R0 (Rabsolu (Rplus l l'))).
-Exact (Rle_trans ? ? ?).
-Exact (Rabsolu_pos ?).
-Exact (Rabsolu_triang ? ?).
-Rewrite (proj1 ? ? (Rplus_ne R1));Trivial.
+Lemma mul_factor_gt : forall eps l l':R, eps > 0 -> eps * mul_factor l l' > 0.
+intros; unfold Rgt in |- *; rewrite <- (Rmult_0_r eps);
+ apply Rmult_lt_compat_l.
+assumption.
+unfold mul_factor in |- *; apply Rinv_0_lt_compat;
+ cut (1 <= 1 + (Rabs l + Rabs l')).
+cut (0 < 1).
+exact (Rlt_le_trans _ _ _).
+exact Rlt_0_1.
+replace (1 <= 1 + (Rabs l + Rabs l')) with (1 + 0 <= 1 + (Rabs l + Rabs l')).
+apply Rplus_le_compat_l.
+cut (Rabs (l + l') <= Rabs l + Rabs l').
+cut (0 <= Rabs (l + l')).
+exact (Rle_trans _ _ _).
+exact (Rabs_pos _).
+exact (Rabs_triang _ _).
+rewrite (proj1 (Rplus_ne 1)); trivial.
Qed.
(*********)
-Lemma mul_factor_gt_f:(eps:R)(l,l':R)(Rgt eps R0)->
- (Rgt (Rmin R1 (Rmult eps (mul_factor l l'))) R0).
-Intros;Apply Rmin_Rgt_r;Split.
-Exact Rlt_R0_R1.
-Exact (mul_factor_gt eps l l' H).
+Lemma mul_factor_gt_f :
+ forall eps l l':R, eps > 0 -> Rmin 1 (eps * mul_factor l l') > 0.
+intros; apply Rmin_Rgt_r; split.
+exact Rlt_0_1.
+exact (mul_factor_gt eps l l' H).
Qed.
@@ -151,389 +139,419 @@ Qed.
(*******************************)
(*********)
-Record Metric_Space:Type:= {
- Base:Type;
- dist:Base->Base->R;
- dist_pos:(x,y:Base)(Rge (dist x y) R0);
- dist_sym:(x,y:Base)(dist x y)==(dist y x);
- dist_refl:(x,y:Base)((dist x y)==R0<->x==y);
- dist_tri:(x,y,z:Base)(Rle (dist x y)
- (Rplus (dist x z) (dist z y))) }.
+Record Metric_Space : Type :=
+ {Base : Type;
+ dist : Base -> Base -> R;
+ dist_pos : forall x y:Base, dist x y >= 0;
+ dist_sym : forall x y:Base, dist x y = dist y x;
+ dist_refl : forall x y:Base, dist x y = 0 <-> x = y;
+ dist_tri : forall x y z:Base, dist x y <= dist x z + dist z y}.
(*******************************)
(* Limit in Metric space *)
(*******************************)
(*********)
-Definition limit_in:=
- [X:Metric_Space; X':Metric_Space; f:(Base X)->(Base X');
- D:(Base X)->Prop; x0:(Base X); l:(Base X')]
- (eps:R)(Rgt eps R0)->
- (EXT alp:R | (Rgt alp R0)/\(x:(Base X))(D x)/\
- (Rlt (dist X x x0) alp)->
- (Rlt (dist X' (f x) l) eps)).
+Definition limit_in (X X':Metric_Space) (f:Base X -> Base X')
+ (D:Base X -> Prop) (x0:Base X) (l:Base X') :=
+ forall eps:R,
+ eps > 0 ->
+ exists alp : R
+ | alp > 0 /\
+ (forall x:Base X, D x /\ dist X x x0 < alp -> dist X' (f x) l < eps).
(*******************************)
(* R is a metric space *)
(*******************************)
(*********)
-Definition R_met:Metric_Space:=(Build_Metric_Space R R_dist
- R_dist_pos R_dist_sym R_dist_refl R_dist_tri).
+Definition R_met : Metric_Space :=
+ Build_Metric_Space R R_dist R_dist_pos R_dist_sym R_dist_refl R_dist_tri.
(*******************************)
(* Limit 1 arg *)
(*******************************)
(*********)
-Definition Dgf:=[Df,Dg:R->Prop][f:R->R][x:R](Df x)/\(Dg (f x)).
+Definition Dgf (Df Dg:R -> Prop) (f:R -> R) (x:R) := Df x /\ Dg (f x).
(*********)
-Definition limit1_in:(R->R)->(R->Prop)->R->R->Prop:=
- [f:R->R; D:R->Prop; l:R; x0:R](limit_in R_met R_met f D x0 l).
+Definition limit1_in (f:R -> R) (D:R -> Prop) (l x0:R) : Prop :=
+ limit_in R_met R_met f D x0 l.
(*********)
-Lemma tech_limit:(f:R->R)(D:R->Prop)(l:R)(x0:R)(D x0)->
- (limit1_in f D l x0)->l==(f x0).
-Intros f D l x0 H H0.
-Case (Rabsolu_pos (Rminus (f x0) l)); Intros H1.
-Absurd (Rlt (dist R_met (f x0) l) (dist R_met (f x0) l)).
-Apply Rlt_antirefl.
-Case (H0 (dist R_met (f x0) l)); Auto.
-Intros alpha1 (H2, H3); Apply H3; Auto; Split; Auto.
-Case (dist_refl R_met x0 x0); Intros Hr1 Hr2; Rewrite Hr2; Auto.
-Case (dist_refl R_met (f x0) l); Intros Hr1 Hr2; Apply sym_eqT; Auto.
+Lemma tech_limit :
+ forall (f:R -> R) (D:R -> Prop) (l x0:R),
+ D x0 -> limit1_in f D l x0 -> l = f x0.
+intros f D l x0 H H0.
+case (Rabs_pos (f x0 - l)); intros H1.
+absurd (dist R_met (f x0) l < dist R_met (f x0) l).
+apply Rlt_irrefl.
+case (H0 (dist R_met (f x0) l)); auto.
+intros alpha1 [H2 H3]; apply H3; auto; split; auto.
+case (dist_refl R_met x0 x0); intros Hr1 Hr2; rewrite Hr2; auto.
+case (dist_refl R_met (f x0) l); intros Hr1 Hr2; apply sym_eq; auto.
Qed.
(*********)
-Lemma tech_limit_contr:(f:R->R)(D:R->Prop)(l:R)(x0:R)(D x0)->~l==(f x0)
- ->~(limit1_in f D l x0).
-Intros;Generalize (tech_limit f D l x0);Tauto.
+Lemma tech_limit_contr :
+ forall (f:R -> R) (D:R -> Prop) (l x0:R),
+ D x0 -> l <> f x0 -> ~ limit1_in f D l x0.
+intros; generalize (tech_limit f D l x0); tauto.
Qed.
(*********)
-Lemma lim_x:(D:R->Prop)(x0:R)(limit1_in [x:R]x D x0 x0).
-Unfold limit1_in; Unfold limit_in; Simpl; Intros;Split with eps;
- Split; Auto;Intros;Elim H0; Intros; Auto.
+Lemma lim_x : forall (D:R -> Prop) (x0:R), limit1_in (fun x:R => x) D x0 x0.
+unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; intros;
+ split with eps; split; auto; intros; elim H0; intros;
+ auto.
Qed.
(*********)
-Lemma limit_plus:(f,g:R->R)(D:R->Prop)(l,l':R)(x0:R)
- (limit1_in f D l x0)->(limit1_in g D l' x0)->
- (limit1_in [x:R](Rplus (f x) (g x)) D (Rplus l l') x0).
-Intros;Unfold limit1_in; Unfold limit_in; Simpl; Intros;
- Elim (H (Rmult eps (Rinv (Rplus R1 R1))) (eps2_Rgt_R0 eps H1));
- Elim (H0 (Rmult eps (Rinv (Rplus R1 R1))) (eps2_Rgt_R0 eps H1));
- Simpl;Clear H H0; Intros; Elim H; Elim H0; Clear H H0; Intros;
- Split with (Rmin x1 x); Split.
-Exact (Rmin_Rgt_r x1 x R0 (conj ? ? H H2)).
-Intros;Elim H4; Clear H4; Intros;
- Cut (Rlt (Rplus (R_dist (f x2) l) (R_dist (g x2) l')) eps).
- Cut (Rle (R_dist (Rplus (f x2) (g x2)) (Rplus l l'))
- (Rplus (R_dist (f x2) l) (R_dist (g x2) l'))).
-Exact (Rle_lt_trans ? ? ?).
-Exact (R_dist_plus ? ? ? ?).
-Elim (Rmin_Rgt_l x1 x (R_dist x2 x0) H5); Clear H5; Intros.
-Generalize (H3 x2 (conj (D x2) (Rlt (R_dist x2 x0) x) H4 H6));
- Generalize (H0 x2 (conj (D x2) (Rlt (R_dist x2 x0) x1) H4 H5));
- Intros;
- Replace eps
- with (Rplus (Rmult eps (Rinv (Rplus R1 R1)))
- (Rmult eps (Rinv (Rplus R1 R1)))).
-Exact (Rplus_lt ? ? ? ? H7 H8).
-Exact (eps2 eps).
+Lemma limit_plus :
+ forall (f g:R -> R) (D:R -> Prop) (l l' x0:R),
+ limit1_in f D l x0 ->
+ limit1_in g D l' x0 -> limit1_in (fun x:R => f x + g x) D (l + l') x0.
+intros; unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *;
+ intros; elim (H (eps * / 2) (eps2_Rgt_R0 eps H1));
+ elim (H0 (eps * / 2) (eps2_Rgt_R0 eps H1)); simpl in |- *;
+ clear H H0; intros; elim H; elim H0; clear H H0; intros;
+ split with (Rmin x1 x); split.
+exact (Rmin_Rgt_r x1 x 0 (conj H H2)).
+intros; elim H4; clear H4; intros;
+ cut (R_dist (f x2) l + R_dist (g x2) l' < eps).
+ cut (R_dist (f x2 + g x2) (l + l') <= R_dist (f x2) l + R_dist (g x2) l').
+exact (Rle_lt_trans _ _ _).
+exact (R_dist_plus _ _ _ _).
+elim (Rmin_Rgt_l x1 x (R_dist x2 x0) H5); clear H5; intros.
+generalize (H3 x2 (conj H4 H6)); generalize (H0 x2 (conj H4 H5)); intros;
+ replace eps with (eps * / 2 + eps * / 2).
+exact (Rplus_lt_compat _ _ _ _ H7 H8).
+exact (eps2 eps).
Qed.
(*********)
-Lemma limit_Ropp:(f:R->R)(D:R->Prop)(l:R)(x0:R)
- (limit1_in f D l x0)->(limit1_in [x:R](Ropp (f x)) D (Ropp l) x0).
-Unfold limit1_in;Unfold limit_in;Simpl;Intros;Elim (H eps H0);Clear H;
- Intros;Elim H;Clear H;Intros;Split with x;Split;Auto;Intros;
- Generalize (H1 x1 H2);Clear H1;Intro;Unfold R_dist;Unfold Rminus;
- Rewrite (Ropp_Ropp l);Rewrite (Rplus_sym (Ropp (f x1)) l);
- Fold (Rminus l (f x1));Fold (R_dist l (f x1));Rewrite R_dist_sym;
- Assumption.
+Lemma limit_Ropp :
+ forall (f:R -> R) (D:R -> Prop) (l x0:R),
+ limit1_in f D l x0 -> limit1_in (fun x:R => - f x) D (- l) x0.
+unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; intros;
+ elim (H eps H0); clear H; intros; elim H; clear H;
+ intros; split with x; split; auto; intros; generalize (H1 x1 H2);
+ clear H1; intro; unfold R_dist in |- *; unfold Rminus in |- *;
+ rewrite (Ropp_involutive l); rewrite (Rplus_comm (- f x1) l);
+ fold (l - f x1) in |- *; fold (R_dist l (f x1)) in |- *;
+ rewrite R_dist_sym; assumption.
Qed.
(*********)
-Lemma limit_minus:(f,g:R->R)(D:R->Prop)(l,l':R)(x0:R)
- (limit1_in f D l x0)->(limit1_in g D l' x0)->
- (limit1_in [x:R](Rminus (f x) (g x)) D (Rminus l l') x0).
-Intros;Unfold Rminus;Generalize (limit_Ropp g D l' x0 H0);Intro;
- Exact (limit_plus f [x:R](Ropp (g x)) D l (Ropp l') x0 H H1).
+Lemma limit_minus :
+ forall (f g:R -> R) (D:R -> Prop) (l l' x0:R),
+ limit1_in f D l x0 ->
+ limit1_in g D l' x0 -> limit1_in (fun x:R => f x - g x) D (l - l') x0.
+intros; unfold Rminus in |- *; generalize (limit_Ropp g D l' x0 H0); intro;
+ exact (limit_plus f (fun x:R => - g x) D l (- l') x0 H H1).
Qed.
(*********)
-Lemma limit_free:(f:R->R)(D:R->Prop)(x:R)(x0:R)
- (limit1_in [h:R](f x) D (f x) x0).
-Unfold limit1_in;Unfold limit_in;Simpl;Intros;Split with eps;Split;
- Auto;Intros;Elim (R_dist_refl (f x) (f x));Intros a b;
- Rewrite (b (refl_eqT R (f x)));Unfold Rgt in H;Assumption.
+Lemma limit_free :
+ forall (f:R -> R) (D:R -> Prop) (x x0:R),
+ limit1_in (fun h:R => f x) D (f x) x0.
+unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; intros;
+ split with eps; split; auto; intros; elim (R_dist_refl (f x) (f x));
+ intros a b; rewrite (b (refl_equal (f x))); unfold Rgt in H;
+ assumption.
Qed.
(*********)
-Lemma limit_mul:(f,g:R->R)(D:R->Prop)(l,l':R)(x0:R)
- (limit1_in f D l x0)->(limit1_in g D l' x0)->
- (limit1_in [x:R](Rmult (f x) (g x)) D (Rmult l l') x0).
-Intros;Unfold limit1_in; Unfold limit_in; Simpl; Intros;
- Elim (H (Rmin R1 (Rmult eps (mul_factor l l')))
- (mul_factor_gt_f eps l l' H1));
- Elim (H0 (Rmult eps (mul_factor l l')) (mul_factor_gt eps l l' H1));
- Clear H H0; Simpl; Intros; Elim H; Elim H0; Clear H H0; Intros;
- Split with (Rmin x1 x); Split.
-Exact (Rmin_Rgt_r x1 x R0 (conj ? ? H H2)).
-Intros; Elim H4; Clear H4; Intros;Unfold R_dist;
- Replace (Rminus (Rmult (f x2) (g x2)) (Rmult l l')) with
- (Rplus (Rmult (f x2) (Rminus (g x2) l')) (Rmult l' (Rminus (f x2) l))).
-Cut (Rlt (Rplus (Rabsolu (Rmult (f x2) (Rminus (g x2) l'))) (Rabsolu (Rmult l'
- (Rminus (f x2) l)))) eps).
-Cut (Rle (Rabsolu (Rplus (Rmult (f x2) (Rminus (g x2) l')) (Rmult l' (Rminus
- (f x2) l)))) (Rplus (Rabsolu (Rmult (f x2) (Rminus (g x2) l'))) (Rabsolu
- (Rmult l' (Rminus (f x2) l))))).
-Exact (Rle_lt_trans ? ? ?).
-Exact (Rabsolu_triang ? ?).
-Rewrite (Rabsolu_mult (f x2) (Rminus (g x2) l'));
- Rewrite (Rabsolu_mult l' (Rminus (f x2) l));
- Cut (Rle (Rplus (Rmult (Rplus R1 (Rabsolu l)) (Rmult eps (mul_factor l l')))
- (Rmult (Rabsolu l') (Rmult eps (mul_factor l l')))) eps).
-Cut (Rlt (Rplus (Rmult (Rabsolu (f x2)) (Rabsolu (Rminus (g x2) l'))) (Rmult
- (Rabsolu l') (Rabsolu (Rminus (f x2) l)))) (Rplus (Rmult (Rplus R1 (Rabsolu
- l)) (Rmult eps (mul_factor l l'))) (Rmult (Rabsolu l') (Rmult eps
- (mul_factor l l'))))).
-Exact (Rlt_le_trans ? ? ?).
-Elim (Rmin_Rgt_l x1 x (R_dist x2 x0) H5); Clear H5; Intros;
- Generalize (H0 x2 (conj (D x2) (Rlt (R_dist x2 x0) x1) H4 H5));Intro;
- Generalize (Rmin_Rgt_l ? ? ? H7);Intro;Elim H8;Intros;Clear H0 H8;
- Apply Rplus_lt_le_lt.
-Apply Rmult_lt_0.
-Apply Rle_sym1.
-Exact (Rabsolu_pos (Rminus (g x2) l')).
-Rewrite (Rplus_sym R1 (Rabsolu l));Unfold Rgt;Apply Rlt_r_plus_R1;
- Exact (Rabsolu_pos l).
-Unfold R_dist in H9;
- Apply (Rlt_anti_compatibility (Ropp (Rabsolu l)) (Rabsolu (f x2))
- (Rplus R1 (Rabsolu l))).
-Rewrite <- (Rplus_assoc (Ropp (Rabsolu l)) R1 (Rabsolu l));
- Rewrite (Rplus_sym (Ropp (Rabsolu l)) R1);
- Rewrite (Rplus_assoc R1 (Ropp (Rabsolu l)) (Rabsolu l));
- Rewrite (Rplus_Ropp_l (Rabsolu l));
- Rewrite (proj1 ? ? (Rplus_ne R1));
- Rewrite (Rplus_sym (Ropp (Rabsolu l)) (Rabsolu (f x2)));
- Generalize H9;
-Cut (Rle (Rminus (Rabsolu (f x2)) (Rabsolu l)) (Rabsolu (Rminus (f x2) l))).
-Exact (Rle_lt_trans ? ? ?).
-Exact (Rabsolu_triang_inv ? ?).
-Generalize (H3 x2 (conj (D x2) (Rlt (R_dist x2 x0) x) H4 H6));Trivial.
-Apply Rle_monotony.
-Exact (Rabsolu_pos l').
-Unfold Rle;Left;Assumption.
-Rewrite (Rmult_sym (Rplus R1 (Rabsolu l)) (Rmult eps (mul_factor l l')));
- Rewrite (Rmult_sym (Rabsolu l') (Rmult eps (mul_factor l l')));
- Rewrite <- (Rmult_Rplus_distr
- (Rmult eps (mul_factor l l'))
- (Rplus R1 (Rabsolu l))
- (Rabsolu l'));
- Rewrite (Rmult_assoc eps (mul_factor l l') (Rplus (Rplus R1 (Rabsolu l))
- (Rabsolu l')));
- Rewrite (Rplus_assoc R1 (Rabsolu l) (Rabsolu l'));Unfold mul_factor;
- Rewrite (Rinv_l (Rplus R1 (Rplus (Rabsolu l) (Rabsolu l')))
- (mul_factor_wd l l'));
- Rewrite (proj1 ? ? (Rmult_ne eps));Apply eq_Rle;Trivial.
-Ring.
+Lemma limit_mul :
+ forall (f g:R -> R) (D:R -> Prop) (l l' x0:R),
+ limit1_in f D l x0 ->
+ limit1_in g D l' x0 -> limit1_in (fun x:R => f x * g x) D (l * l') x0.
+intros; unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *;
+ intros;
+ elim (H (Rmin 1 (eps * mul_factor l l')) (mul_factor_gt_f eps l l' H1));
+ elim (H0 (eps * mul_factor l l') (mul_factor_gt eps l l' H1));
+ clear H H0; simpl in |- *; intros; elim H; elim H0;
+ clear H H0; intros; split with (Rmin x1 x); split.
+exact (Rmin_Rgt_r x1 x 0 (conj H H2)).
+intros; elim H4; clear H4; intros; unfold R_dist in |- *;
+ replace (f x2 * g x2 - l * l') with (f x2 * (g x2 - l') + l' * (f x2 - l)).
+cut (Rabs (f x2 * (g x2 - l')) + Rabs (l' * (f x2 - l)) < eps).
+cut
+ (Rabs (f x2 * (g x2 - l') + l' * (f x2 - l)) <=
+ Rabs (f x2 * (g x2 - l')) + Rabs (l' * (f x2 - l))).
+exact (Rle_lt_trans _ _ _).
+exact (Rabs_triang _ _).
+rewrite (Rabs_mult (f x2) (g x2 - l')); rewrite (Rabs_mult l' (f x2 - l));
+ cut
+ ((1 + Rabs l) * (eps * mul_factor l l') + Rabs l' * (eps * mul_factor l l') <=
+ eps).
+cut
+ (Rabs (f x2) * Rabs (g x2 - l') + Rabs l' * Rabs (f x2 - l) <
+ (1 + Rabs l) * (eps * mul_factor l l') + Rabs l' * (eps * mul_factor l l')).
+exact (Rlt_le_trans _ _ _).
+elim (Rmin_Rgt_l x1 x (R_dist x2 x0) H5); clear H5; intros;
+ generalize (H0 x2 (conj H4 H5)); intro; generalize (Rmin_Rgt_l _ _ _ H7);
+ intro; elim H8; intros; clear H0 H8; apply Rplus_lt_le_compat.
+apply Rmult_ge_0_gt_0_lt_compat.
+apply Rle_ge.
+exact (Rabs_pos (g x2 - l')).
+rewrite (Rplus_comm 1 (Rabs l)); unfold Rgt in |- *; apply Rle_lt_0_plus_1;
+ exact (Rabs_pos l).
+unfold R_dist in H9;
+ apply (Rplus_lt_reg_r (- Rabs l) (Rabs (f x2)) (1 + Rabs l)).
+rewrite <- (Rplus_assoc (- Rabs l) 1 (Rabs l));
+ rewrite (Rplus_comm (- Rabs l) 1);
+ rewrite (Rplus_assoc 1 (- Rabs l) (Rabs l)); rewrite (Rplus_opp_l (Rabs l));
+ rewrite (proj1 (Rplus_ne 1)); rewrite (Rplus_comm (- Rabs l) (Rabs (f x2)));
+ generalize H9; cut (Rabs (f x2) - Rabs l <= Rabs (f x2 - l)).
+exact (Rle_lt_trans _ _ _).
+exact (Rabs_triang_inv _ _).
+generalize (H3 x2 (conj H4 H6)); trivial.
+apply Rmult_le_compat_l.
+exact (Rabs_pos l').
+unfold Rle in |- *; left; assumption.
+rewrite (Rmult_comm (1 + Rabs l) (eps * mul_factor l l'));
+ rewrite (Rmult_comm (Rabs l') (eps * mul_factor l l'));
+ rewrite <-
+ (Rmult_plus_distr_l (eps * mul_factor l l') (1 + Rabs l) (Rabs l'))
+ ; rewrite (Rmult_assoc eps (mul_factor l l') (1 + Rabs l + Rabs l'));
+ rewrite (Rplus_assoc 1 (Rabs l) (Rabs l')); unfold mul_factor in |- *;
+ rewrite (Rinv_l (1 + (Rabs l + Rabs l')) (mul_factor_wd l l'));
+ rewrite (proj1 (Rmult_ne eps)); apply Req_le; trivial.
+ring.
Qed.
(*********)
-Definition adhDa:(R->Prop)->R->Prop:=[D:R->Prop][a:R]
- (alp:R)(Rgt alp R0)->(EXT x:R | (D x)/\(Rlt (R_dist x a) alp)).
+Definition adhDa (D:R -> Prop) (a:R) : Prop :=
+ forall alp:R, alp > 0 -> exists x : R | D x /\ R_dist x a < alp.
(*********)
-Lemma single_limit:(f:R->R)(D:R->Prop)(l:R)(l':R)(x0:R)
- (adhDa D x0)->(limit1_in f D l x0)->(limit1_in f D l' x0)->l==l'.
-Unfold limit1_in; Unfold limit_in; Intros.
-Cut (eps:R)(Rgt eps R0)->(Rlt (dist R_met l l')
- (Rmult (Rplus R1 R1) eps)).
-Clear H0 H1;Unfold dist; Unfold R_met; Unfold R_dist;
- Unfold Rabsolu;Case (case_Rabsolu (Rminus l l')); Intros.
-Cut (eps:R)(Rgt eps R0)->(Rlt (Ropp (Rminus l l')) eps).
-Intro;Generalize (prop_eps (Ropp (Rminus l l')) H1);Intro;
- Generalize (Rlt_RoppO (Rminus l l') r); Intro;Unfold Rgt in H3;
- Generalize (Rle_not (Ropp (Rminus l l')) R0 H3); Intro;
- ElimType False; Auto.
-Intros;Cut (Rgt (Rmult eps (Rinv (Rplus R1 R1))) R0).
-Intro;Generalize (H0 (Rmult eps (Rinv (Rplus R1 R1))) H2);
- Rewrite (Rmult_sym eps (Rinv (Rplus R1 R1)));
- Rewrite <- (Rmult_assoc (Rplus R1 R1) (Rinv (Rplus R1 R1)) eps);
- Rewrite (Rinv_r (Rplus R1 R1)).
-Elim (Rmult_ne eps);Intros a b;Rewrite b;Clear a b;Trivial.
-Apply (imp_not_Req (Rplus R1 R1) R0);Right;Generalize Rlt_R0_R1;Intro;
- Unfold Rgt;Generalize (Rlt_compatibility R1 R0 R1 H3);Intro;
- Elim (Rplus_ne R1);Intros a b;Rewrite a in H4;Clear a b;
- Apply (Rlt_trans R0 R1 (Rplus R1 R1) H3 H4).
-Unfold Rgt;Unfold Rgt in H1;
- Rewrite (Rmult_sym eps(Rinv (Rplus R1 R1)));
- Rewrite <-(Rmult_Or (Rinv (Rplus R1 R1)));
- Apply (Rlt_monotony (Rinv (Rplus R1 R1)) R0 eps);Auto.
-Apply (Rlt_Rinv (Rplus R1 R1));Cut (Rlt R1 (Rplus R1 R1)).
-Intro;Apply (Rlt_trans R0 R1 (Rplus R1 R1) Rlt_R0_R1 H2).
-Generalize (Rlt_compatibility R1 R0 R1 Rlt_R0_R1);Elim (Rplus_ne R1);
- Intros a b;Rewrite a;Clear a b;Trivial.
+Lemma single_limit :
+ forall (f:R -> R) (D:R -> Prop) (l l' x0:R),
+ adhDa D x0 -> limit1_in f D l x0 -> limit1_in f D l' x0 -> l = l'.
+unfold limit1_in in |- *; unfold limit_in in |- *; intros.
+cut (forall eps:R, eps > 0 -> dist R_met l l' < 2 * eps).
+clear H0 H1; unfold dist in |- *; unfold R_met in |- *; unfold R_dist in |- *;
+ unfold Rabs in |- *; case (Rcase_abs (l - l')); intros.
+cut (forall eps:R, eps > 0 -> - (l - l') < eps).
+intro; generalize (prop_eps (- (l - l')) H1); intro;
+ generalize (Ropp_gt_lt_0_contravar (l - l') r); intro;
+ unfold Rgt in H3; generalize (Rgt_not_le (- (l - l')) 0 H3);
+ intro; elimtype False; auto.
+intros; cut (eps * / 2 > 0).
+intro; generalize (H0 (eps * / 2) H2); rewrite (Rmult_comm eps (/ 2));
+ rewrite <- (Rmult_assoc 2 (/ 2) eps); rewrite (Rinv_r 2).
+elim (Rmult_ne eps); intros a b; rewrite b; clear a b; trivial.
+apply (Rlt_dichotomy_converse 2 0); right; generalize Rlt_0_1; intro;
+ unfold Rgt in |- *; generalize (Rplus_lt_compat_l 1 0 1 H3);
+ intro; elim (Rplus_ne 1); intros a b; rewrite a in H4;
+ clear a b; apply (Rlt_trans 0 1 2 H3 H4).
+unfold Rgt in |- *; unfold Rgt in H1; rewrite (Rmult_comm eps (/ 2));
+ rewrite <- (Rmult_0_r (/ 2)); apply (Rmult_lt_compat_l (/ 2) 0 eps);
+ auto.
+apply (Rinv_0_lt_compat 2); cut (1 < 2).
+intro; apply (Rlt_trans 0 1 2 Rlt_0_1 H2).
+generalize (Rplus_lt_compat_l 1 0 1 Rlt_0_1); elim (Rplus_ne 1); intros a b;
+ rewrite a; clear a b; trivial.
(**)
-Cut (eps:R)(Rgt eps R0)->(Rlt (Rminus l l') eps).
-Intro;Generalize (prop_eps (Rminus l l') H1);Intro;
- Elim (Rle_le_eq (Rminus l l') R0);Intros a b;Clear b;
- Apply (Rminus_eq l l');Apply a;Split.
-Assumption.
-Apply (Rle_sym2 R0 (Rminus l l') r).
-Intros;Cut (Rgt (Rmult eps (Rinv (Rplus R1 R1))) R0).
-Intro;Generalize (H0 (Rmult eps (Rinv (Rplus R1 R1))) H2);
- Rewrite (Rmult_sym eps (Rinv (Rplus R1 R1)));
- Rewrite <- (Rmult_assoc (Rplus R1 R1) (Rinv (Rplus R1 R1)) eps);
- Rewrite (Rinv_r (Rplus R1 R1)).
-Elim (Rmult_ne eps);Intros a b;Rewrite b;Clear a b;Trivial.
-Apply (imp_not_Req (Rplus R1 R1) R0);Right;Generalize Rlt_R0_R1;Intro;
- Unfold Rgt;Generalize (Rlt_compatibility R1 R0 R1 H3);Intro;
- Elim (Rplus_ne R1);Intros a b;Rewrite a in H4;Clear a b;
- Apply (Rlt_trans R0 R1 (Rplus R1 R1) H3 H4).
-Unfold Rgt;Unfold Rgt in H1;
- Rewrite (Rmult_sym eps(Rinv (Rplus R1 R1)));
- Rewrite <-(Rmult_Or (Rinv (Rplus R1 R1)));
- Apply (Rlt_monotony (Rinv (Rplus R1 R1)) R0 eps);Auto.
-Apply (Rlt_Rinv (Rplus R1 R1));Cut (Rlt R1 (Rplus R1 R1)).
-Intro;Apply (Rlt_trans R0 R1 (Rplus R1 R1) Rlt_R0_R1 H2).
-Generalize (Rlt_compatibility R1 R0 R1 Rlt_R0_R1);Elim (Rplus_ne R1);
- Intros a b;Rewrite a;Clear a b;Trivial.
+cut (forall eps:R, eps > 0 -> l - l' < eps).
+intro; generalize (prop_eps (l - l') H1); intro; elim (Rle_le_eq (l - l') 0);
+ intros a b; clear b; apply (Rminus_diag_uniq l l');
+ apply a; split.
+assumption.
+apply (Rge_le (l - l') 0 r).
+intros; cut (eps * / 2 > 0).
+intro; generalize (H0 (eps * / 2) H2); rewrite (Rmult_comm eps (/ 2));
+ rewrite <- (Rmult_assoc 2 (/ 2) eps); rewrite (Rinv_r 2).
+elim (Rmult_ne eps); intros a b; rewrite b; clear a b; trivial.
+apply (Rlt_dichotomy_converse 2 0); right; generalize Rlt_0_1; intro;
+ unfold Rgt in |- *; generalize (Rplus_lt_compat_l 1 0 1 H3);
+ intro; elim (Rplus_ne 1); intros a b; rewrite a in H4;
+ clear a b; apply (Rlt_trans 0 1 2 H3 H4).
+unfold Rgt in |- *; unfold Rgt in H1; rewrite (Rmult_comm eps (/ 2));
+ rewrite <- (Rmult_0_r (/ 2)); apply (Rmult_lt_compat_l (/ 2) 0 eps);
+ auto.
+apply (Rinv_0_lt_compat 2); cut (1 < 2).
+intro; apply (Rlt_trans 0 1 2 Rlt_0_1 H2).
+generalize (Rplus_lt_compat_l 1 0 1 Rlt_0_1); elim (Rplus_ne 1); intros a b;
+ rewrite a; clear a b; trivial.
(**)
-Intros;Unfold adhDa in H;Elim (H0 eps H2);Intros;Elim (H1 eps H2);
- Intros;Clear H0 H1;Elim H3;Elim H4;Clear H3 H4;Intros;
- Simpl;Simpl in H1 H4;Generalize (Rmin_Rgt x x1 R0);Intro;Elim H5;
- Intros;Clear H5;
- Elim (H (Rmin x x1) (H7 (conj (Rgt x R0) (Rgt x1 R0) H3 H0)));
- Intros; Elim H5;Intros;Clear H5 H H6 H7;
- Generalize (Rmin_Rgt x x1 (R_dist x2 x0));Intro;Elim H;
- Intros;Clear H H6;Unfold Rgt in H5;Elim (H5 H9);Intros;Clear H5 H9;
- Generalize (H1 x2 (conj (D x2) (Rlt (R_dist x2 x0) x1) H8 H6));
- Generalize (H4 x2 (conj (D x2) (Rlt (R_dist x2 x0) x) H8 H));
- Clear H8 H H6 H1 H4 H0 H3;Intros;
- Generalize (Rplus_lt (R_dist (f x2) l) eps (R_dist (f x2) l') eps
- H H0); Unfold R_dist;Intros;
- Rewrite (Rabsolu_minus_sym (f x2) l) in H1;
- Rewrite (Rmult_sym (Rplus R1 R1) eps);Rewrite (Rmult_Rplus_distr eps R1 R1);
- Elim (Rmult_ne eps);Intros a b;Rewrite a;Clear a b;
- Generalize (R_dist_tri l l' (f x2));Unfold R_dist;Intros;
- Apply (Rle_lt_trans (Rabsolu (Rminus l l'))
- (Rplus (Rabsolu (Rminus l (f x2))) (Rabsolu (Rminus (f x2) l')))
- (Rplus eps eps) H3 H1).
+intros; unfold adhDa in H; elim (H0 eps H2); intros; elim (H1 eps H2); intros;
+ clear H0 H1; elim H3; elim H4; clear H3 H4; intros;
+ simpl in |- *; simpl in H1, H4; generalize (Rmin_Rgt x x1 0);
+ intro; elim H5; intros; clear H5; elim (H (Rmin x x1) (H7 (conj H3 H0)));
+ intros; elim H5; intros; clear H5 H H6 H7;
+ generalize (Rmin_Rgt x x1 (R_dist x2 x0)); intro;
+ elim H; intros; clear H H6; unfold Rgt in H5; elim (H5 H9);
+ intros; clear H5 H9; generalize (H1 x2 (conj H8 H6));
+ generalize (H4 x2 (conj H8 H)); clear H8 H H6 H1 H4 H0 H3;
+ intros;
+ generalize
+ (Rplus_lt_compat (R_dist (f x2) l) eps (R_dist (f x2) l') eps H H0);
+ unfold R_dist in |- *; intros; rewrite (Rabs_minus_sym (f x2) l) in H1;
+ rewrite (Rmult_comm 2 eps); rewrite (Rmult_plus_distr_l eps 1 1);
+ elim (Rmult_ne eps); intros a b; rewrite a; clear a b;
+ generalize (R_dist_tri l l' (f x2)); unfold R_dist in |- *;
+ intros;
+ apply
+ (Rle_lt_trans (Rabs (l - l')) (Rabs (l - f x2) + Rabs (f x2 - l'))
+ (eps + eps) H3 H1).
Qed.
(*********)
-Lemma limit_comp:(f,g:R->R)(Df,Dg:R->Prop)(l,l':R)(x0:R)
- (limit1_in f Df l x0)->(limit1_in g Dg l' l)->
- (limit1_in [x:R](g (f x)) (Dgf Df Dg f) l' x0).
-Unfold limit1_in limit_in Dgf;Simpl.
-Intros f g Df Dg l l' x0 Hf Hg eps eps_pos.
-Elim (Hg eps eps_pos).
-Intros alpg lg.
-Elim (Hf alpg).
-2: Tauto.
-Intros alpf lf.
-Exists alpf.
-Intuition.
+Lemma limit_comp :
+ forall (f g:R -> R) (Df Dg:R -> Prop) (l l' x0:R),
+ limit1_in f Df l x0 ->
+ limit1_in g Dg l' l -> limit1_in (fun x:R => g (f x)) (Dgf Df Dg f) l' x0.
+unfold limit1_in, limit_in, Dgf in |- *; simpl in |- *.
+intros f g Df Dg l l' x0 Hf Hg eps eps_pos.
+elim (Hg eps eps_pos).
+intros alpg lg.
+elim (Hf alpg).
+2: tauto.
+intros alpf lf.
+exists alpf.
+intuition.
Qed.
(*********)
-Lemma limit_inv : (f:R->R)(D:R->Prop)(l:R)(x0:R) (limit1_in f D l x0)->~(l==R0)->(limit1_in [x:R](Rinv (f x)) D (Rinv l) x0).
-Unfold limit1_in; Unfold limit_in; Simpl; Unfold R_dist; Intros; Elim (H ``(Rabsolu l)/2``).
-Intros delta1 H2; Elim (H ``eps*((Rsqr l)/2)``).
-Intros delta2 H3; Elim H2; Elim H3; Intros; Exists (Rmin delta1 delta2); Split.
-Unfold Rmin; Case (total_order_Rle delta1 delta2); Intro; Assumption.
-Intro; Generalize (H5 x); Clear H5; Intro H5; Generalize (H7 x); Clear H7; Intro H7; Intro H10; Elim H10; Intros; Cut (D x)/\``(Rabsolu (x-x0))<delta1``.
-Cut (D x)/\``(Rabsolu (x-x0))<delta2``.
-Intros; Generalize (H5 H11); Clear H5; Intro H5; Generalize (H7 H12); Clear H7; Intro H7; Generalize (Rabsolu_triang_inv l (f x)); Intro; Rewrite Rabsolu_minus_sym in H7; Generalize (Rle_lt_trans ``(Rabsolu l)-(Rabsolu (f x))`` ``(Rabsolu (l-(f x)))`` ``(Rabsolu l)/2`` H13 H7); Intro; Generalize (Rlt_compatibility ``(Rabsolu (f x))-(Rabsolu l)/2`` ``(Rabsolu l)-(Rabsolu (f x))`` ``(Rabsolu l)/2`` H14); Replace ``(Rabsolu (f x))-(Rabsolu l)/2+((Rabsolu l)-(Rabsolu (f x)))`` with ``(Rabsolu l)/2``.
-Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Intro; Cut ~``(f x)==0``.
-Intro; Replace ``/(f x)+ -/l`` with ``(l-(f x))*/(l*(f x))``.
-Rewrite Rabsolu_mult; Rewrite Rabsolu_Rinv.
-Cut ``/(Rabsolu (l*(f x)))<2/(Rsqr l)``.
-Intro; Rewrite Rabsolu_minus_sym in H5; Cut ``0<=/(Rabsolu (l*(f x)))``.
-Intro; Generalize (Rmult_lt2 ``(Rabsolu (l-(f x)))`` ``eps*(Rsqr l)/2`` ``/(Rabsolu (l*(f x)))`` ``2/(Rsqr l)`` (Rabsolu_pos ``l-(f x)``) H18 H5 H17); Replace ``eps*(Rsqr l)/2*2/(Rsqr l)`` with ``eps``.
-Intro; Assumption.
-Unfold Rdiv; Unfold Rsqr; Rewrite Rinv_Rmult.
-Repeat Rewrite Rmult_assoc.
-Rewrite (Rmult_sym l).
-Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Rewrite (Rmult_sym l).
-Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Reflexivity.
-DiscrR.
-Exact H0.
-Exact H0.
-Exact H0.
-Exact H0.
-Left; Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Apply prod_neq_R0; Assumption.
-Rewrite Rmult_sym; Rewrite Rabsolu_mult; Rewrite Rinv_Rmult.
-Rewrite (Rsqr_abs l); Unfold Rsqr; Unfold Rdiv; Rewrite Rinv_Rmult.
-Repeat Rewrite <- Rmult_assoc; Apply Rlt_monotony_r.
-Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption.
-Apply Rlt_monotony_contra with ``(Rabsolu (f x))*(Rabsolu l)*/2``.
-Repeat Apply Rmult_lt_pos.
-Apply Rabsolu_pos_lt; Assumption.
-Apply Rabsolu_pos_lt; Assumption.
-Apply Rlt_Rinv; Cut ~(O=(2)); [Intro H17; Generalize (lt_INR_0 (2) (neq_O_lt (2) H17)); Unfold INR; Intro H18; Assumption | Discriminate].
-Replace ``(Rabsolu (f x))*(Rabsolu l)*/2*/(Rabsolu (f x))`` with ``(Rabsolu l)/2``.
-Replace ``(Rabsolu (f x))*(Rabsolu l)*/2*(2*/(Rabsolu l))`` with ``(Rabsolu (f x))``.
-Assumption.
-Repeat Rewrite Rmult_assoc.
-Rewrite (Rmult_sym (Rabsolu l)).
-Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Reflexivity.
-DiscrR.
-Apply Rabsolu_no_R0.
-Assumption.
-Unfold Rdiv.
-Repeat Rewrite Rmult_assoc.
-Rewrite (Rmult_sym (Rabsolu (f x))).
-Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Reflexivity.
-Apply Rabsolu_no_R0; Assumption.
-Apply Rabsolu_no_R0; Assumption.
-Apply Rabsolu_no_R0; Assumption.
-Apply Rabsolu_no_R0; Assumption.
-Apply Rabsolu_no_R0; Assumption.
-Apply prod_neq_R0; Assumption.
-Rewrite (Rinv_Rmult ? ? H0 H16).
-Unfold Rminus; Rewrite Rmult_Rplus_distrl.
-Rewrite <- Rmult_assoc.
-Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1l.
-Rewrite Ropp_mul1.
-Rewrite (Rmult_sym (f x)).
-Rewrite Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Reflexivity.
-Assumption.
-Assumption.
-Red; Intro; Rewrite H16 in H15; Rewrite Rabsolu_R0 in H15; Cut ``0<(Rabsolu l)/2``.
-Intro; Elim (Rlt_antirefl ``0`` (Rlt_trans ``0`` ``(Rabsolu l)/2`` ``0`` H17 H15)).
-Unfold Rdiv; Apply Rmult_lt_pos.
-Apply Rabsolu_pos_lt; Assumption.
-Apply Rlt_Rinv; Cut ~(O=(2)); [Intro H17; Generalize (lt_INR_0 (2) (neq_O_lt (2) H17)); Unfold INR; Intro; Assumption | Discriminate].
-Pattern 3 (Rabsolu l); Rewrite double_var.
-Ring.
-Split; [Assumption | Apply Rlt_le_trans with (Rmin delta1 delta2); [Assumption | Apply Rmin_r]].
-Split; [Assumption | Apply Rlt_le_trans with (Rmin delta1 delta2); [Assumption | Apply Rmin_l]].
-Change ``0<eps*(Rsqr l)/2``; Unfold Rdiv; Repeat Rewrite Rmult_assoc; Repeat Apply Rmult_lt_pos.
-Assumption.
-Apply Rsqr_pos_lt; Assumption.
-Apply Rlt_Rinv; Cut ~(O=(2)); [Intro H3; Generalize (lt_INR_0 (2) (neq_O_lt (2) H3)); Unfold INR; Intro; Assumption | Discriminate].
-Change ``0<(Rabsolu l)/2``; Unfold Rdiv; Apply Rmult_lt_pos; [Apply Rabsolu_pos_lt; Assumption | Apply Rlt_Rinv; Cut ~(O=(2)); [Intro H3; Generalize (lt_INR_0 (2) (neq_O_lt (2) H3)); Unfold INR; Intro; Assumption | Discriminate]].
-Qed.
+Lemma limit_inv :
+ forall (f:R -> R) (D:R -> Prop) (l x0:R),
+ limit1_in f D l x0 -> l <> 0 -> limit1_in (fun x:R => / f x) D (/ l) x0.
+unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *;
+ unfold R_dist in |- *; intros; elim (H (Rabs l / 2)).
+intros delta1 H2; elim (H (eps * (Rsqr l / 2))).
+intros delta2 H3; elim H2; elim H3; intros; exists (Rmin delta1 delta2);
+ split.
+unfold Rmin in |- *; case (Rle_dec delta1 delta2); intro; assumption.
+intro; generalize (H5 x); clear H5; intro H5; generalize (H7 x); clear H7;
+ intro H7; intro H10; elim H10; intros; cut (D x /\ Rabs (x - x0) < delta1).
+cut (D x /\ Rabs (x - x0) < delta2).
+intros; generalize (H5 H11); clear H5; intro H5; generalize (H7 H12);
+ clear H7; intro H7; generalize (Rabs_triang_inv l (f x));
+ intro; rewrite Rabs_minus_sym in H7;
+ generalize
+ (Rle_lt_trans (Rabs l - Rabs (f x)) (Rabs (l - f x)) (Rabs l / 2) H13 H7);
+ intro;
+ generalize
+ (Rplus_lt_compat_l (Rabs (f x) - Rabs l / 2) (Rabs l - Rabs (f x))
+ (Rabs l / 2) H14);
+ replace (Rabs (f x) - Rabs l / 2 + (Rabs l - Rabs (f x))) with (Rabs l / 2).
+unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_l;
+ rewrite Rplus_0_r; intro; cut (f x <> 0).
+intro; replace (/ f x + - / l) with ((l - f x) * / (l * f x)).
+rewrite Rabs_mult; rewrite Rabs_Rinv.
+cut (/ Rabs (l * f x) < 2 / Rsqr l).
+intro; rewrite Rabs_minus_sym in H5; cut (0 <= / Rabs (l * f x)).
+intro;
+ generalize
+ (Rmult_le_0_lt_compat (Rabs (l - f x)) (eps * (Rsqr l / 2))
+ (/ Rabs (l * f x)) (2 / Rsqr l) (Rabs_pos (l - f x)) H18 H5 H17);
+ replace (eps * (Rsqr l / 2) * (2 / Rsqr l)) with eps.
+intro; assumption.
+unfold Rdiv in |- *; unfold Rsqr in |- *; rewrite Rinv_mult_distr.
+repeat rewrite Rmult_assoc.
+rewrite (Rmult_comm l).
+repeat rewrite Rmult_assoc.
+rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r.
+rewrite (Rmult_comm l).
+repeat rewrite Rmult_assoc.
+rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r.
+rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r; reflexivity.
+discrR.
+exact H0.
+exact H0.
+exact H0.
+exact H0.
+left; apply Rinv_0_lt_compat; apply Rabs_pos_lt; apply prod_neq_R0;
+ assumption.
+rewrite Rmult_comm; rewrite Rabs_mult; rewrite Rinv_mult_distr.
+rewrite (Rsqr_abs l); unfold Rsqr in |- *; unfold Rdiv in |- *;
+ rewrite Rinv_mult_distr.
+repeat rewrite <- Rmult_assoc; apply Rmult_lt_compat_r.
+apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption.
+apply Rmult_lt_reg_l with (Rabs (f x) * Rabs l * / 2).
+repeat apply Rmult_lt_0_compat.
+apply Rabs_pos_lt; assumption.
+apply Rabs_pos_lt; assumption.
+apply Rinv_0_lt_compat; cut (0%nat <> 2%nat);
+ [ intro H17; generalize (lt_INR_0 2 (neq_O_lt 2 H17)); unfold INR in |- *;
+ intro H18; assumption
+ | discriminate ].
+replace (Rabs (f x) * Rabs l * / 2 * / Rabs (f x)) with (Rabs l / 2).
+replace (Rabs (f x) * Rabs l * / 2 * (2 * / Rabs l)) with (Rabs (f x)).
+assumption.
+repeat rewrite Rmult_assoc.
+rewrite (Rmult_comm (Rabs l)).
+repeat rewrite Rmult_assoc.
+rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r.
+rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r; reflexivity.
+discrR.
+apply Rabs_no_R0.
+assumption.
+unfold Rdiv in |- *.
+repeat rewrite Rmult_assoc.
+rewrite (Rmult_comm (Rabs (f x))).
+repeat rewrite Rmult_assoc.
+rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r.
+reflexivity.
+apply Rabs_no_R0; assumption.
+apply Rabs_no_R0; assumption.
+apply Rabs_no_R0; assumption.
+apply Rabs_no_R0; assumption.
+apply Rabs_no_R0; assumption.
+apply prod_neq_R0; assumption.
+rewrite (Rinv_mult_distr _ _ H0 H16).
+unfold Rminus in |- *; rewrite Rmult_plus_distr_r.
+rewrite <- Rmult_assoc.
+rewrite <- Rinv_r_sym.
+rewrite Rmult_1_l.
+rewrite Ropp_mult_distr_l_reverse.
+rewrite (Rmult_comm (f x)).
+rewrite Rmult_assoc.
+rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r.
+reflexivity.
+assumption.
+assumption.
+red in |- *; intro; rewrite H16 in H15; rewrite Rabs_R0 in H15;
+ cut (0 < Rabs l / 2).
+intro; elim (Rlt_irrefl 0 (Rlt_trans 0 (Rabs l / 2) 0 H17 H15)).
+unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+apply Rabs_pos_lt; assumption.
+apply Rinv_0_lt_compat; cut (0%nat <> 2%nat);
+ [ intro H17; generalize (lt_INR_0 2 (neq_O_lt 2 H17)); unfold INR in |- *;
+ intro; assumption
+ | discriminate ].
+pattern (Rabs l) at 3 in |- *; rewrite double_var.
+ring.
+split;
+ [ assumption
+ | apply Rlt_le_trans with (Rmin delta1 delta2);
+ [ assumption | apply Rmin_r ] ].
+split;
+ [ assumption
+ | apply Rlt_le_trans with (Rmin delta1 delta2);
+ [ assumption | apply Rmin_l ] ].
+change (0 < eps * (Rsqr l / 2)) in |- *; unfold Rdiv in |- *;
+ repeat rewrite Rmult_assoc; repeat apply Rmult_lt_0_compat.
+assumption.
+apply Rsqr_pos_lt; assumption.
+apply Rinv_0_lt_compat; cut (0%nat <> 2%nat);
+ [ intro H3; generalize (lt_INR_0 2 (neq_O_lt 2 H3)); unfold INR in |- *;
+ intro; assumption
+ | discriminate ].
+change (0 < Rabs l / 2) in |- *; unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ apply Rabs_pos_lt; assumption
+ | apply Rinv_0_lt_compat; cut (0%nat <> 2%nat);
+ [ intro H3; generalize (lt_INR_0 2 (neq_O_lt 2 H3)); unfold INR in |- *;
+ intro; assumption
+ | discriminate ] ].
+Qed. \ No newline at end of file
diff --git a/theories/Reals/Rpower.v b/theories/Reals/Rpower.v
index c4cb1a8eb..7c31bbe61 100644
--- a/theories/Reals/Rpower.v
+++ b/theories/Reals/Rpower.v
@@ -13,548 +13,649 @@
(* Definitions of log and Rpower : R->R->R; main properties *)
(************************************************************)
-Require Rbase.
-Require Rfunctions.
-Require SeqSeries.
-Require Rtrigo.
-Require Ranalysis1.
-Require Exp_prop.
-Require Rsqrt_def.
-Require R_sqrt.
-Require MVT.
-Require Ranalysis4.
-V7only [Import R_scope.]. Open Local Scope R_scope.
+Require Import Rbase.
+Require Import Rfunctions.
+Require Import SeqSeries.
+Require Import Rtrigo.
+Require Import Ranalysis1.
+Require Import Exp_prop.
+Require Import Rsqrt_def.
+Require Import R_sqrt.
+Require Import MVT.
+Require Import Ranalysis4. Open Local Scope R_scope.
-Lemma P_Rmin: (P : R -> Prop) (x, y : R) (P x) -> (P y) -> (P (Rmin x y)).
-Intros P x y H1 H2; Unfold Rmin; Case (total_order_Rle x y); Intro; Assumption.
+Lemma P_Rmin : forall (P:R -> Prop) (x y:R), P x -> P y -> P (Rmin x y).
+intros P x y H1 H2; unfold Rmin in |- *; case (Rle_dec x y); intro;
+ assumption.
Qed.
-Lemma exp_le_3 : ``(exp 1)<=3``.
-Assert exp_1 : ``(exp 1)<>0``.
-Assert H0 := (exp_pos R1); Red; Intro; Rewrite H in H0; Elim (Rlt_antirefl ? H0).
-Apply Rle_monotony_contra with ``/(exp 1)``.
-Apply Rlt_Rinv; Apply exp_pos.
-Rewrite <- Rinv_l_sym.
-Apply Rle_monotony_contra with ``/3``.
-Apply Rlt_Rinv; Sup0.
-Rewrite Rmult_1r; Rewrite <- (Rmult_sym ``3``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l; Replace ``/(exp 1)`` with ``(exp (-1))``.
-Unfold exp; Case (exist_exp ``-1``); Intros; Simpl; Unfold exp_in in e; Assert H := (alternated_series_ineq [i:nat]``/(INR (fact i))`` x (S O)).
-Cut ``(sum_f_R0 (tg_alt [([i:nat]``/(INR (fact i))``)]) (S (mult (S (S O)) (S O)))) <= x <= (sum_f_R0 (tg_alt [([i:nat]``/(INR (fact i))``)]) (mult (S (S O)) (S O)))``.
-Intro; Elim H0; Clear H0; Intros H0 _; Simpl in H0; Unfold tg_alt in H0; Simpl in H0.
-Replace ``/3`` with ``1*/1+ -1*1*/1+ -1*( -1*1)*/2+ -1*( -1*( -1*1))*/(2+1+1+1+1)``.
-Apply H0.
-Repeat Rewrite Rinv_R1; Repeat Rewrite Rmult_1r; Rewrite Ropp_mul1; Rewrite Rmult_1l; Rewrite Ropp_Ropp; Rewrite Rplus_Ropp_r; Rewrite Rmult_1r; Rewrite Rplus_Ol; Rewrite Rmult_1l; Apply r_Rmult_mult with ``6``.
-Rewrite Rmult_Rplus_distr; Replace ``2+1+1+1+1`` with ``6``.
-Rewrite <- (Rmult_sym ``/6``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1l; Replace ``6`` with ``2*3``.
-Do 2 Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Rewrite (Rmult_sym ``3``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
-Ring.
-DiscrR.
-DiscrR.
-Ring.
-DiscrR.
-Ring.
-DiscrR.
-Apply H.
-Unfold Un_decreasing; Intros; Apply Rle_monotony_contra with ``(INR (fact n))``.
-Apply INR_fact_lt_0.
-Apply Rle_monotony_contra with ``(INR (fact (S n)))``.
-Apply INR_fact_lt_0.
-Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Rewrite Rmult_sym; Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Apply le_INR; Apply fact_growing; Apply le_n_Sn.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Assert H0 := (cv_speed_pow_fact R1); Unfold Un_cv; Unfold Un_cv in H0; Intros; Elim (H0 ? H1); Intros; Exists x0; Intros; Unfold R_dist in H2; Unfold R_dist; Replace ``/(INR (fact n))`` with ``(pow 1 n)/(INR (fact n))``.
-Apply (H2 ? H3).
-Unfold Rdiv; Rewrite pow1; Rewrite Rmult_1l; Reflexivity.
-Unfold infinit_sum in e; Unfold Un_cv tg_alt; Intros; Elim (e ? H0); Intros; Exists x0; Intros; Replace (sum_f_R0 ([i:nat]``(pow ( -1) i)*/(INR (fact i))``) n) with (sum_f_R0 ([i:nat]``/(INR (fact i))*(pow ( -1) i)``) n).
-Apply (H1 ? H2).
-Apply sum_eq; Intros; Apply Rmult_sym.
-Apply r_Rmult_mult with ``(exp 1)``.
-Rewrite <- exp_plus; Rewrite Rplus_Ropp_r; Rewrite exp_0; Rewrite <- Rinv_r_sym.
-Reflexivity.
-Assumption.
-Assumption.
-DiscrR.
-Assumption.
+Lemma exp_le_3 : exp 1 <= 3.
+assert (exp_1 : exp 1 <> 0).
+assert (H0 := exp_pos 1); red in |- *; intro; rewrite H in H0;
+ elim (Rlt_irrefl _ H0).
+apply Rmult_le_reg_l with (/ exp 1).
+apply Rinv_0_lt_compat; apply exp_pos.
+rewrite <- Rinv_l_sym.
+apply Rmult_le_reg_l with (/ 3).
+apply Rinv_0_lt_compat; prove_sup0.
+rewrite Rmult_1_r; rewrite <- (Rmult_comm 3); rewrite <- Rmult_assoc;
+ rewrite <- Rinv_l_sym.
+rewrite Rmult_1_l; replace (/ exp 1) with (exp (-1)).
+unfold exp in |- *; case (exist_exp (-1)); intros; simpl in |- *;
+ unfold exp_in in e;
+ assert (H := alternated_series_ineq (fun i:nat => / INR (fact i)) x 1).
+cut
+ (sum_f_R0 (tg_alt (fun i:nat => / INR (fact i))) (S (2 * 1)) <= x <=
+ sum_f_R0 (tg_alt (fun i:nat => / INR (fact i))) (2 * 1)).
+intro; elim H0; clear H0; intros H0 _; simpl in H0; unfold tg_alt in H0;
+ simpl in H0.
+replace (/ 3) with
+ (1 * / 1 + -1 * 1 * / 1 + -1 * (-1 * 1) * / 2 +
+ -1 * (-1 * (-1 * 1)) * / (2 + 1 + 1 + 1 + 1)).
+apply H0.
+repeat rewrite Rinv_1; repeat rewrite Rmult_1_r;
+ rewrite Ropp_mult_distr_l_reverse; rewrite Rmult_1_l;
+ rewrite Ropp_involutive; rewrite Rplus_opp_r; rewrite Rmult_1_r;
+ rewrite Rplus_0_l; rewrite Rmult_1_l; apply Rmult_eq_reg_l with 6.
+rewrite Rmult_plus_distr_l; replace (2 + 1 + 1 + 1 + 1) with 6.
+rewrite <- (Rmult_comm (/ 6)); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym.
+rewrite Rmult_1_l; replace 6 with 6.
+do 2 rewrite Rmult_assoc; rewrite <- Rinv_r_sym.
+rewrite Rmult_1_r; rewrite (Rmult_comm 3); rewrite <- Rmult_assoc;
+ rewrite <- Rinv_r_sym.
+ring.
+discrR.
+discrR.
+ring.
+discrR.
+ring.
+discrR.
+apply H.
+unfold Un_decreasing in |- *; intros;
+ apply Rmult_le_reg_l with (INR (fact n)).
+apply INR_fact_lt_0.
+apply Rmult_le_reg_l with (INR (fact (S n))).
+apply INR_fact_lt_0.
+rewrite <- Rinv_r_sym.
+rewrite Rmult_1_r; rewrite Rmult_comm; rewrite Rmult_assoc;
+ rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r; apply le_INR; apply fact_le; apply le_n_Sn.
+apply INR_fact_neq_0.
+apply INR_fact_neq_0.
+assert (H0 := cv_speed_pow_fact 1); unfold Un_cv in |- *; unfold Un_cv in H0;
+ intros; elim (H0 _ H1); intros; exists x0; intros;
+ unfold R_dist in H2; unfold R_dist in |- *;
+ replace (/ INR (fact n)) with (1 ^ n / INR (fact n)).
+apply (H2 _ H3).
+unfold Rdiv in |- *; rewrite pow1; rewrite Rmult_1_l; reflexivity.
+unfold infinit_sum in e; unfold Un_cv, tg_alt in |- *; intros; elim (e _ H0);
+ intros; exists x0; intros;
+ replace (sum_f_R0 (fun i:nat => (-1) ^ i * / INR (fact i)) n) with
+ (sum_f_R0 (fun i:nat => / INR (fact i) * (-1) ^ i) n).
+apply (H1 _ H2).
+apply sum_eq; intros; apply Rmult_comm.
+apply Rmult_eq_reg_l with (exp 1).
+rewrite <- exp_plus; rewrite Rplus_opp_r; rewrite exp_0;
+ rewrite <- Rinv_r_sym.
+reflexivity.
+assumption.
+assumption.
+discrR.
+assumption.
Qed.
(******************************************************************)
(* Properties of Exp *)
(******************************************************************)
-Theorem exp_increasing: (x, y : R) ``x<y`` -> ``(exp x)<(exp y)``.
-Intros x y H.
-Assert H0 : (derivable exp).
-Apply derivable_exp.
-Assert H1 := (positive_derivative ? H0).
-Unfold strict_increasing in H1.
-Apply H1.
-Intro.
-Replace (derive_pt exp x0 (H0 x0)) with (exp x0).
-Apply exp_pos.
-Symmetry; Apply derive_pt_eq_0.
-Apply (derivable_pt_lim_exp x0).
-Apply H.
+Theorem exp_increasing : forall x y:R, x < y -> exp x < exp y.
+intros x y H.
+assert (H0 : derivable exp).
+apply derivable_exp.
+assert (H1 := positive_derivative _ H0).
+unfold strict_increasing in H1.
+apply H1.
+intro.
+replace (derive_pt exp x0 (H0 x0)) with (exp x0).
+apply exp_pos.
+symmetry in |- *; apply derive_pt_eq_0.
+apply (derivable_pt_lim_exp x0).
+apply H.
Qed.
-Theorem exp_lt_inv: (x, y : R) ``(exp x)<(exp y)`` -> ``x<y``.
-Intros x y H; Case (total_order x y); [Intros H1 | Intros [H1|H1]].
-Assumption.
-Rewrite H1 in H; Elim (Rlt_antirefl ? H).
-Assert H2 := (exp_increasing ? ? H1).
-Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H H2)).
+Theorem exp_lt_inv : forall x y:R, exp x < exp y -> x < y.
+intros x y H; case (Rtotal_order x y); [ intros H1 | intros [H1| H1] ].
+assumption.
+rewrite H1 in H; elim (Rlt_irrefl _ H).
+assert (H2 := exp_increasing _ _ H1).
+elim (Rlt_irrefl _ (Rlt_trans _ _ _ H H2)).
Qed.
-Lemma exp_ineq1 : (x:R) ``0<x`` -> ``1+x < (exp x)``.
-Intros; Apply Rlt_anti_compatibility with ``-(exp 0)``; Rewrite <- (Rplus_sym (exp x)); Assert H0 := (MVT_cor1 exp R0 x derivable_exp H); Elim H0; Intros; Elim H1; Intros; Unfold Rminus in H2; Rewrite H2; Rewrite Ropp_O; Rewrite Rplus_Or; Replace (derive_pt exp x0 (derivable_exp x0)) with (exp x0).
-Rewrite exp_0; Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Pattern 1 x; Rewrite <- Rmult_1r; Rewrite (Rmult_sym (exp x0)); Apply Rlt_monotony.
-Apply H.
-Rewrite <- exp_0; Apply exp_increasing; Elim H3; Intros; Assumption.
-Symmetry; Apply derive_pt_eq_0; Apply derivable_pt_lim_exp.
+Lemma exp_ineq1 : forall x:R, 0 < x -> 1 + x < exp x.
+intros; apply Rplus_lt_reg_r with (- exp 0); rewrite <- (Rplus_comm (exp x));
+ assert (H0 := MVT_cor1 exp 0 x derivable_exp H); elim H0;
+ intros; elim H1; intros; unfold Rminus in H2; rewrite H2;
+ rewrite Ropp_0; rewrite Rplus_0_r;
+ replace (derive_pt exp x0 (derivable_exp x0)) with (exp x0).
+rewrite exp_0; rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l;
+ pattern x at 1 in |- *; rewrite <- Rmult_1_r; rewrite (Rmult_comm (exp x0));
+ apply Rmult_lt_compat_l.
+apply H.
+rewrite <- exp_0; apply exp_increasing; elim H3; intros; assumption.
+symmetry in |- *; apply derive_pt_eq_0; apply derivable_pt_lim_exp.
Qed.
-Lemma ln_exists1 : (y:R) ``0<y``->``1<=y``->(sigTT R [z:R]``y==(exp z)``).
-Intros; Pose f := [x:R]``(exp x)-y``; Cut ``(f 0)<=0``.
-Intro; Cut (continuity f).
-Intro; Cut ``0<=(f y)``.
-Intro; Cut ``(f 0)*(f y)<=0``.
-Intro; Assert X := (IVT_cor f R0 y H2 (Rlt_le ? ? H) H4); Elim X; Intros t H5; Apply existTT with t; Elim H5; Intros; Unfold f in H7; Apply Rminus_eq_right; Exact H7.
-Pattern 2 R0; Rewrite <- (Rmult_Or (f y)); Rewrite (Rmult_sym (f R0)); Apply Rle_monotony; Assumption.
-Unfold f; Apply Rle_anti_compatibility with y; Left; Apply Rlt_trans with ``1+y``.
-Rewrite <- (Rplus_sym y); Apply Rlt_compatibility; Apply Rlt_R0_R1.
-Replace ``y+((exp y)-y)`` with (exp y); [Apply (exp_ineq1 y H) | Ring].
-Unfold f; Change (continuity (minus_fct exp (fct_cte y))); Apply continuity_minus; [Apply derivable_continuous; Apply derivable_exp | Apply derivable_continuous; Apply derivable_const].
-Unfold f; Rewrite exp_0; Apply Rle_anti_compatibility with y; Rewrite Rplus_Or; Replace ``y+(1-y)`` with R1; [Apply H0 | Ring].
+Lemma ln_exists1 : forall y:R, 0 < y -> 1 <= y -> sigT (fun z:R => y = exp z).
+intros; pose (f := fun x:R => exp x - y); cut (f 0 <= 0).
+intro; cut (continuity f).
+intro; cut (0 <= f y).
+intro; cut (f 0 * f y <= 0).
+intro; assert (X := IVT_cor f 0 y H2 (Rlt_le _ _ H) H4); elim X; intros t H5;
+ apply existT with t; elim H5; intros; unfold f in H7;
+ apply Rminus_diag_uniq_sym; exact H7.
+pattern 0 at 2 in |- *; rewrite <- (Rmult_0_r (f y));
+ rewrite (Rmult_comm (f 0)); apply Rmult_le_compat_l;
+ assumption.
+unfold f in |- *; apply Rplus_le_reg_l with y; left;
+ apply Rlt_trans with (1 + y).
+rewrite <- (Rplus_comm y); apply Rplus_lt_compat_l; apply Rlt_0_1.
+replace (y + (exp y - y)) with (exp y); [ apply (exp_ineq1 y H) | ring ].
+unfold f in |- *; change (continuity (exp - fct_cte y)) in |- *;
+ apply continuity_minus;
+ [ apply derivable_continuous; apply derivable_exp
+ | apply derivable_continuous; apply derivable_const ].
+unfold f in |- *; rewrite exp_0; apply Rplus_le_reg_l with y;
+ rewrite Rplus_0_r; replace (y + (1 - y)) with 1; [ apply H0 | ring ].
Qed.
(**********)
-Lemma ln_exists : (y:R) ``0<y`` -> (sigTT R [z:R]``y==(exp z)``).
-Intros; Case (total_order_Rle R1 y); Intro.
-Apply (ln_exists1 ? H r).
-Assert H0 : ``1<=/y``.
-Apply Rle_monotony_contra with y.
-Apply H.
-Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Left; Apply (not_Rle ? ? n).
-Red; Intro; Rewrite H0 in H; Elim (Rlt_antirefl ? H).
-Assert H1 : ``0</y``.
-Apply Rlt_Rinv; Apply H.
-Assert H2 := (ln_exists1 ? H1 H0); Elim H2; Intros; Apply existTT with ``-x``; Apply r_Rmult_mult with ``(exp x)/y``.
-Unfold Rdiv; Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Rewrite <- (Rmult_sym ``/y``); Rewrite Rmult_assoc; Rewrite <- exp_plus; Rewrite Rplus_Ropp_r; Rewrite exp_0; Rewrite Rmult_1r; Symmetry; Apply p.
-Red; Intro; Rewrite H3 in H; Elim (Rlt_antirefl ? H).
-Unfold Rdiv; Apply prod_neq_R0.
-Assert H3 := (exp_pos x); Red; Intro; Rewrite H4 in H3; Elim (Rlt_antirefl ? H3).
-Apply Rinv_neq_R0; Red; Intro; Rewrite H3 in H; Elim (Rlt_antirefl ? H).
+Lemma ln_exists : forall y:R, 0 < y -> sigT (fun z:R => y = exp z).
+intros; case (Rle_dec 1 y); intro.
+apply (ln_exists1 _ H r).
+assert (H0 : 1 <= / y).
+apply Rmult_le_reg_l with y.
+apply H.
+rewrite <- Rinv_r_sym.
+rewrite Rmult_1_r; left; apply (Rnot_le_lt _ _ n).
+red in |- *; intro; rewrite H0 in H; elim (Rlt_irrefl _ H).
+assert (H1 : 0 < / y).
+apply Rinv_0_lt_compat; apply H.
+assert (H2 := ln_exists1 _ H1 H0); elim H2; intros; apply existT with (- x);
+ apply Rmult_eq_reg_l with (exp x / y).
+unfold Rdiv in |- *; rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r; rewrite <- (Rmult_comm (/ y)); rewrite Rmult_assoc;
+ rewrite <- exp_plus; rewrite Rplus_opp_r; rewrite exp_0;
+ rewrite Rmult_1_r; symmetry in |- *; apply p.
+red in |- *; intro; rewrite H3 in H; elim (Rlt_irrefl _ H).
+unfold Rdiv in |- *; apply prod_neq_R0.
+assert (H3 := exp_pos x); red in |- *; intro; rewrite H4 in H3;
+ elim (Rlt_irrefl _ H3).
+apply Rinv_neq_0_compat; red in |- *; intro; rewrite H3 in H;
+ elim (Rlt_irrefl _ H).
Qed.
(* Definition of log R+* -> R *)
-Definition Rln [y:posreal] : R := Cases (ln_exists (pos y) (RIneq.cond_pos y)) of (existTT a b) => a end.
+Definition Rln (y:posreal) : R :=
+ match ln_exists (pos y) (cond_pos y) with
+ | existT a b => a
+ end.
(* Extension on R *)
-Definition ln : R->R := [x:R](Cases (total_order_Rlt R0 x) of
- (leftT a) => (Rln (mkposreal x a))
- | (rightT a) => R0 end).
+Definition ln (x:R) : R :=
+ match Rlt_dec 0 x with
+ | left a => Rln (mkposreal x a)
+ | right a => 0
+ end.
-Lemma exp_ln : (x : R) ``0<x`` -> (exp (ln x)) == x.
-Intros; Unfold ln; Case (total_order_Rlt R0 x); Intro.
-Unfold Rln; Case (ln_exists (mkposreal x r) (RIneq.cond_pos (mkposreal x r))); Intros.
-Simpl in e; Symmetry; Apply e.
-Elim n; Apply H.
+Lemma exp_ln : forall x:R, 0 < x -> exp (ln x) = x.
+intros; unfold ln in |- *; case (Rlt_dec 0 x); intro.
+unfold Rln in |- *;
+ case (ln_exists (mkposreal x r) (cond_pos (mkposreal x r)));
+ intros.
+simpl in e; symmetry in |- *; apply e.
+elim n; apply H.
Qed.
-Theorem exp_inv: (x, y : R) (exp x) == (exp y) -> x == y.
-Intros x y H; Case (total_order x y); [Intros H1 | Intros [H1|H1]]; Auto; Assert H2 := (exp_increasing ? ? H1); Rewrite H in H2; Elim (Rlt_antirefl ? H2).
+Theorem exp_inv : forall x y:R, exp x = exp y -> x = y.
+intros x y H; case (Rtotal_order x y); [ intros H1 | intros [H1| H1] ]; auto;
+ assert (H2 := exp_increasing _ _ H1); rewrite H in H2;
+ elim (Rlt_irrefl _ H2).
Qed.
-Theorem exp_Ropp: (x : R) ``(exp (-x)) == /(exp x)``.
-Intros x; Assert H : ``(exp x)<>0``.
-Assert H := (exp_pos x); Red; Intro; Rewrite H0 in H; Elim (Rlt_antirefl ? H).
-Apply r_Rmult_mult with r := (exp x).
-Rewrite <- exp_plus; Rewrite Rplus_Ropp_r; Rewrite exp_0.
-Apply Rinv_r_sym.
-Apply H.
-Apply H.
+Theorem exp_Ropp : forall x:R, exp (- x) = / exp x.
+intros x; assert (H : exp x <> 0).
+assert (H := exp_pos x); red in |- *; intro; rewrite H0 in H;
+ elim (Rlt_irrefl _ H).
+apply Rmult_eq_reg_l with (r := exp x).
+rewrite <- exp_plus; rewrite Rplus_opp_r; rewrite exp_0.
+apply Rinv_r_sym.
+apply H.
+apply H.
Qed.
(******************************************************************)
(* Properties of Ln *)
(******************************************************************)
-Theorem ln_increasing:
- (x, y : R) ``0<x`` -> ``x<y`` -> ``(ln x) < (ln y)``.
-Intros x y H H0; Apply exp_lt_inv.
-Repeat Rewrite exp_ln.
-Apply H0.
-Apply Rlt_trans with x; Assumption.
-Apply H.
+Theorem ln_increasing : forall x y:R, 0 < x -> x < y -> ln x < ln y.
+intros x y H H0; apply exp_lt_inv.
+repeat rewrite exp_ln.
+apply H0.
+apply Rlt_trans with x; assumption.
+apply H.
Qed.
-Theorem ln_exp: (x : R) (ln (exp x)) == x.
-Intros x; Apply exp_inv.
-Apply exp_ln.
-Apply exp_pos.
+Theorem ln_exp : forall x:R, ln (exp x) = x.
+intros x; apply exp_inv.
+apply exp_ln.
+apply exp_pos.
Qed.
-Theorem ln_1: ``(ln 1) == 0``.
-Rewrite <- exp_0; Rewrite ln_exp; Reflexivity.
+Theorem ln_1 : ln 1 = 0.
+rewrite <- exp_0; rewrite ln_exp; reflexivity.
Qed.
-Theorem ln_lt_inv:
- (x, y : R) ``0<x`` -> ``0<y`` -> ``(ln x)<(ln y)`` -> ``x<y``.
-Intros x y H H0 H1; Rewrite <- (exp_ln x); Try Rewrite <- (exp_ln y).
-Apply exp_increasing; Apply H1.
-Assumption.
-Assumption.
+Theorem ln_lt_inv : forall x y:R, 0 < x -> 0 < y -> ln x < ln y -> x < y.
+intros x y H H0 H1; rewrite <- (exp_ln x); try rewrite <- (exp_ln y).
+apply exp_increasing; apply H1.
+assumption.
+assumption.
Qed.
-Theorem ln_inv: (x, y : R) ``0<x`` -> ``0<y`` -> (ln x) == (ln y) -> x == y.
-Intros x y H H0 H'0; Case (total_order x y); [Intros H1 | Intros [H1|H1]]; Auto.
-Assert H2 := (ln_increasing ? ? H H1); Rewrite H'0 in H2; Elim (Rlt_antirefl ? H2).
-Assert H2 := (ln_increasing ? ? H0 H1); Rewrite H'0 in H2; Elim (Rlt_antirefl ? H2).
+Theorem ln_inv : forall x y:R, 0 < x -> 0 < y -> ln x = ln y -> x = y.
+intros x y H H0 H'0; case (Rtotal_order x y); [ intros H1 | intros [H1| H1] ];
+ auto.
+assert (H2 := ln_increasing _ _ H H1); rewrite H'0 in H2;
+ elim (Rlt_irrefl _ H2).
+assert (H2 := ln_increasing _ _ H0 H1); rewrite H'0 in H2;
+ elim (Rlt_irrefl _ H2).
Qed.
-Theorem ln_mult: (x, y : R) ``0<x`` -> ``0<y`` -> ``(ln (x*y)) == (ln x)+(ln y)``.
-Intros x y H H0; Apply exp_inv.
-Rewrite exp_plus.
-Repeat Rewrite exp_ln.
-Reflexivity.
-Assumption.
-Assumption.
-Apply Rmult_lt_pos; Assumption.
+Theorem ln_mult : forall x y:R, 0 < x -> 0 < y -> ln (x * y) = ln x + ln y.
+intros x y H H0; apply exp_inv.
+rewrite exp_plus.
+repeat rewrite exp_ln.
+reflexivity.
+assumption.
+assumption.
+apply Rmult_lt_0_compat; assumption.
Qed.
-Theorem ln_Rinv: (x : R) ``0<x`` -> ``(ln (/x)) == -(ln x)``.
-Intros x H; Apply exp_inv; Repeat (Rewrite exp_ln Orelse Rewrite exp_Ropp).
-Reflexivity.
-Assumption.
-Apply Rlt_Rinv; Assumption.
+Theorem ln_Rinv : forall x:R, 0 < x -> ln (/ x) = - ln x.
+intros x H; apply exp_inv; repeat rewrite exp_ln || rewrite exp_Ropp.
+reflexivity.
+assumption.
+apply Rinv_0_lt_compat; assumption.
Qed.
-Theorem ln_continue:
- (y : R) ``0<y`` -> (continue_in ln [x : R] (Rlt R0 x) y).
-Intros y H.
-Unfold continue_in limit1_in limit_in; Intros eps Heps.
-Cut (Rlt R1 (exp eps)); [Intros H1 | Idtac].
-Cut (Rlt (exp (Ropp eps)) R1); [Intros H2 | Idtac].
-Exists
- (Rmin (Rmult y (Rminus (exp eps) R1)) (Rmult y (Rminus R1 (exp (Ropp eps)))));
- Split.
-Red; Apply P_Rmin.
-Apply Rmult_lt_pos.
-Assumption.
-Apply Rlt_anti_compatibility with R1.
-Rewrite Rplus_Or; Replace ``(1+((exp eps)-1))`` with (exp eps); [Apply H1 | Ring].
-Apply Rmult_lt_pos.
-Assumption.
-Apply Rlt_anti_compatibility with ``(exp (-eps))``.
-Rewrite Rplus_Or; Replace ``(exp ( -eps))+(1-(exp ( -eps)))`` with R1; [Apply H2 | Ring].
-Unfold dist R_met R_dist; Simpl.
-Intros x ((H3, H4), H5).
-Cut (Rmult y (Rmult x (Rinv y))) == x.
-Intro Hxyy.
-Replace (Rminus (ln x) (ln y)) with (ln (Rmult x (Rinv y))).
-Case (total_order x y); [Intros Hxy | Intros [Hxy|Hxy]].
-Rewrite Rabsolu_left.
-Apply Ropp_Rlt; Rewrite Ropp_Ropp.
-Apply exp_lt_inv.
-Rewrite exp_ln.
-Apply Rlt_monotony_contra with z := y.
-Apply H.
-Rewrite Hxyy.
-Apply Ropp_Rlt.
-Apply Rlt_anti_compatibility with r := y.
-Replace (Rplus y (Ropp (Rmult y (exp (Ropp eps)))))
- with (Rmult y (Rminus R1 (exp (Ropp eps)))); [Idtac | Ring].
-Replace (Rplus y (Ropp x)) with (Rabsolu (Rminus x y)); [Idtac | Ring].
-Apply Rlt_le_trans with 1 := H5; Apply Rmin_r.
-Rewrite Rabsolu_left; [Ring | Idtac].
-Apply (Rlt_minus ? ? Hxy).
-Apply Rmult_lt_pos; [Apply H3 | Apply (Rlt_Rinv ? H)].
-Rewrite <- ln_1.
-Apply ln_increasing.
-Apply Rmult_lt_pos; [Apply H3 | Apply (Rlt_Rinv ? H)].
-Apply Rlt_monotony_contra with z := y.
-Apply H.
-Rewrite Hxyy; Rewrite Rmult_1r; Apply Hxy.
-Rewrite Hxy; Rewrite Rinv_r.
-Rewrite ln_1; Rewrite Rabsolu_R0; Apply Heps.
-Red; Intro; Rewrite H0 in H; Elim (Rlt_antirefl ? H).
-Rewrite Rabsolu_right.
-Apply exp_lt_inv.
-Rewrite exp_ln.
-Apply Rlt_monotony_contra with z := y.
-Apply H.
-Rewrite Hxyy.
-Apply Rlt_anti_compatibility with r := (Ropp y).
-Replace (Rplus (Ropp y) (Rmult y (exp eps)))
- with (Rmult y (Rminus (exp eps) R1)); [Idtac | Ring].
-Replace (Rplus (Ropp y) x) with (Rabsolu (Rminus x y)); [Idtac | Ring].
-Apply Rlt_le_trans with 1 := H5; Apply Rmin_l.
-Rewrite Rabsolu_right; [Ring | Idtac].
-Left; Apply (Rgt_minus ? ? Hxy).
-Apply Rmult_lt_pos; [Apply H3 | Apply (Rlt_Rinv ? H)].
-Rewrite <- ln_1.
-Apply Rgt_ge; Red; Apply ln_increasing.
-Apply Rlt_R0_R1.
-Apply Rlt_monotony_contra with z := y.
-Apply H.
-Rewrite Hxyy; Rewrite Rmult_1r; Apply Hxy.
-Rewrite ln_mult.
-Rewrite ln_Rinv.
-Ring.
-Assumption.
-Assumption.
-Apply Rlt_Rinv; Assumption.
-Rewrite (Rmult_sym x); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
-Ring.
-Red; Intro; Rewrite H0 in H; Elim (Rlt_antirefl ? H).
-Apply Rlt_monotony_contra with (exp eps).
-Apply exp_pos.
-Rewrite <- exp_plus; Rewrite Rmult_1r; Rewrite Rplus_Ropp_r; Rewrite exp_0; Apply H1.
-Rewrite <- exp_0.
-Apply exp_increasing; Apply Heps.
+Theorem ln_continue :
+ forall y:R, 0 < y -> continue_in ln (fun x:R => 0 < x) y.
+intros y H.
+unfold continue_in, limit1_in, limit_in in |- *; intros eps Heps.
+cut (1 < exp eps); [ intros H1 | idtac ].
+cut (exp (- eps) < 1); [ intros H2 | idtac ].
+exists (Rmin (y * (exp eps - 1)) (y * (1 - exp (- eps)))); split.
+red in |- *; apply P_Rmin.
+apply Rmult_lt_0_compat.
+assumption.
+apply Rplus_lt_reg_r with 1.
+rewrite Rplus_0_r; replace (1 + (exp eps - 1)) with (exp eps);
+ [ apply H1 | ring ].
+apply Rmult_lt_0_compat.
+assumption.
+apply Rplus_lt_reg_r with (exp (- eps)).
+rewrite Rplus_0_r; replace (exp (- eps) + (1 - exp (- eps))) with 1;
+ [ apply H2 | ring ].
+unfold dist, R_met, R_dist in |- *; simpl in |- *.
+intros x [[H3 H4] H5].
+cut (y * (x * / y) = x).
+intro Hxyy.
+replace (ln x - ln y) with (ln (x * / y)).
+case (Rtotal_order x y); [ intros Hxy | intros [Hxy| Hxy] ].
+rewrite Rabs_left.
+apply Ropp_lt_cancel; rewrite Ropp_involutive.
+apply exp_lt_inv.
+rewrite exp_ln.
+apply Rmult_lt_reg_l with (r := y).
+apply H.
+rewrite Hxyy.
+apply Ropp_lt_cancel.
+apply Rplus_lt_reg_r with (r := y).
+replace (y + - (y * exp (- eps))) with (y * (1 - exp (- eps)));
+ [ idtac | ring ].
+replace (y + - x) with (Rabs (x - y)); [ idtac | ring ].
+apply Rlt_le_trans with (1 := H5); apply Rmin_r.
+rewrite Rabs_left; [ ring | idtac ].
+apply (Rlt_minus _ _ Hxy).
+apply Rmult_lt_0_compat; [ apply H3 | apply (Rinv_0_lt_compat _ H) ].
+rewrite <- ln_1.
+apply ln_increasing.
+apply Rmult_lt_0_compat; [ apply H3 | apply (Rinv_0_lt_compat _ H) ].
+apply Rmult_lt_reg_l with (r := y).
+apply H.
+rewrite Hxyy; rewrite Rmult_1_r; apply Hxy.
+rewrite Hxy; rewrite Rinv_r.
+rewrite ln_1; rewrite Rabs_R0; apply Heps.
+red in |- *; intro; rewrite H0 in H; elim (Rlt_irrefl _ H).
+rewrite Rabs_right.
+apply exp_lt_inv.
+rewrite exp_ln.
+apply Rmult_lt_reg_l with (r := y).
+apply H.
+rewrite Hxyy.
+apply Rplus_lt_reg_r with (r := - y).
+replace (- y + y * exp eps) with (y * (exp eps - 1)); [ idtac | ring ].
+replace (- y + x) with (Rabs (x - y)); [ idtac | ring ].
+apply Rlt_le_trans with (1 := H5); apply Rmin_l.
+rewrite Rabs_right; [ ring | idtac ].
+left; apply (Rgt_minus _ _ Hxy).
+apply Rmult_lt_0_compat; [ apply H3 | apply (Rinv_0_lt_compat _ H) ].
+rewrite <- ln_1.
+apply Rgt_ge; red in |- *; apply ln_increasing.
+apply Rlt_0_1.
+apply Rmult_lt_reg_l with (r := y).
+apply H.
+rewrite Hxyy; rewrite Rmult_1_r; apply Hxy.
+rewrite ln_mult.
+rewrite ln_Rinv.
+ring.
+assumption.
+assumption.
+apply Rinv_0_lt_compat; assumption.
+rewrite (Rmult_comm x); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym.
+ring.
+red in |- *; intro; rewrite H0 in H; elim (Rlt_irrefl _ H).
+apply Rmult_lt_reg_l with (exp eps).
+apply exp_pos.
+rewrite <- exp_plus; rewrite Rmult_1_r; rewrite Rplus_opp_r; rewrite exp_0;
+ apply H1.
+rewrite <- exp_0.
+apply exp_increasing; apply Heps.
Qed.
(******************************************************************)
(* Definition of Rpower *)
(******************************************************************)
-Definition Rpower := [x : R] [y : R] ``(exp (y*(ln x)))``.
+Definition Rpower (x y:R) := exp (y * ln x).
-Infix Local "^R" Rpower (at level 2, left associativity) : R_scope.
+Infix Local "^R" := Rpower (at level 30, left associativity) : R_scope.
(******************************************************************)
(* Properties of Rpower *)
(******************************************************************)
-Theorem Rpower_plus:
- (x, y, z : R) ``(Rpower z (x+y)) == (Rpower z x)*(Rpower z y)``.
-Intros x y z; Unfold Rpower.
-Rewrite Rmult_Rplus_distrl; Rewrite exp_plus; Auto.
+Theorem Rpower_plus : forall x y z:R, z ^R (x + y) = z ^R x * z ^R y.
+intros x y z; unfold Rpower in |- *.
+rewrite Rmult_plus_distr_r; rewrite exp_plus; auto.
Qed.
-Theorem Rpower_mult:
- (x, y, z : R) ``(Rpower (Rpower x y) z) == (Rpower x (y*z))``.
-Intros x y z; Unfold Rpower.
-Rewrite ln_exp.
-Replace (Rmult z (Rmult y (ln x))) with (Rmult (Rmult y z) (ln x)).
-Reflexivity.
-Ring.
+Theorem Rpower_mult : forall x y z:R, x ^R y ^R z = x ^R (y * z).
+intros x y z; unfold Rpower in |- *.
+rewrite ln_exp.
+replace (z * (y * ln x)) with (y * z * ln x).
+reflexivity.
+ring.
Qed.
-Theorem Rpower_O: (x : R) ``0<x`` -> ``(Rpower x 0) == 1``.
-Intros x H; Unfold Rpower.
-Rewrite Rmult_Ol; Apply exp_0.
+Theorem Rpower_O : forall x:R, 0 < x -> x ^R 0 = 1.
+intros x H; unfold Rpower in |- *.
+rewrite Rmult_0_l; apply exp_0.
Qed.
-Theorem Rpower_1: (x : R) ``0<x`` -> ``(Rpower x 1) == x``.
-Intros x H; Unfold Rpower.
-Rewrite Rmult_1l; Apply exp_ln; Apply H.
+Theorem Rpower_1 : forall x:R, 0 < x -> x ^R 1 = x.
+intros x H; unfold Rpower in |- *.
+rewrite Rmult_1_l; apply exp_ln; apply H.
Qed.
-Theorem Rpower_pow:
- (n : nat) (x : R) ``0<x`` -> (Rpower x (INR n)) == (pow x n).
-Intros n; Elim n; Simpl; Auto; Fold INR.
-Intros x H; Apply Rpower_O; Auto.
-Intros n1; Case n1.
-Intros H x H0; Simpl; Rewrite Rmult_1r; Apply Rpower_1; Auto.
-Intros n0 H x H0; Rewrite Rpower_plus; Rewrite H; Try Rewrite Rpower_1; Try Apply Rmult_sym Orelse Assumption.
+Theorem Rpower_pow : forall (n:nat) (x:R), 0 < x -> x ^R INR n = x ^ n.
+intros n; elim n; simpl in |- *; auto; fold INR in |- *.
+intros x H; apply Rpower_O; auto.
+intros n1; case n1.
+intros H x H0; simpl in |- *; rewrite Rmult_1_r; apply Rpower_1; auto.
+intros n0 H x H0; rewrite Rpower_plus; rewrite H; try rewrite Rpower_1;
+ try apply Rmult_comm || assumption.
Qed.
-Theorem Rpower_lt: (x, y, z : R) ``1<x`` -> ``0<=y`` -> ``y<z`` -> ``(Rpower x y) < (Rpower x z)``.
-Intros x y z H H0 H1.
-Unfold Rpower.
-Apply exp_increasing.
-Apply Rlt_monotony_r.
-Rewrite <- ln_1; Apply ln_increasing.
-Apply Rlt_R0_R1.
-Apply H.
-Apply H1.
+Theorem Rpower_lt :
+ forall x y z:R, 1 < x -> 0 <= y -> y < z -> x ^R y < x ^R z.
+intros x y z H H0 H1.
+unfold Rpower in |- *.
+apply exp_increasing.
+apply Rmult_lt_compat_r.
+rewrite <- ln_1; apply ln_increasing.
+apply Rlt_0_1.
+apply H.
+apply H1.
Qed.
-Theorem Rpower_sqrt: (x : R) ``0<x`` -> ``(Rpower x (/2)) == (sqrt x)``.
-Intros x H.
-Apply ln_inv.
-Unfold Rpower; Apply exp_pos.
-Apply sqrt_lt_R0; Apply H.
-Apply r_Rmult_mult with (INR (S (S O))).
-Apply exp_inv.
-Fold Rpower.
-Cut (Rpower (Rpower x (Rinv (Rplus R1 R1))) (INR (S (S O)))) == (Rpower (sqrt x) (INR (S (S O)))).
-Unfold Rpower; Auto.
-Rewrite Rpower_mult.
-Rewrite Rinv_l.
-Replace R1 with (INR (S O)); Auto.
-Repeat Rewrite Rpower_pow; Simpl.
-Pattern 1 x; Rewrite <- (sqrt_sqrt x (Rlt_le ? ? H)).
-Ring.
-Apply sqrt_lt_R0; Apply H.
-Apply H.
-Apply not_O_INR; Discriminate.
-Apply not_O_INR; Discriminate.
+Theorem Rpower_sqrt : forall x:R, 0 < x -> x ^R (/ 2) = sqrt x.
+intros x H.
+apply ln_inv.
+unfold Rpower in |- *; apply exp_pos.
+apply sqrt_lt_R0; apply H.
+apply Rmult_eq_reg_l with (INR 2).
+apply exp_inv.
+fold Rpower in |- *.
+cut (x ^R (/ 2) ^R INR 2 = sqrt x ^R INR 2).
+unfold Rpower in |- *; auto.
+rewrite Rpower_mult.
+rewrite Rinv_l.
+replace 1 with (INR 1); auto.
+repeat rewrite Rpower_pow; simpl in |- *.
+pattern x at 1 in |- *; rewrite <- (sqrt_sqrt x (Rlt_le _ _ H)).
+ring.
+apply sqrt_lt_R0; apply H.
+apply H.
+apply not_O_INR; discriminate.
+apply not_O_INR; discriminate.
Qed.
-Theorem Rpower_Ropp: (x, y : R) ``(Rpower x (-y)) == /(Rpower x y)``.
-Unfold Rpower.
-Intros x y; Rewrite Ropp_mul1.
-Apply exp_Ropp.
+Theorem Rpower_Ropp : forall x y:R, x ^R (- y) = / x ^R y.
+unfold Rpower in |- *.
+intros x y; rewrite Ropp_mult_distr_l_reverse.
+apply exp_Ropp.
Qed.
-Theorem Rle_Rpower: (e,n,m : R) ``1<e`` -> ``0<=n`` -> ``n<=m`` -> ``(Rpower e n)<=(Rpower e m)``.
-Intros e n m H H0 H1; Case H1.
-Intros H2; Left; Apply Rpower_lt; Assumption.
-Intros H2; Rewrite H2; Right; Reflexivity.
+Theorem Rle_Rpower :
+ forall e n m:R, 1 < e -> 0 <= n -> n <= m -> e ^R n <= e ^R m.
+intros e n m H H0 H1; case H1.
+intros H2; left; apply Rpower_lt; assumption.
+intros H2; rewrite H2; right; reflexivity.
Qed.
-Theorem ln_lt_2: ``/2<(ln 2)``.
-Apply Rlt_monotony_contra with z := (Rplus R1 R1).
-Sup0.
-Rewrite Rinv_r.
-Apply exp_lt_inv.
-Apply Rle_lt_trans with 1 := exp_le_3.
-Change (Rlt (Rplus R1 (Rplus R1 R1)) (Rpower (Rplus R1 R1) (Rplus R1 R1))).
-Repeat Rewrite Rpower_plus; Repeat Rewrite Rpower_1.
-Repeat Rewrite Rmult_Rplus_distrl; Repeat Rewrite Rmult_Rplus_distr;
- Repeat Rewrite Rmult_1l.
-Pattern 1 ``3``; Rewrite <- Rplus_Or; Replace ``2+2`` with ``3+1``; [Apply Rlt_compatibility; Apply Rlt_R0_R1 | Ring].
-Sup0.
-DiscrR.
+Theorem ln_lt_2 : / 2 < ln 2.
+apply Rmult_lt_reg_l with (r := 2).
+prove_sup0.
+rewrite Rinv_r.
+apply exp_lt_inv.
+apply Rle_lt_trans with (1 := exp_le_3).
+change (3 < 2 ^R 2) in |- *.
+repeat rewrite Rpower_plus; repeat rewrite Rpower_1.
+repeat rewrite Rmult_plus_distr_r; repeat rewrite Rmult_plus_distr_l;
+ repeat rewrite Rmult_1_l.
+pattern 3 at 1 in |- *; rewrite <- Rplus_0_r; replace (2 + 2) with (3 + 1);
+ [ apply Rplus_lt_compat_l; apply Rlt_0_1 | ring ].
+prove_sup0.
+discrR.
Qed.
(**************************************)
(* Differentiability of Ln and Rpower *)
(**************************************)
-Theorem limit1_ext: (f, g : R -> R)(D : R -> Prop)(l, x : R) ((x : R) (D x) -> (f x) == (g x)) -> (limit1_in f D l x) -> (limit1_in g D l x).
-Intros f g D l x H; Unfold limit1_in limit_in.
-Intros H0 eps H1; Case (H0 eps); Auto.
-Intros x0 (H2, H3); Exists x0; Split; Auto.
-Intros x1 (H4, H5); Rewrite <- H; Auto.
+Theorem limit1_ext :
+ forall (f g:R -> R) (D:R -> Prop) (l x:R),
+ (forall x:R, D x -> f x = g x) -> limit1_in f D l x -> limit1_in g D l x.
+intros f g D l x H; unfold limit1_in, limit_in in |- *.
+intros H0 eps H1; case (H0 eps); auto.
+intros x0 [H2 H3]; exists x0; split; auto.
+intros x1 [H4 H5]; rewrite <- H; auto.
Qed.
-Theorem limit1_imp: (f : R -> R)(D, D1 : R -> Prop)(l, x : R) ((x : R) (D1 x) -> (D x)) -> (limit1_in f D l x) -> (limit1_in f D1 l x).
-Intros f D D1 l x H; Unfold limit1_in limit_in.
-Intros H0 eps H1; Case (H0 eps H1); Auto.
-Intros alpha (H2, H3); Exists alpha; Split; Auto.
-Intros d (H4, H5); Apply H3; Split; Auto.
+Theorem limit1_imp :
+ forall (f:R -> R) (D D1:R -> Prop) (l x:R),
+ (forall x:R, D1 x -> D x) -> limit1_in f D l x -> limit1_in f D1 l x.
+intros f D D1 l x H; unfold limit1_in, limit_in in |- *.
+intros H0 eps H1; case (H0 eps H1); auto.
+intros alpha [H2 H3]; exists alpha; split; auto.
+intros d [H4 H5]; apply H3; split; auto.
Qed.
-Theorem Rinv_Rdiv: (x, y : R) ``x<>0`` -> ``y<>0`` -> ``/(x/y) == y/x``.
-Intros x y H1 H2; Unfold Rdiv; Rewrite Rinv_Rmult.
-Rewrite Rinv_Rinv.
-Apply Rmult_sym.
-Assumption.
-Assumption.
-Apply Rinv_neq_R0; Assumption.
+Theorem Rinv_Rdiv : forall x y:R, x <> 0 -> y <> 0 -> / (x / y) = y / x.
+intros x y H1 H2; unfold Rdiv in |- *; rewrite Rinv_mult_distr.
+rewrite Rinv_involutive.
+apply Rmult_comm.
+assumption.
+assumption.
+apply Rinv_neq_0_compat; assumption.
Qed.
-Theorem Dln: (y : R) ``0<y`` -> (D_in ln Rinv [x:R]``0<x`` y).
-Intros y Hy; Unfold D_in.
-Apply limit1_ext with f := [x : R](Rinv (Rdiv (Rminus (exp (ln x)) (exp (ln y))) (Rminus (ln x) (ln y)))).
-Intros x (HD1, HD2); Repeat Rewrite exp_ln.
-Unfold Rdiv; Rewrite Rinv_Rmult.
-Rewrite Rinv_Rinv.
-Apply Rmult_sym.
-Apply Rminus_eq_contra.
-Red; Intros H2; Case HD2.
-Symmetry; Apply (ln_inv ? ? HD1 Hy H2).
-Apply Rminus_eq_contra; Apply (not_sym ? ? HD2).
-Apply Rinv_neq_R0; Apply Rminus_eq_contra; Red; Intros H2; Case HD2; Apply ln_inv; Auto.
-Assumption.
-Assumption.
-Apply limit_inv with f := [x : R] (Rdiv (Rminus (exp (ln x)) (exp (ln y))) (Rminus (ln x) (ln y))).
-Apply limit1_imp with f := [x : R] ([x : R] (Rdiv (Rminus (exp x) (exp (ln y))) (Rminus x (ln y))) (ln x)) D := (Dgf (D_x [x : R] (Rlt R0 x) y) (D_x [x : R] True (ln y)) ln).
-Intros x (H1, H2); Split.
-Split; Auto.
-Split; Auto.
-Red; Intros H3; Case H2; Apply ln_inv; Auto.
-Apply limit_comp with l := (ln y) g := [x : R] (Rdiv (Rminus (exp x) (exp (ln y))) (Rminus x (ln y))) f := ln.
-Apply ln_continue; Auto.
-Assert H0 := (derivable_pt_lim_exp (ln y)); Unfold derivable_pt_lim in H0; Unfold limit1_in; Unfold limit_in; Simpl; Unfold R_dist; Intros; Elim (H0 ? H); Intros; Exists (pos x); Split.
-Apply (RIneq.cond_pos x).
-Intros; Pattern 3 y; Rewrite <- exp_ln.
-Pattern 1 x0; Replace x0 with ``(ln y)+(x0-(ln y))``; [Idtac | Ring].
-Apply H1.
-Elim H2; Intros H3 _; Unfold D_x in H3; Elim H3; Clear H3; Intros _ H3; Apply Rminus_eq_contra; Apply not_sym; Apply H3.
-Elim H2; Clear H2; Intros _ H2; Apply H2.
-Assumption.
-Red; Intro; Rewrite H in Hy; Elim (Rlt_antirefl ? Hy).
+Theorem Dln : forall y:R, 0 < y -> D_in ln Rinv (fun x:R => 0 < x) y.
+intros y Hy; unfold D_in in |- *.
+apply limit1_ext with
+ (f := fun x:R => / ((exp (ln x) - exp (ln y)) / (ln x - ln y))).
+intros x [HD1 HD2]; repeat rewrite exp_ln.
+unfold Rdiv in |- *; rewrite Rinv_mult_distr.
+rewrite Rinv_involutive.
+apply Rmult_comm.
+apply Rminus_eq_contra.
+red in |- *; intros H2; case HD2.
+symmetry in |- *; apply (ln_inv _ _ HD1 Hy H2).
+apply Rminus_eq_contra; apply (sym_not_eq HD2).
+apply Rinv_neq_0_compat; apply Rminus_eq_contra; red in |- *; intros H2;
+ case HD2; apply ln_inv; auto.
+assumption.
+assumption.
+apply limit_inv with
+ (f := fun x:R => (exp (ln x) - exp (ln y)) / (ln x - ln y)).
+apply limit1_imp with
+ (f := fun x:R => (fun x:R => (exp x - exp (ln y)) / (x - ln y)) (ln x))
+ (D := Dgf (D_x (fun x:R => 0 < x) y) (D_x (fun x:R => True) (ln y)) ln).
+intros x [H1 H2]; split.
+split; auto.
+split; auto.
+red in |- *; intros H3; case H2; apply ln_inv; auto.
+apply limit_comp with
+ (l := ln y) (g := fun x:R => (exp x - exp (ln y)) / (x - ln y)) (f := ln).
+apply ln_continue; auto.
+assert (H0 := derivable_pt_lim_exp (ln y)); unfold derivable_pt_lim in H0;
+ unfold limit1_in in |- *; unfold limit_in in |- *;
+ simpl in |- *; unfold R_dist in |- *; intros; elim (H0 _ H);
+ intros; exists (pos x); split.
+apply (cond_pos x).
+intros; pattern y at 3 in |- *; rewrite <- exp_ln.
+pattern x0 at 1 in |- *; replace x0 with (ln y + (x0 - ln y));
+ [ idtac | ring ].
+apply H1.
+elim H2; intros H3 _; unfold D_x in H3; elim H3; clear H3; intros _ H3;
+ apply Rminus_eq_contra; apply (sym_not_eq (A:=R));
+ apply H3.
+elim H2; clear H2; intros _ H2; apply H2.
+assumption.
+red in |- *; intro; rewrite H in Hy; elim (Rlt_irrefl _ Hy).
Qed.
-Lemma derivable_pt_lim_ln : (x:R) ``0<x`` -> (derivable_pt_lim ln x ``/x``).
-Intros; Assert H0 := (Dln x H); Unfold D_in in H0; Unfold limit1_in in H0; Unfold limit_in in H0; Simpl in H0; Unfold R_dist in H0; Unfold derivable_pt_lim; Intros; Elim (H0 ? H1); Intros; Elim H2; Clear H2; Intros; Pose alp := (Rmin x0 ``x/2``); Assert H4 : ``0<alp``.
-Unfold alp; Unfold Rmin; Case (total_order_Rle x0 ``x/2``); Intro.
-Apply H2.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
-Exists (mkposreal ? H4); Intros; Pattern 2 h; Replace h with ``(x+h)-x``; [Idtac | Ring].
-Apply H3; Split.
-Unfold D_x; Split.
-Case (case_Rabsolu h); Intro.
-Assert H7 : ``(Rabsolu h)<x/2``.
-Apply Rlt_le_trans with alp.
-Apply H6.
-Unfold alp; Apply Rmin_r.
-Apply Rlt_trans with ``x/2``.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
-Rewrite Rabsolu_left in H7.
-Apply Rlt_anti_compatibility with ``-h-x/2``.
-Replace ``-h-x/2+x/2`` with ``-h``; [Idtac | Ring].
-Pattern 2 x; Rewrite double_var.
-Replace ``-h-x/2+(x/2+x/2+h)`` with ``x/2``; [Apply H7 | Ring].
-Apply r.
-Apply gt0_plus_ge0_is_gt0; [Assumption | Apply Rle_sym2; Apply r].
-Apply not_sym; Apply Rminus_not_eq; Replace ``x+h-x`` with h; [Apply H5 | Ring].
-Replace ``x+h-x`` with h; [Apply Rlt_le_trans with alp; [Apply H6 | Unfold alp; Apply Rmin_l] | Ring].
+Lemma derivable_pt_lim_ln : forall x:R, 0 < x -> derivable_pt_lim ln x (/ x).
+intros; assert (H0 := Dln x H); unfold D_in in H0; unfold limit1_in in H0;
+ unfold limit_in in H0; simpl in H0; unfold R_dist in H0;
+ unfold derivable_pt_lim in |- *; intros; elim (H0 _ H1);
+ intros; elim H2; clear H2; intros; pose (alp := Rmin x0 (x / 2));
+ assert (H4 : 0 < alp).
+unfold alp in |- *; unfold Rmin in |- *; case (Rle_dec x0 (x / 2)); intro.
+apply H2.
+unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
+exists (mkposreal _ H4); intros; pattern h at 2 in |- *;
+ replace h with (x + h - x); [ idtac | ring ].
+apply H3; split.
+unfold D_x in |- *; split.
+case (Rcase_abs h); intro.
+assert (H7 : Rabs h < x / 2).
+apply Rlt_le_trans with alp.
+apply H6.
+unfold alp in |- *; apply Rmin_r.
+apply Rlt_trans with (x / 2).
+unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
+rewrite Rabs_left in H7.
+apply Rplus_lt_reg_r with (- h - x / 2).
+replace (- h - x / 2 + x / 2) with (- h); [ idtac | ring ].
+pattern x at 2 in |- *; rewrite double_var.
+replace (- h - x / 2 + (x / 2 + x / 2 + h)) with (x / 2); [ apply H7 | ring ].
+apply r.
+apply Rplus_lt_le_0_compat; [ assumption | apply Rge_le; apply r ].
+apply (sym_not_eq (A:=R)); apply Rminus_not_eq; replace (x + h - x) with h;
+ [ apply H5 | ring ].
+replace (x + h - x) with h;
+ [ apply Rlt_le_trans with alp;
+ [ apply H6 | unfold alp in |- *; apply Rmin_l ]
+ | ring ].
Qed.
-Theorem D_in_imp: (f, g : R -> R)(D, D1 : R -> Prop)(x : R) ((x : R) (D1 x) -> (D x)) -> (D_in f g D x) -> (D_in f g D1 x).
-Intros f g D D1 x H; Unfold D_in.
-Intros H0; Apply limit1_imp with D := (D_x D x); Auto.
-Intros x1 (H1, H2); Split; Auto.
+Theorem D_in_imp :
+ forall (f g:R -> R) (D D1:R -> Prop) (x:R),
+ (forall x:R, D1 x -> D x) -> D_in f g D x -> D_in f g D1 x.
+intros f g D D1 x H; unfold D_in in |- *.
+intros H0; apply limit1_imp with (D := D_x D x); auto.
+intros x1 [H1 H2]; split; auto.
Qed.
-Theorem D_in_ext: (f, g, h : R -> R)(D : R -> Prop) (x : R) (f x) == (g x) -> (D_in h f D x) -> (D_in h g D x).
-Intros f g h D x H; Unfold D_in.
-Rewrite H; Auto.
+Theorem D_in_ext :
+ forall (f g h:R -> R) (D:R -> Prop) (x:R),
+ f x = g x -> D_in h f D x -> D_in h g D x.
+intros f g h D x H; unfold D_in in |- *.
+rewrite H; auto.
Qed.
-Theorem Dpower: (y, z : R) ``0<y`` -> (D_in [x:R](Rpower x z) [x:R](Rmult z (Rpower x (Rminus z R1))) [x:R]``0<x`` y).
-Intros y z H; Apply D_in_imp with D := (Dgf [x : R] (Rlt R0 x) [x : R] True ln).
-Intros x H0; Repeat Split.
-Assumption.
-Apply D_in_ext with f := [x : R] (Rmult (Rinv x) (Rmult z (exp (Rmult z (ln x))))).
-Unfold Rminus; Rewrite Rpower_plus; Rewrite Rpower_Ropp; Rewrite (Rpower_1 ? H); Ring.
-Apply Dcomp with f := ln g := [x : R] (exp (Rmult z x)) df := Rinv dg := [x : R] (Rmult z (exp (Rmult z x))).
-Apply (Dln ? H).
-Apply D_in_imp with D := (Dgf [x : R] True [x : R] True [x : R] (Rmult z x)).
-Intros x H1; Repeat Split; Auto.
-Apply (Dcomp [_ : R] True [_ : R] True [x : ?] z exp [x : R] (Rmult z x) exp); Simpl.
-Apply D_in_ext with f := [x : R] (Rmult z R1).
-Apply Rmult_1r.
-Apply (Dmult_const [x : ?] True [x : ?] x [x : ?] R1); Apply Dx.
-Assert H0 := (derivable_pt_lim_D_in exp exp ``z*(ln y)``); Elim H0; Clear H0; Intros _ H0; Apply H0; Apply derivable_pt_lim_exp.
+Theorem Dpower :
+ forall y z:R,
+ 0 < y ->
+ D_in (fun x:R => x ^R z) (fun x:R => z * x ^R (z - 1)) (
+ fun x:R => 0 < x) y.
+intros y z H;
+ apply D_in_imp with (D := Dgf (fun x:R => 0 < x) (fun x:R => True) ln).
+intros x H0; repeat split.
+assumption.
+apply D_in_ext with (f := fun x:R => / x * (z * exp (z * ln x))).
+unfold Rminus in |- *; rewrite Rpower_plus; rewrite Rpower_Ropp;
+ rewrite (Rpower_1 _ H); ring.
+apply Dcomp with
+ (f := ln)
+ (g := fun x:R => exp (z * x))
+ (df := Rinv)
+ (dg := fun x:R => z * exp (z * x)).
+apply (Dln _ H).
+apply D_in_imp with
+ (D := Dgf (fun x:R => True) (fun x:R => True) (fun x:R => z * x)).
+intros x H1; repeat split; auto.
+apply
+ (Dcomp (fun _:R => True) (fun _:R => True) (fun x => z) exp
+ (fun x:R => z * x) exp); simpl in |- *.
+apply D_in_ext with (f := fun x:R => z * 1).
+apply Rmult_1_r.
+apply (Dmult_const (fun x => True) (fun x => x) (fun x => 1)); apply Dx.
+assert (H0 := derivable_pt_lim_D_in exp exp (z * ln y)); elim H0; clear H0;
+ intros _ H0; apply H0; apply derivable_pt_lim_exp.
Qed.
-Theorem derivable_pt_lim_power: (x, y : R) (Rlt R0 x) -> (derivable_pt_lim [x : ?] (Rpower x y) x (Rmult y (Rpower x (Rminus y R1)))).
-Intros x y H.
-Unfold Rminus; Rewrite Rpower_plus.
-Rewrite Rpower_Ropp.
-Rewrite Rpower_1; Auto.
-Rewrite <- Rmult_assoc.
-Unfold Rpower.
-Apply derivable_pt_lim_comp with f1 := ln f2 := [x : ?] (exp (Rmult y x)).
-Apply derivable_pt_lim_ln; Assumption.
-Rewrite (Rmult_sym y).
-Apply derivable_pt_lim_comp with f1 := [x : ?] (Rmult y x) f2 := exp.
-Pattern 2 y; Replace y with (Rplus (Rmult R0 (ln x)) (Rmult y R1)).
-Apply derivable_pt_lim_mult with f1 := [x : R] y f2 := [x : R] x.
-Apply derivable_pt_lim_const with a := y.
-Apply derivable_pt_lim_id.
-Ring.
-Apply derivable_pt_lim_exp.
-Qed.
+Theorem derivable_pt_lim_power :
+ forall x y:R,
+ 0 < x -> derivable_pt_lim (fun x => x ^R y) x (y * x ^R (y - 1)).
+intros x y H.
+unfold Rminus in |- *; rewrite Rpower_plus.
+rewrite Rpower_Ropp.
+rewrite Rpower_1; auto.
+rewrite <- Rmult_assoc.
+unfold Rpower in |- *.
+apply derivable_pt_lim_comp with (f1 := ln) (f2 := fun x => exp (y * x)).
+apply derivable_pt_lim_ln; assumption.
+rewrite (Rmult_comm y).
+apply derivable_pt_lim_comp with (f1 := fun x => y * x) (f2 := exp).
+pattern y at 2 in |- *; replace y with (0 * ln x + y * 1).
+apply derivable_pt_lim_mult with (f1 := fun x:R => y) (f2 := fun x:R => x).
+apply derivable_pt_lim_const with (a := y).
+apply derivable_pt_lim_id.
+ring.
+apply derivable_pt_lim_exp.
+Qed. \ No newline at end of file
diff --git a/theories/Reals/Rprod.v b/theories/Reals/Rprod.v
index c613c7647..9d962e125 100644
--- a/theories/Reals/Rprod.v
+++ b/theories/Reals/Rprod.v
@@ -8,157 +8,184 @@
(*i $Id$ i*)
-Require Compare.
-Require Rbase.
-Require Rfunctions.
-Require Rseries.
-Require PartSum.
-Require Binomial.
-V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
+Require Import Compare.
+Require Import Rbase.
+Require Import Rfunctions.
+Require Import Rseries.
+Require Import PartSum.
+Require Import Binomial.
Open Local Scope R_scope.
(* TT Ak; 1<=k<=N *)
-Fixpoint prod_f_SO [An:nat->R;N:nat] : R := Cases N of
- O => R1
-| (S p) => ``(prod_f_SO An p)*(An (S p))``
-end.
+Fixpoint prod_f_SO (An:nat -> R) (N:nat) {struct N} : R :=
+ match N with
+ | O => 1
+ | S p => prod_f_SO An p * An (S p)
+ end.
(**********)
-Lemma prod_SO_split : (An:nat->R;n,k:nat) (le k n) -> (prod_f_SO An n)==(Rmult (prod_f_SO An k) (prod_f_SO [l:nat](An (plus k l)) (minus n k))).
-Intros; Induction n.
-Cut k=O; [Intro; Rewrite H0; Simpl; Ring | Inversion H; Reflexivity].
-Cut k=(S n)\/(le k n).
-Intro; Elim H0; Intro.
-Rewrite H1; Simpl; Rewrite <- minus_n_n; Simpl; Ring.
-Replace (minus (S n) k) with (S (minus n k)).
-Simpl; Replace (plus k (S (minus n k))) with (S n).
-Rewrite Hrecn; [Ring | Assumption].
-Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Rewrite S_INR; Rewrite minus_INR; [Ring | Assumption].
-Apply INR_eq; Rewrite S_INR; Repeat Rewrite minus_INR.
-Rewrite S_INR; Ring.
-Apply le_trans with n; [Assumption | Apply le_n_Sn].
-Assumption.
-Inversion H; [Left; Reflexivity | Right; Assumption].
+Lemma prod_SO_split :
+ forall (An:nat -> R) (n k:nat),
+ (k <= n)%nat ->
+ prod_f_SO An n =
+ prod_f_SO An k * prod_f_SO (fun l:nat => An (k + l)%nat) (n - k).
+intros; induction n as [| n Hrecn].
+cut (k = 0%nat);
+ [ intro; rewrite H0; simpl in |- *; ring | inversion H; reflexivity ].
+cut (k = S n \/ (k <= n)%nat).
+intro; elim H0; intro.
+rewrite H1; simpl in |- *; rewrite <- minus_n_n; simpl in |- *; ring.
+replace (S n - k)%nat with (S (n - k)).
+simpl in |- *; replace (k + S (n - k))%nat with (S n).
+rewrite Hrecn; [ ring | assumption ].
+apply INR_eq; rewrite S_INR; rewrite plus_INR; rewrite S_INR;
+ rewrite minus_INR; [ ring | assumption ].
+apply INR_eq; rewrite S_INR; repeat rewrite minus_INR.
+rewrite S_INR; ring.
+apply le_trans with n; [ assumption | apply le_n_Sn ].
+assumption.
+inversion H; [ left; reflexivity | right; assumption ].
Qed.
(**********)
-Lemma prod_SO_pos : (An:nat->R;N:nat) ((n:nat)(le n N)->``0<=(An n)``) -> ``0<=(prod_f_SO An N)``.
-Intros; Induction N.
-Simpl; Left; Apply Rlt_R0_R1.
-Simpl; Apply Rmult_le_pos.
-Apply HrecN; Intros; Apply H; Apply le_trans with N; [Assumption | Apply le_n_Sn].
-Apply H; Apply le_n.
+Lemma prod_SO_pos :
+ forall (An:nat -> R) (N:nat),
+ (forall n:nat, (n <= N)%nat -> 0 <= An n) -> 0 <= prod_f_SO An N.
+intros; induction N as [| N HrecN].
+simpl in |- *; left; apply Rlt_0_1.
+simpl in |- *; apply Rmult_le_pos.
+apply HrecN; intros; apply H; apply le_trans with N;
+ [ assumption | apply le_n_Sn ].
+apply H; apply le_n.
Qed.
(**********)
-Lemma prod_SO_Rle : (An,Bn:nat->R;N:nat) ((n:nat)(le n N)->``0<=(An n)<=(Bn n)``) -> ``(prod_f_SO An N)<=(prod_f_SO Bn N)``.
-Intros; Induction N.
-Right; Reflexivity.
-Simpl; Apply Rle_trans with ``(prod_f_SO An N)*(Bn (S N))``.
-Apply Rle_monotony.
-Apply prod_SO_pos; Intros; Elim (H n (le_trans ? ? ? H0 (le_n_Sn N))); Intros; Assumption.
-Elim (H (S N) (le_n (S N))); Intros; Assumption.
-Do 2 Rewrite <- (Rmult_sym (Bn (S N))); Apply Rle_monotony.
-Elim (H (S N) (le_n (S N))); Intros.
-Apply Rle_trans with (An (S N)); Assumption.
-Apply HrecN; Intros; Elim (H n (le_trans ? ? ? H0 (le_n_Sn N))); Intros; Split; Assumption.
+Lemma prod_SO_Rle :
+ forall (An Bn:nat -> R) (N:nat),
+ (forall n:nat, (n <= N)%nat -> 0 <= An n <= Bn n) ->
+ prod_f_SO An N <= prod_f_SO Bn N.
+intros; induction N as [| N HrecN].
+right; reflexivity.
+simpl in |- *; apply Rle_trans with (prod_f_SO An N * Bn (S N)).
+apply Rmult_le_compat_l.
+apply prod_SO_pos; intros; elim (H n (le_trans _ _ _ H0 (le_n_Sn N))); intros;
+ assumption.
+elim (H (S N) (le_n (S N))); intros; assumption.
+do 2 rewrite <- (Rmult_comm (Bn (S N))); apply Rmult_le_compat_l.
+elim (H (S N) (le_n (S N))); intros.
+apply Rle_trans with (An (S N)); assumption.
+apply HrecN; intros; elim (H n (le_trans _ _ _ H0 (le_n_Sn N))); intros;
+ split; assumption.
Qed.
(* Application to factorial *)
-Lemma fact_prodSO : (n:nat) (INR (fact n))==(prod_f_SO [k:nat](INR k) n).
-Intro; Induction n.
-Reflexivity.
-Change (INR (mult (S n) (fact n)))==(prod_f_SO ([k:nat](INR k)) (S n)).
-Rewrite mult_INR; Rewrite Rmult_sym; Rewrite Hrecn; Reflexivity.
+Lemma fact_prodSO :
+ forall n:nat, INR (fact n) = prod_f_SO (fun k:nat => INR k) n.
+intro; induction n as [| n Hrecn].
+reflexivity.
+change (INR (S n * fact n) = prod_f_SO (fun k:nat => INR k) (S n)) in |- *.
+rewrite mult_INR; rewrite Rmult_comm; rewrite Hrecn; reflexivity.
Qed.
-Lemma le_n_2n : (n:nat) (le n (mult (2) n)).
-Induction n.
-Replace (mult (2) (O)) with O; [Apply le_n | Ring].
-Intros; Replace (mult (2) (S n0)) with (S (S (mult (2) n0))).
-Apply le_n_S; Apply le_S; Assumption.
-Replace (S (S (mult (2) n0))) with (plus (mult (2) n0) (2)); [Idtac | Ring].
-Replace (S n0) with (plus n0 (1)); [Idtac | Ring].
-Ring.
+Lemma le_n_2n : forall n:nat, (n <= 2 * n)%nat.
+simple induction n.
+replace (2 * 0)%nat with 0%nat; [ apply le_n | ring ].
+intros; replace (2 * S n0)%nat with (S (S (2 * n0))).
+apply le_n_S; apply le_S; assumption.
+replace (S (S (2 * n0))) with (2 * n0 + 2)%nat; [ idtac | ring ].
+replace (S n0) with (n0 + 1)%nat; [ idtac | ring ].
+ring.
Qed.
(* We prove that (N!)²<=(2N-k)!*k! forall k in [|O;2N|] *)
-Lemma RfactN_fact2N_factk : (N,k:nat) (le k (mult (2) N)) -> ``(Rsqr (INR (fact N)))<=(INR (fact (minus (mult (S (S O)) N) k)))*(INR (fact k))``.
-Intros; Unfold Rsqr; Repeat Rewrite fact_prodSO.
-Cut (le k N)\/(le N k).
-Intro; Elim H0; Intro.
-Rewrite (prod_SO_split [l:nat](INR l) (minus (mult (2) N) k) N).
-Rewrite Rmult_assoc; Apply Rle_monotony.
-Apply prod_SO_pos; Intros; Apply pos_INR.
-Replace (minus (minus (mult (2) N) k) N) with (minus N k).
-Rewrite Rmult_sym; Rewrite (prod_SO_split [l:nat](INR l) N k).
-Apply Rle_monotony.
-Apply prod_SO_pos; Intros; Apply pos_INR.
-Apply prod_SO_Rle; Intros; Split.
-Apply pos_INR.
-Apply le_INR; Apply le_reg_r; Assumption.
-Assumption.
-Apply INR_eq; Repeat Rewrite minus_INR.
-Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Apply le_trans with N; [Assumption | Apply le_n_2n].
-Apply simpl_le_plus_l with k; Rewrite <- le_plus_minus.
-Replace (mult (2) N) with (plus N N); [Idtac | Ring].
-Apply le_reg_r; Assumption.
-Assumption.
-Assumption.
-Apply simpl_le_plus_l with k; Rewrite <- le_plus_minus.
-Replace (mult (2) N) with (plus N N); [Idtac | Ring].
-Apply le_reg_r; Assumption.
-Assumption.
-Rewrite <- (Rmult_sym (prod_f_SO [l:nat](INR l) k)); Rewrite (prod_SO_split [l:nat](INR l) k N).
-Rewrite Rmult_assoc; Apply Rle_monotony.
-Apply prod_SO_pos; Intros; Apply pos_INR.
-Rewrite Rmult_sym; Rewrite (prod_SO_split [l:nat](INR l) N (minus (mult (2) N) k)).
-Apply Rle_monotony.
-Apply prod_SO_pos; Intros; Apply pos_INR.
-Replace (minus N (minus (mult (2) N) k)) with (minus k N).
-Apply prod_SO_Rle; Intros; Split.
-Apply pos_INR.
-Apply le_INR; Apply le_reg_r.
-Apply simpl_le_plus_l with k; Rewrite <- le_plus_minus.
-Replace (mult (2) N) with (plus N N); [Idtac | Ring]; Apply le_reg_r; Assumption.
-Assumption.
-Apply INR_eq; Repeat Rewrite minus_INR.
-Rewrite mult_INR; Do 2 Rewrite S_INR; Ring.
-Assumption.
-Apply simpl_le_plus_l with k; Rewrite <- le_plus_minus.
-Replace (mult (2) N) with (plus N N); [Idtac | Ring]; Apply le_reg_r; Assumption.
-Assumption.
-Assumption.
-Apply simpl_le_plus_l with k; Rewrite <- le_plus_minus.
-Replace (mult (2) N) with (plus N N); [Idtac | Ring]; Apply le_reg_r; Assumption.
-Assumption.
-Assumption.
-Elim (le_dec k N); Intro; [Left; Assumption | Right; Assumption].
+Lemma RfactN_fact2N_factk :
+ forall N k:nat,
+ (k <= 2 * N)%nat ->
+ Rsqr (INR (fact N)) <= INR (fact (2 * N - k)) * INR (fact k).
+intros; unfold Rsqr in |- *; repeat rewrite fact_prodSO.
+cut ((k <= N)%nat \/ (N <= k)%nat).
+intro; elim H0; intro.
+rewrite (prod_SO_split (fun l:nat => INR l) (2 * N - k) N).
+rewrite Rmult_assoc; apply Rmult_le_compat_l.
+apply prod_SO_pos; intros; apply pos_INR.
+replace (2 * N - k - N)%nat with (N - k)%nat.
+rewrite Rmult_comm; rewrite (prod_SO_split (fun l:nat => INR l) N k).
+apply Rmult_le_compat_l.
+apply prod_SO_pos; intros; apply pos_INR.
+apply prod_SO_Rle; intros; split.
+apply pos_INR.
+apply le_INR; apply plus_le_compat_r; assumption.
+assumption.
+apply INR_eq; repeat rewrite minus_INR.
+rewrite mult_INR; repeat rewrite S_INR; ring.
+apply le_trans with N; [ assumption | apply le_n_2n ].
+apply (fun p n m:nat => plus_le_reg_l n m p) with k; rewrite <- le_plus_minus.
+replace (2 * N)%nat with (N + N)%nat; [ idtac | ring ].
+apply plus_le_compat_r; assumption.
+assumption.
+assumption.
+apply (fun p n m:nat => plus_le_reg_l n m p) with k; rewrite <- le_plus_minus.
+replace (2 * N)%nat with (N + N)%nat; [ idtac | ring ].
+apply plus_le_compat_r; assumption.
+assumption.
+rewrite <- (Rmult_comm (prod_f_SO (fun l:nat => INR l) k));
+ rewrite (prod_SO_split (fun l:nat => INR l) k N).
+rewrite Rmult_assoc; apply Rmult_le_compat_l.
+apply prod_SO_pos; intros; apply pos_INR.
+rewrite Rmult_comm;
+ rewrite (prod_SO_split (fun l:nat => INR l) N (2 * N - k)).
+apply Rmult_le_compat_l.
+apply prod_SO_pos; intros; apply pos_INR.
+replace (N - (2 * N - k))%nat with (k - N)%nat.
+apply prod_SO_Rle; intros; split.
+apply pos_INR.
+apply le_INR; apply plus_le_compat_r.
+apply (fun p n m:nat => plus_le_reg_l n m p) with k; rewrite <- le_plus_minus.
+replace (2 * N)%nat with (N + N)%nat; [ idtac | ring ];
+ apply plus_le_compat_r; assumption.
+assumption.
+apply INR_eq; repeat rewrite minus_INR.
+rewrite mult_INR; do 2 rewrite S_INR; ring.
+assumption.
+apply (fun p n m:nat => plus_le_reg_l n m p) with k; rewrite <- le_plus_minus.
+replace (2 * N)%nat with (N + N)%nat; [ idtac | ring ];
+ apply plus_le_compat_r; assumption.
+assumption.
+assumption.
+apply (fun p n m:nat => plus_le_reg_l n m p) with k; rewrite <- le_plus_minus.
+replace (2 * N)%nat with (N + N)%nat; [ idtac | ring ];
+ apply plus_le_compat_r; assumption.
+assumption.
+assumption.
+elim (le_dec k N); intro; [ left; assumption | right; assumption ].
Qed.
(**********)
-Lemma INR_fact_lt_0 : (n:nat) ``0<(INR (fact n))``.
-Intro; Apply lt_INR_0; Apply neq_O_lt; Red; Intro; Elim (fact_neq_0 n); Symmetry; Assumption.
+Lemma INR_fact_lt_0 : forall n:nat, 0 < INR (fact n).
+intro; apply lt_INR_0; apply neq_O_lt; red in |- *; intro;
+ elim (fact_neq_0 n); symmetry in |- *; assumption.
Qed.
(* We have the following inequality : (C 2N k) <= (C 2N N) forall k in [|O;2N|] *)
-Lemma C_maj : (N,k:nat) (le k (mult (2) N)) -> ``(C (mult (S (S O)) N) k)<=(C (mult (S (S O)) N) N)``.
-Intros; Unfold C; Unfold Rdiv; Apply Rle_monotony.
-Apply pos_INR.
-Replace (minus (mult (2) N) N) with N.
-Apply Rle_monotony_contra with ``((INR (fact N))*(INR (fact N)))``.
-Apply Rmult_lt_pos; Apply INR_fact_lt_0.
-Rewrite <- Rinv_r_sym.
-Rewrite Rmult_sym; Apply Rle_monotony_contra with ``((INR (fact k))*
- (INR (fact (minus (mult (S (S O)) N) k))))``.
-Apply Rmult_lt_pos; Apply INR_fact_lt_0.
-Rewrite Rmult_1r; Rewrite <- mult_INR; Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1l; Rewrite mult_INR; Rewrite (Rmult_sym (INR (fact k))); Replace ``(INR (fact N))*(INR (fact N))`` with (Rsqr (INR (fact N))).
-Apply RfactN_fact2N_factk.
-Assumption.
-Reflexivity.
-Rewrite mult_INR; Apply prod_neq_R0; Apply INR_fact_neq_0.
-Apply prod_neq_R0; Apply INR_fact_neq_0.
-Apply INR_eq; Rewrite minus_INR; [Rewrite mult_INR; Do 2 Rewrite S_INR; Ring | Apply le_n_2n].
-Qed.
+Lemma C_maj : forall N k:nat, (k <= 2 * N)%nat -> C (2 * N) k <= C (2 * N) N.
+intros; unfold C in |- *; unfold Rdiv in |- *; apply Rmult_le_compat_l.
+apply pos_INR.
+replace (2 * N - N)%nat with N.
+apply Rmult_le_reg_l with (INR (fact N) * INR (fact N)).
+apply Rmult_lt_0_compat; apply INR_fact_lt_0.
+rewrite <- Rinv_r_sym.
+rewrite Rmult_comm;
+ apply Rmult_le_reg_l with (INR (fact k) * INR (fact (2 * N - k))).
+apply Rmult_lt_0_compat; apply INR_fact_lt_0.
+rewrite Rmult_1_r; rewrite <- mult_INR; rewrite <- Rmult_assoc;
+ rewrite <- Rinv_r_sym.
+rewrite Rmult_1_l; rewrite mult_INR; rewrite (Rmult_comm (INR (fact k)));
+ replace (INR (fact N) * INR (fact N)) with (Rsqr (INR (fact N))).
+apply RfactN_fact2N_factk.
+assumption.
+reflexivity.
+rewrite mult_INR; apply prod_neq_R0; apply INR_fact_neq_0.
+apply prod_neq_R0; apply INR_fact_neq_0.
+apply INR_eq; rewrite minus_INR;
+ [ rewrite mult_INR; do 2 rewrite S_INR; ring | apply le_n_2n ].
+Qed. \ No newline at end of file
diff --git a/theories/Reals/Rseries.v b/theories/Reals/Rseries.v
index 032524771..03544af4b 100644
--- a/theories/Reals/Rseries.v
+++ b/theories/Reals/Rseries.v
@@ -8,14 +8,13 @@
(*i $Id$ i*)
-Require Rbase.
-Require Rfunctions.
-Require Classical.
-Require Compare.
-V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
+Require Import Rbase.
+Require Import Rfunctions.
+Require Import Classical.
+Require Import Compare.
Open Local Scope R_scope.
-Implicit Variable Type r:R.
+Implicit Type r : R.
(* classical is needed for [Un_cv_crit] *)
(*********************************************************)
@@ -26,144 +25,153 @@ Implicit Variable Type r:R.
Section sequence.
(*********)
-Variable Un:nat->R.
+Variable Un : nat -> R.
(*********)
-Fixpoint Rmax_N [N:nat]:R:=
- Cases N of
- O => (Un O)
- |(S n) => (Rmax (Un (S n)) (Rmax_N n))
- end.
+Fixpoint Rmax_N (N:nat) : R :=
+ match N with
+ | O => Un 0
+ | S n => Rmax (Un (S n)) (Rmax_N n)
+ end.
(*********)
-Definition EUn:R->Prop:=[r:R](Ex [i:nat] (r==(Un i))).
+Definition EUn r : Prop := exists i : nat | r = Un i.
(*********)
-Definition Un_cv:R->Prop:=[l:R]
- (eps:R)(Rgt eps R0)->(Ex[N:nat](n:nat)(ge n N)->
- (Rlt (R_dist (Un n) l) eps)).
+Definition Un_cv (l:R) : Prop :=
+ forall eps:R,
+ eps > 0 ->
+ exists N : nat | (forall n:nat, (n >= N)%nat -> R_dist (Un n) l < eps).
(*********)
-Definition Cauchy_crit:Prop:=(eps:R)(Rgt eps R0)->
- (Ex[N:nat] (n,m:nat)(ge n N)->(ge m N)->
- (Rlt (R_dist (Un n) (Un m)) eps)).
+Definition Cauchy_crit : Prop :=
+ forall eps:R,
+ eps > 0 ->
+ exists N : nat
+ | (forall n m:nat,
+ (n >= N)%nat -> (m >= N)%nat -> R_dist (Un n) (Un m) < eps).
(*********)
-Definition Un_growing:Prop:=(n:nat)(Rle (Un n) (Un (S n))).
+Definition Un_growing : Prop := forall n:nat, Un n <= Un (S n).
(*********)
-Lemma EUn_noempty:(ExT [r:R] (EUn r)).
-Unfold EUn;Split with (Un O);Split with O;Trivial.
+Lemma EUn_noempty : exists r : R | EUn r.
+unfold EUn in |- *; split with (Un 0); split with 0%nat; trivial.
Qed.
(*********)
-Lemma Un_in_EUn:(n:nat)(EUn (Un n)).
-Intro;Unfold EUn;Split with n;Trivial.
+Lemma Un_in_EUn : forall n:nat, EUn (Un n).
+intro; unfold EUn in |- *; split with n; trivial.
Qed.
(*********)
-Lemma Un_bound_imp:(x:R)((n:nat)(Rle (Un n) x))->(is_upper_bound EUn x).
-Intros;Unfold is_upper_bound;Intros;Unfold EUn in H0;Elim H0;Clear H0;
- Intros;Generalize (H x1);Intro;Rewrite <- H0 in H1;Trivial.
+Lemma Un_bound_imp :
+ forall x:R, (forall n:nat, Un n <= x) -> is_upper_bound EUn x.
+intros; unfold is_upper_bound in |- *; intros; unfold EUn in H0; elim H0;
+ clear H0; intros; generalize (H x1); intro; rewrite <- H0 in H1;
+ trivial.
Qed.
(*********)
-Lemma growing_prop:(n,m:nat)Un_growing->(ge n m)->(Rge (Un n) (Un m)).
-Double Induction n m;Intros.
-Unfold Rge;Right;Trivial.
-ElimType False;Unfold ge in H1;Generalize (le_Sn_O n0);Intro;Auto.
-Cut (ge n0 (0)).
-Generalize H0;Intros;Unfold Un_growing in H0;
- Apply (Rge_trans (Un (S n0)) (Un n0) (Un (0))
- (Rle_sym1 (Un n0) (Un (S n0)) (H0 n0)) (H O H2 H3)).
-Elim n0;Auto.
-Elim (lt_eq_lt_dec n1 n0);Intro y.
-Elim y;Clear y;Intro y.
-Unfold ge in H2;Generalize (le_not_lt n0 n1 (le_S_n n0 n1 H2));Intro;
- ElimType False;Auto.
-Rewrite y;Unfold Rge;Right;Trivial.
-Unfold ge in H0;Generalize (H0 (S n0) H1 (lt_le_S n0 n1 y));Intro;
- Unfold Un_growing in H1;
- Apply (Rge_trans (Un (S n1)) (Un n1) (Un (S n0))
- (Rle_sym1 (Un n1) (Un (S n1)) (H1 n1)) H3).
+Lemma growing_prop :
+ forall n m:nat, Un_growing -> (n >= m)%nat -> Un n >= Un m.
+double induction n m; intros.
+unfold Rge in |- *; right; trivial.
+elimtype False; unfold ge in H1; generalize (le_Sn_O n0); intro; auto.
+cut (n0 >= 0)%nat.
+generalize H0; intros; unfold Un_growing in H0;
+ apply
+ (Rge_trans (Un (S n0)) (Un n0) (Un 0) (Rle_ge (Un n0) (Un (S n0)) (H0 n0))
+ (H 0%nat H2 H3)).
+elim n0; auto.
+elim (lt_eq_lt_dec n1 n0); intro y.
+elim y; clear y; intro y.
+unfold ge in H2; generalize (le_not_lt n0 n1 (le_S_n n0 n1 H2)); intro;
+ elimtype False; auto.
+rewrite y; unfold Rge in |- *; right; trivial.
+unfold ge in H0; generalize (H0 (S n0) H1 (lt_le_S n0 n1 y)); intro;
+ unfold Un_growing in H1;
+ apply
+ (Rge_trans (Un (S n1)) (Un n1) (Un (S n0))
+ (Rle_ge (Un n1) (Un (S n1)) (H1 n1)) H3).
Qed.
(* classical is needed: [not_all_not_ex] *)
(*********)
-Lemma Un_cv_crit:Un_growing->(bound EUn)->(ExT [l:R] (Un_cv l)).
-Unfold Un_growing Un_cv;Intros;
- Generalize (complet_weak EUn H0 EUn_noempty);Intro;
- Elim H1;Clear H1;Intros;Split with x;Intros;
- Unfold is_lub in H1;Unfold bound in H0;Unfold is_upper_bound in H0 H1;
- Elim H0;Clear H0;Intros;Elim H1;Clear H1;Intros;
- Generalize (H3 x0 H0);Intro;Cut (n:nat)(Rle (Un n) x);Intro.
-Cut (Ex [N:nat] (Rlt (Rminus x eps) (Un N))).
-Intro;Elim H6;Clear H6;Intros;Split with x1.
-Intros;Unfold R_dist;Apply (Rabsolu_def1 (Rminus (Un n) x) eps).
-Unfold Rgt in H2;
- Apply (Rle_lt_trans (Rminus (Un n) x) R0 eps
- (Rle_minus (Un n) x (H5 n)) H2).
-Fold Un_growing in H;Generalize (growing_prop n x1 H H7);Intro;
- Generalize (Rlt_le_trans (Rminus x eps) (Un x1) (Un n) H6
- (Rle_sym2 (Un x1) (Un n) H8));Intro;
- Generalize (Rlt_compatibility (Ropp x) (Rminus x eps) (Un n) H9);
- Unfold Rminus;Rewrite <-(Rplus_assoc (Ropp x) x (Ropp eps));
- Rewrite (Rplus_sym (Ropp x) (Un n));Fold (Rminus (Un n) x);
- Rewrite Rplus_Ropp_l;Rewrite (let (H1,H2)=(Rplus_ne (Ropp eps)) in H2);
- Trivial.
-Cut ~((N:nat)(Rge (Rminus x eps) (Un N))).
-Intro;Apply (not_all_not_ex nat ([N:nat](Rlt (Rminus x eps) (Un N))));
- Red;Intro;Red in H6;Elim H6;Clear H6;Intro;
- Apply (Rlt_not_ge (Rminus x eps) (Un N) (H7 N)).
-Red;Intro;Cut (N:nat)(Rle (Un N) (Rminus x eps)).
-Intro;Generalize (Un_bound_imp (Rminus x eps) H7);Intro;
- Unfold is_upper_bound in H8;Generalize (H3 (Rminus x eps) H8);Intro;
- Generalize (Rle_minus x (Rminus x eps) H9);Unfold Rminus;
- Rewrite Ropp_distr1;Rewrite <- Rplus_assoc;Rewrite Rplus_Ropp_r;
- Rewrite (let (H1,H2)=(Rplus_ne (Ropp (Ropp eps))) in H2);
- Rewrite Ropp_Ropp;Intro;Unfold Rgt in H2;
- Generalize (Rle_not eps R0 H2);Intro;Auto.
-Intro;Elim (H6 N);Intro;Unfold Rle.
-Left;Unfold Rgt in H7;Assumption.
-Right;Auto.
-Apply (H1 (Un n) (Un_in_EUn n)).
+Lemma Un_cv_crit : Un_growing -> bound EUn -> exists l : R | Un_cv l.
+unfold Un_growing, Un_cv in |- *; intros;
+ generalize (completeness_weak EUn H0 EUn_noempty);
+ intro; elim H1; clear H1; intros; split with x; intros;
+ unfold is_lub in H1; unfold bound in H0; unfold is_upper_bound in H0, H1;
+ elim H0; clear H0; intros; elim H1; clear H1; intros;
+ generalize (H3 x0 H0); intro; cut (forall n:nat, Un n <= x);
+ intro.
+cut ( exists N : nat | x - eps < Un N).
+intro; elim H6; clear H6; intros; split with x1.
+intros; unfold R_dist in |- *; apply (Rabs_def1 (Un n - x) eps).
+unfold Rgt in H2;
+ apply (Rle_lt_trans (Un n - x) 0 eps (Rle_minus (Un n) x (H5 n)) H2).
+fold Un_growing in H; generalize (growing_prop n x1 H H7); intro;
+ generalize
+ (Rlt_le_trans (x - eps) (Un x1) (Un n) H6 (Rge_le (Un n) (Un x1) H8));
+ intro; generalize (Rplus_lt_compat_l (- x) (x - eps) (Un n) H9);
+ unfold Rminus in |- *; rewrite <- (Rplus_assoc (- x) x (- eps));
+ rewrite (Rplus_comm (- x) (Un n)); fold (Un n - x) in |- *;
+ rewrite Rplus_opp_l; rewrite (let (H1, H2) := Rplus_ne (- eps) in H2);
+ trivial.
+cut (~ (forall N:nat, x - eps >= Un N)).
+intro; apply (not_all_not_ex nat (fun N:nat => x - eps < Un N)); red in |- *;
+ intro; red in H6; elim H6; clear H6; intro;
+ apply (Rnot_lt_ge (x - eps) (Un N) (H7 N)).
+red in |- *; intro; cut (forall N:nat, Un N <= x - eps).
+intro; generalize (Un_bound_imp (x - eps) H7); intro;
+ unfold is_upper_bound in H8; generalize (H3 (x - eps) H8);
+ intro; generalize (Rle_minus x (x - eps) H9); unfold Rminus in |- *;
+ rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; rewrite Rplus_opp_r;
+ rewrite (let (H1, H2) := Rplus_ne (- - eps) in H2);
+ rewrite Ropp_involutive; intro; unfold Rgt in H2;
+ generalize (Rgt_not_le eps 0 H2); intro; auto.
+intro; elim (H6 N); intro; unfold Rle in |- *.
+left; unfold Rgt in H7; assumption.
+right; auto.
+apply (H1 (Un n) (Un_in_EUn n)).
Qed.
(*********)
-Lemma finite_greater:(N:nat)(ExT [M:R] (n:nat)(le n N)->(Rle (Un n) M)).
-Intro;Induction N.
-Split with (Un O);Intros;Rewrite (le_n_O_eq n H);
- Apply (eq_Rle (Un (n)) (Un (n)) (refl_eqT R (Un (n)))).
-Elim HrecN;Clear HrecN;Intros;Split with (Rmax (Un (S N)) x);Intros;
- Elim (Rmax_Rle (Un (S N)) x (Un n));Intros;Clear H1;Inversion H0.
-Rewrite <-H1;Rewrite <-H1 in H2;
- Apply (H2 (or_introl (Rle (Un n) (Un n)) (Rle (Un n) x)
- (eq_Rle (Un n) (Un n) (refl_eqT R (Un n))))).
-Apply (H2 (or_intror (Rle (Un n) (Un (S N))) (Rle (Un n) x)
- (H n H3))).
+Lemma finite_greater :
+ forall N:nat, exists M : R | (forall n:nat, (n <= N)%nat -> Un n <= M).
+intro; induction N as [| N HrecN].
+split with (Un 0); intros; rewrite (le_n_O_eq n H);
+ apply (Req_le (Un n) (Un n) (refl_equal (Un n))).
+elim HrecN; clear HrecN; intros; split with (Rmax (Un (S N)) x); intros;
+ elim (Rmax_Rle (Un (S N)) x (Un n)); intros; clear H1;
+ inversion H0.
+rewrite <- H1; rewrite <- H1 in H2;
+ apply
+ (H2 (or_introl (Un n <= x) (Req_le (Un n) (Un n) (refl_equal (Un n))))).
+apply (H2 (or_intror (Un n <= Un (S N)) (H n H3))).
Qed.
(*********)
-Lemma cauchy_bound:Cauchy_crit->(bound EUn).
-Unfold Cauchy_crit bound;Intros;Unfold is_upper_bound;
- Unfold Rgt in H;Elim (H R1 Rlt_R0_R1);Clear H;Intros;
- Generalize (H x);Intro;Generalize (le_dec x);Intro;
- Elim (finite_greater x);Intros;Split with (Rmax x0 (Rplus (Un x) R1));
- Clear H;Intros;Unfold EUn in H;Elim H;Clear H;Intros;Elim (H1 x2);
- Clear H1;Intro y.
-Unfold ge in H0;Generalize (H0 x2 (le_n x) y);Clear H0;Intro;
- Rewrite <- H in H0;Unfold R_dist in H0;
- Elim (Rabsolu_def2 (Rminus (Un x) x1) R1 H0);Clear H0;Intros;
- Elim (Rmax_Rle x0 (Rplus (Un x) R1) x1);Intros;Apply H4;Clear H3 H4;
- Right;Clear H H0 y;Apply (Rlt_le x1 (Rplus (Un x) R1));
- Generalize (Rlt_minus (Ropp R1) (Rminus (Un x) x1) H1);Clear H1;
- Intro;Apply (Rminus_lt x1 (Rplus (Un x) R1));
- Cut (Rminus (Ropp R1) (Rminus (Un x) x1))==
- (Rminus x1 (Rplus (Un x) R1));[Intro;Rewrite H0 in H;Assumption|Ring].
-Generalize (H2 x2 y);Clear H2 H0;Intro;Rewrite<-H in H0;
- Elim (Rmax_Rle x0 (Rplus (Un x) R1) x1);Intros;Clear H1;Apply H2;
- Left;Assumption.
+Lemma cauchy_bound : Cauchy_crit -> bound EUn.
+unfold Cauchy_crit, bound in |- *; intros; unfold is_upper_bound in |- *;
+ unfold Rgt in H; elim (H 1 Rlt_0_1); clear H; intros;
+ generalize (H x); intro; generalize (le_dec x); intro;
+ elim (finite_greater x); intros; split with (Rmax x0 (Un x + 1));
+ clear H; intros; unfold EUn in H; elim H; clear H;
+ intros; elim (H1 x2); clear H1; intro y.
+unfold ge in H0; generalize (H0 x2 (le_n x) y); clear H0; intro;
+ rewrite <- H in H0; unfold R_dist in H0; elim (Rabs_def2 (Un x - x1) 1 H0);
+ clear H0; intros; elim (Rmax_Rle x0 (Un x + 1) x1);
+ intros; apply H4; clear H3 H4; right; clear H H0 y;
+ apply (Rlt_le x1 (Un x + 1)); generalize (Rlt_minus (-1) (Un x - x1) H1);
+ clear H1; intro; apply (Rminus_lt x1 (Un x + 1));
+ cut (-1 - (Un x - x1) = x1 - (Un x + 1));
+ [ intro; rewrite H0 in H; assumption | ring ].
+generalize (H2 x2 y); clear H2 H0; intro; rewrite <- H in H0;
+ elim (Rmax_Rle x0 (Un x + 1) x1); intros; clear H1;
+ apply H2; left; assumption.
Qed.
End sequence.
@@ -176,104 +184,92 @@ End sequence.
Section Isequence.
(*********)
-Variable An:nat->R.
+Variable An : nat -> R.
(*********)
-Definition Pser:R->R->Prop:=[x,l:R]
- (infinit_sum [n:nat](Rmult (An n) (pow x n)) l).
+Definition Pser (x l:R) : Prop := infinit_sum (fun n:nat => An n * x ^ n) l.
End Isequence.
-Lemma GP_infinite:
- (x:R) (Rlt (Rabsolu x) R1)
- -> (Pser ([n:nat] R1) x (Rinv(Rminus R1 x))).
-Intros;Unfold Pser; Unfold infinit_sum;Intros;Elim (Req_EM x R0).
-Intros;Exists O; Intros;Rewrite H1;Rewrite minus_R0;Rewrite Rinv_R1;
- Cut (sum_f_R0 [n0:nat](Rmult R1 (pow R0 n0)) n)==R1.
-Intros; Rewrite H3;Rewrite R_dist_eq;Auto.
-Elim n; Simpl.
-Ring.
-Intros;Rewrite H3;Ring.
-Intro;Cut (Rlt R0
- (Rmult eps (Rmult (Rabsolu (Rminus R1 x))
- (Rabsolu (Rinv x))))).
-Intro;Elim (pow_lt_1_zero x H
- (Rmult eps (Rmult (Rabsolu (Rminus R1 x))
- (Rabsolu (Rinv x))))
- H2);Intro N; Intros;Exists N; Intros;
- Cut (sum_f_R0 [n0:nat](Rmult R1 (pow x n0)) n)==
- (sum_f_R0 [n0:nat](pow x n0) n).
-Intros; Rewrite H5;Apply (Rlt_monotony_rev
- (Rabsolu (Rminus R1 x))
- (R_dist (sum_f_R0 [n0:nat](pow x n0) n)
- (Rinv (Rminus R1 x)))
- eps).
-Apply Rabsolu_pos_lt.
-Apply Rminus_eq_contra.
-Apply imp_not_Req.
-Right; Unfold Rgt.
-Apply (Rle_lt_trans x (Rabsolu x) R1).
-Apply Rle_Rabsolu.
-Assumption.
-Unfold R_dist; Rewrite <- Rabsolu_mult.
-Rewrite Rminus_distr.
-Cut (Rmult (Rminus R1 x) (sum_f_R0 [n0:nat](pow x n0) n))==
- (Ropp (Rmult(sum_f_R0 [n0:nat](pow x n0) n)
- (Rminus x R1))).
-Intro; Rewrite H6.
-Rewrite GP_finite.
-Rewrite Rinv_r.
-Cut (Rminus (Ropp (Rminus (pow x (plus n (1))) R1)) R1)==
- (Ropp (pow x (plus n (1)))).
-Intro; Rewrite H7.
-Rewrite Rabsolu_Ropp;Cut (plus n (S O))=(S n);Auto.
-Intro H8;Rewrite H8;Simpl;Rewrite Rabsolu_mult;
- Apply (Rlt_le_trans (Rmult (Rabsolu x) (Rabsolu (pow x n)))
- (Rmult (Rabsolu x)
- (Rmult eps
- (Rmult (Rabsolu (Rminus R1 x))
- (Rabsolu (Rinv x)))))
- (Rmult (Rabsolu (Rminus R1 x)) eps)).
-Apply Rlt_monotony.
-Apply Rabsolu_pos_lt.
-Assumption.
-Auto.
-Cut (Rmult (Rabsolu x)
- (Rmult eps (Rmult (Rabsolu (Rminus R1 x))
- (Rabsolu (Rinv x)))))==
- (Rmult (Rmult (Rabsolu x) (Rabsolu (Rinv x)))
- (Rmult eps (Rabsolu (Rminus R1 x)))).
-Clear H8;Intros; Rewrite H8;Rewrite <- Rabsolu_mult;Rewrite Rinv_r.
-Rewrite Rabsolu_R1;Cut (Rmult R1 (Rmult eps (Rabsolu (Rminus R1 x))))==
- (Rmult (Rabsolu (Rminus R1 x)) eps).
-Intros; Rewrite H9;Unfold Rle; Right; Reflexivity.
-Ring.
-Assumption.
-Ring.
-Ring.
-Ring.
-Apply Rminus_eq_contra.
-Apply imp_not_Req.
-Right; Unfold Rgt.
-Apply (Rle_lt_trans x (Rabsolu x) R1).
-Apply Rle_Rabsolu.
-Assumption.
-Ring; Ring.
-Elim n; Simpl.
-Ring.
-Intros; Rewrite H5.
-Ring.
-Apply Rmult_lt_pos.
-Auto.
-Apply Rmult_lt_pos.
-Apply Rabsolu_pos_lt.
-Apply Rminus_eq_contra.
-Apply imp_not_Req.
-Right; Unfold Rgt.
-Apply (Rle_lt_trans x (Rabsolu x) R1).
-Apply Rle_Rabsolu.
-Assumption.
-Apply Rabsolu_pos_lt.
-Apply Rinv_neq_R0.
-Assumption.
-Qed.
+Lemma GP_infinite :
+ forall x:R, Rabs x < 1 -> Pser (fun n:nat => 1) x (/ (1 - x)).
+intros; unfold Pser in |- *; unfold infinit_sum in |- *; intros;
+ elim (Req_dec x 0).
+intros; exists 0%nat; intros; rewrite H1; rewrite Rminus_0_r; rewrite Rinv_1;
+ cut (sum_f_R0 (fun n0:nat => 1 * 0 ^ n0) n = 1).
+intros; rewrite H3; rewrite R_dist_eq; auto.
+elim n; simpl in |- *.
+ring.
+intros; rewrite H3; ring.
+intro; cut (0 < eps * (Rabs (1 - x) * Rabs (/ x))).
+intro; elim (pow_lt_1_zero x H (eps * (Rabs (1 - x) * Rabs (/ x))) H2);
+ intro N; intros; exists N; intros;
+ cut
+ (sum_f_R0 (fun n0:nat => 1 * x ^ n0) n = sum_f_R0 (fun n0:nat => x ^ n0) n).
+intros; rewrite H5;
+ apply
+ (Rmult_lt_reg_l (Rabs (1 - x))
+ (R_dist (sum_f_R0 (fun n0:nat => x ^ n0) n) (/ (1 - x))) eps).
+apply Rabs_pos_lt.
+apply Rminus_eq_contra.
+apply Rlt_dichotomy_converse.
+right; unfold Rgt in |- *.
+apply (Rle_lt_trans x (Rabs x) 1).
+apply RRle_abs.
+assumption.
+unfold R_dist in |- *; rewrite <- Rabs_mult.
+rewrite Rmult_minus_distr_l.
+cut
+ ((1 - x) * sum_f_R0 (fun n0:nat => x ^ n0) n =
+ - (sum_f_R0 (fun n0:nat => x ^ n0) n * (x - 1))).
+intro; rewrite H6.
+rewrite GP_finite.
+rewrite Rinv_r.
+cut (- (x ^ (n + 1) - 1) - 1 = - x ^ (n + 1)).
+intro; rewrite H7.
+rewrite Rabs_Ropp; cut ((n + 1)%nat = S n); auto.
+intro H8; rewrite H8; simpl in |- *; rewrite Rabs_mult;
+ apply
+ (Rlt_le_trans (Rabs x * Rabs (x ^ n))
+ (Rabs x * (eps * (Rabs (1 - x) * Rabs (/ x)))) (
+ Rabs (1 - x) * eps)).
+apply Rmult_lt_compat_l.
+apply Rabs_pos_lt.
+assumption.
+auto.
+cut
+ (Rabs x * (eps * (Rabs (1 - x) * Rabs (/ x))) =
+ Rabs x * Rabs (/ x) * (eps * Rabs (1 - x))).
+clear H8; intros; rewrite H8; rewrite <- Rabs_mult; rewrite Rinv_r.
+rewrite Rabs_R1; cut (1 * (eps * Rabs (1 - x)) = Rabs (1 - x) * eps).
+intros; rewrite H9; unfold Rle in |- *; right; reflexivity.
+ring.
+assumption.
+ring.
+ring.
+ring.
+apply Rminus_eq_contra.
+apply Rlt_dichotomy_converse.
+right; unfold Rgt in |- *.
+apply (Rle_lt_trans x (Rabs x) 1).
+apply RRle_abs.
+assumption.
+ring; ring.
+elim n; simpl in |- *.
+ring.
+intros; rewrite H5.
+ring.
+apply Rmult_lt_0_compat.
+auto.
+apply Rmult_lt_0_compat.
+apply Rabs_pos_lt.
+apply Rminus_eq_contra.
+apply Rlt_dichotomy_converse.
+right; unfold Rgt in |- *.
+apply (Rle_lt_trans x (Rabs x) 1).
+apply RRle_abs.
+assumption.
+apply Rabs_pos_lt.
+apply Rinv_neq_0_compat.
+assumption.
+Qed. \ No newline at end of file
diff --git a/theories/Reals/Rsigma.v b/theories/Reals/Rsigma.v
index fd14d2c8c..592ddf68f 100644
--- a/theories/Reals/Rsigma.v
+++ b/theories/Reals/Rsigma.v
@@ -8,110 +8,133 @@
(*i $Id$ i*)
-Require Rbase.
-Require Rfunctions.
-Require Rseries.
-Require PartSum.
-V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
+Require Import Rbase.
+Require Import Rfunctions.
+Require Import Rseries.
+Require Import PartSum.
Open Local Scope R_scope.
Set Implicit Arguments.
Section Sigma.
-Variable f : nat->R.
+Variable f : nat -> R.
-Definition sigma [low,high:nat] : R := (sum_f_R0 [k:nat](f (plus low k)) (minus high low)).
+Definition sigma (low high:nat) : R :=
+ sum_f_R0 (fun k:nat => f (low + k)) (high - low).
-Theorem sigma_split : (low,high,k:nat) (le low k)->(lt k high)->``(sigma low high)==(sigma low k)+(sigma (S k) high)``.
-Intros; Induction k.
-Cut low = O.
-Intro; Rewrite H1; Unfold sigma; Rewrite <- minus_n_n; Rewrite <- minus_n_O; Simpl; Replace (minus high (S O)) with (pred high).
-Apply (decomp_sum [k:nat](f k)).
-Assumption.
-Apply pred_of_minus.
-Inversion H; Reflexivity.
-Cut (le low k)\/low=(S k).
-Intro; Elim H1; Intro.
-Replace (sigma low (S k)) with ``(sigma low k)+(f (S k))``.
-Rewrite Rplus_assoc; Replace ``(f (S k))+(sigma (S (S k)) high)`` with (sigma (S k) high).
-Apply Hreck.
-Assumption.
-Apply lt_trans with (S k); [Apply lt_n_Sn | Assumption].
-Unfold sigma; Replace (minus high (S (S k))) with (pred (minus high (S k))).
-Pattern 3 (S k); Replace (S k) with (plus (S k) O); [Idtac | Ring].
-Replace (sum_f_R0 [k0:nat](f (plus (S (S k)) k0)) (pred (minus high (S k)))) with (sum_f_R0 [k0:nat](f (plus (S k) (S k0))) (pred (minus high (S k)))).
-Apply (decomp_sum [i:nat](f (plus (S k) i))).
-Apply lt_minus_O_lt; Assumption.
-Apply sum_eq; Intros; Replace (plus (S k) (S i)) with (plus (S (S k)) i).
-Reflexivity.
-Apply INR_eq; Do 2 Rewrite plus_INR; Do 3 Rewrite S_INR; Ring.
-Replace (minus high (S (S k))) with (minus (minus high (S k)) (S O)).
-Apply pred_of_minus.
-Apply INR_eq; Repeat Rewrite minus_INR.
-Do 4 Rewrite S_INR; Ring.
-Apply lt_le_S; Assumption.
-Apply lt_le_weak; Assumption.
-Apply lt_le_S; Apply lt_minus_O_lt; Assumption.
-Unfold sigma; Replace (minus (S k) low) with (S (minus k low)).
-Pattern 1 (S k); Replace (S k) with (plus low (S (minus k low))).
-Symmetry; Apply (tech5 [i:nat](f (plus low i))).
-Apply INR_eq; Rewrite plus_INR; Do 2 Rewrite S_INR; Rewrite minus_INR.
-Ring.
-Assumption.
-Apply minus_Sn_m; Assumption.
-Rewrite <- H2; Unfold sigma; Rewrite <- minus_n_n; Simpl; Replace (minus high (S low)) with (pred (minus high low)).
-Replace (sum_f_R0 [k0:nat](f (S (plus low k0))) (pred (minus high low))) with (sum_f_R0 [k0:nat](f (plus low (S k0))) (pred (minus high low))).
-Apply (decomp_sum [k0:nat](f (plus low k0))).
-Apply lt_minus_O_lt.
-Apply le_lt_trans with (S k); [Rewrite H2; Apply le_n | Assumption].
-Apply sum_eq; Intros; Replace (S (plus low i)) with (plus low (S i)).
-Reflexivity.
-Apply INR_eq; Rewrite plus_INR; Do 2 Rewrite S_INR; Rewrite plus_INR; Ring.
-Replace (minus high (S low)) with (minus (minus high low) (S O)).
-Apply pred_of_minus.
-Apply INR_eq; Repeat Rewrite minus_INR.
-Do 2 Rewrite S_INR; Ring.
-Apply lt_le_S; Rewrite H2; Assumption.
-Rewrite H2; Apply lt_le_weak; Assumption.
-Apply lt_le_S; Apply lt_minus_O_lt; Rewrite H2; Assumption.
-Inversion H; [
- Right; Reflexivity
-| Left; Assumption].
+Theorem sigma_split :
+ forall low high k:nat,
+ (low <= k)%nat ->
+ (k < high)%nat -> sigma low high = sigma low k + sigma (S k) high.
+intros; induction k as [| k Hreck].
+cut (low = 0%nat).
+intro; rewrite H1; unfold sigma in |- *; rewrite <- minus_n_n;
+ rewrite <- minus_n_O; simpl in |- *; replace (high - 1)%nat with (pred high).
+apply (decomp_sum (fun k:nat => f k)).
+assumption.
+apply pred_of_minus.
+inversion H; reflexivity.
+cut ((low <= k)%nat \/ low = S k).
+intro; elim H1; intro.
+replace (sigma low (S k)) with (sigma low k + f (S k)).
+rewrite Rplus_assoc;
+ replace (f (S k) + sigma (S (S k)) high) with (sigma (S k) high).
+apply Hreck.
+assumption.
+apply lt_trans with (S k); [ apply lt_n_Sn | assumption ].
+unfold sigma in |- *; replace (high - S (S k))%nat with (pred (high - S k)).
+pattern (S k) at 3 in |- *; replace (S k) with (S k + 0)%nat;
+ [ idtac | ring ].
+replace (sum_f_R0 (fun k0:nat => f (S (S k) + k0)) (pred (high - S k))) with
+ (sum_f_R0 (fun k0:nat => f (S k + S k0)) (pred (high - S k))).
+apply (decomp_sum (fun i:nat => f (S k + i))).
+apply lt_minus_O_lt; assumption.
+apply sum_eq; intros; replace (S k + S i)%nat with (S (S k) + i)%nat.
+reflexivity.
+apply INR_eq; do 2 rewrite plus_INR; do 3 rewrite S_INR; ring.
+replace (high - S (S k))%nat with (high - S k - 1)%nat.
+apply pred_of_minus.
+apply INR_eq; repeat rewrite minus_INR.
+do 4 rewrite S_INR; ring.
+apply lt_le_S; assumption.
+apply lt_le_weak; assumption.
+apply lt_le_S; apply lt_minus_O_lt; assumption.
+unfold sigma in |- *; replace (S k - low)%nat with (S (k - low)).
+pattern (S k) at 1 in |- *; replace (S k) with (low + S (k - low))%nat.
+symmetry in |- *; apply (tech5 (fun i:nat => f (low + i))).
+apply INR_eq; rewrite plus_INR; do 2 rewrite S_INR; rewrite minus_INR.
+ring.
+assumption.
+apply minus_Sn_m; assumption.
+rewrite <- H2; unfold sigma in |- *; rewrite <- minus_n_n; simpl in |- *;
+ replace (high - S low)%nat with (pred (high - low)).
+replace (sum_f_R0 (fun k0:nat => f (S (low + k0))) (pred (high - low))) with
+ (sum_f_R0 (fun k0:nat => f (low + S k0)) (pred (high - low))).
+apply (decomp_sum (fun k0:nat => f (low + k0))).
+apply lt_minus_O_lt.
+apply le_lt_trans with (S k); [ rewrite H2; apply le_n | assumption ].
+apply sum_eq; intros; replace (S (low + i)) with (low + S i)%nat.
+reflexivity.
+apply INR_eq; rewrite plus_INR; do 2 rewrite S_INR; rewrite plus_INR; ring.
+replace (high - S low)%nat with (high - low - 1)%nat.
+apply pred_of_minus.
+apply INR_eq; repeat rewrite minus_INR.
+do 2 rewrite S_INR; ring.
+apply lt_le_S; rewrite H2; assumption.
+rewrite H2; apply lt_le_weak; assumption.
+apply lt_le_S; apply lt_minus_O_lt; rewrite H2; assumption.
+inversion H; [ right; reflexivity | left; assumption ].
Qed.
-Theorem sigma_diff : (low,high,k:nat) (le low k) -> (lt k high )->``(sigma low high)-(sigma low k)==(sigma (S k) high)``.
-Intros low high k H1 H2; Symmetry; Rewrite -> (sigma_split H1 H2); Ring.
+Theorem sigma_diff :
+ forall low high k:nat,
+ (low <= k)%nat ->
+ (k < high)%nat -> sigma low high - sigma low k = sigma (S k) high.
+intros low high k H1 H2; symmetry in |- *; rewrite (sigma_split H1 H2); ring.
Qed.
-Theorem sigma_diff_neg : (low,high,k:nat) (le low k) -> (lt k high)-> ``(sigma low k)-(sigma low high)==-(sigma (S k) high)``.
-Intros low high k H1 H2; Rewrite -> (sigma_split H1 H2); Ring.
+Theorem sigma_diff_neg :
+ forall low high k:nat,
+ (low <= k)%nat ->
+ (k < high)%nat -> sigma low k - sigma low high = - sigma (S k) high.
+intros low high k H1 H2; rewrite (sigma_split H1 H2); ring.
Qed.
-Theorem sigma_first : (low,high:nat) (lt low high) -> ``(sigma low high)==(f low)+(sigma (S low) high)``.
-Intros low high H1; Generalize (lt_le_S low high H1); Intro H2; Generalize (lt_le_weak low high H1); Intro H3; Replace ``(f low)`` with ``(sigma low low)``.
-Apply sigma_split.
-Apply le_n.
-Assumption.
-Unfold sigma; Rewrite <- minus_n_n.
-Simpl.
-Replace (plus low O) with low; [Reflexivity | Ring].
+Theorem sigma_first :
+ forall low high:nat,
+ (low < high)%nat -> sigma low high = f low + sigma (S low) high.
+intros low high H1; generalize (lt_le_S low high H1); intro H2;
+ generalize (lt_le_weak low high H1); intro H3;
+ replace (f low) with (sigma low low).
+apply sigma_split.
+apply le_n.
+assumption.
+unfold sigma in |- *; rewrite <- minus_n_n.
+simpl in |- *.
+replace (low + 0)%nat with low; [ reflexivity | ring ].
Qed.
-Theorem sigma_last : (low,high:nat) (lt low high) -> ``(sigma low high)==(f high)+(sigma low (pred high))``.
-Intros low high H1; Generalize (lt_le_S low high H1); Intro H2; Generalize (lt_le_weak low high H1); Intro H3; Replace ``(f high)`` with ``(sigma high high)``.
-Rewrite Rplus_sym; Cut high = (S (pred high)).
-Intro; Pattern 3 high; Rewrite H.
-Apply sigma_split.
-Apply le_S_n; Rewrite <- H; Apply lt_le_S; Assumption.
-Apply lt_pred_n_n; Apply le_lt_trans with low; [Apply le_O_n | Assumption].
-Apply S_pred with O; Apply le_lt_trans with low; [Apply le_O_n | Assumption].
-Unfold sigma; Rewrite <- minus_n_n; Simpl; Replace (plus high O) with high; [Reflexivity | Ring].
+Theorem sigma_last :
+ forall low high:nat,
+ (low < high)%nat -> sigma low high = f high + sigma low (pred high).
+intros low high H1; generalize (lt_le_S low high H1); intro H2;
+ generalize (lt_le_weak low high H1); intro H3;
+ replace (f high) with (sigma high high).
+rewrite Rplus_comm; cut (high = S (pred high)).
+intro; pattern high at 3 in |- *; rewrite H.
+apply sigma_split.
+apply le_S_n; rewrite <- H; apply lt_le_S; assumption.
+apply lt_pred_n_n; apply le_lt_trans with low; [ apply le_O_n | assumption ].
+apply S_pred with 0%nat; apply le_lt_trans with low;
+ [ apply le_O_n | assumption ].
+unfold sigma in |- *; rewrite <- minus_n_n; simpl in |- *;
+ replace (high + 0)%nat with high; [ reflexivity | ring ].
Qed.
-Theorem sigma_eq_arg : (low:nat) (sigma low low)==(f low).
-Intro; Unfold sigma; Rewrite <- minus_n_n.
-Simpl; Replace (plus low O) with low; [Reflexivity | Ring].
+Theorem sigma_eq_arg : forall low:nat, sigma low low = f low.
+intro; unfold sigma in |- *; rewrite <- minus_n_n.
+simpl in |- *; replace (low + 0)%nat with low; [ reflexivity | ring ].
Qed.
-End Sigma.
+End Sigma. \ No newline at end of file
diff --git a/theories/Reals/Rsqrt_def.v b/theories/Reals/Rsqrt_def.v
index ebdece374..b123f1bb7 100644
--- a/theories/Reals/Rsqrt_def.v
+++ b/theories/Reals/Rsqrt_def.v
@@ -8,681 +8,755 @@
(*i $Id$ i*)
-Require Sumbool.
-Require Rbase.
-Require Rfunctions.
-Require SeqSeries.
-Require Ranalysis1.
-V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
+Require Import Sumbool.
+Require Import Rbase.
+Require Import Rfunctions.
+Require Import SeqSeries.
+Require Import Ranalysis1.
Open Local Scope R_scope.
-Fixpoint Dichotomy_lb [x,y:R;P:R->bool;N:nat] : R :=
-Cases N of
- O => x
-| (S n) => let down = (Dichotomy_lb x y P n) in let up = (Dichotomy_ub x y P n) in let z = ``(down+up)/2`` in if (P z) then down else z
-end
-with Dichotomy_ub [x,y:R;P:R->bool;N:nat] : R :=
-Cases N of
- O => y
-| (S n) => let down = (Dichotomy_lb x y P n) in let up = (Dichotomy_ub x y P n) in let z = ``(down+up)/2`` in if (P z) then z else up
-end.
+Fixpoint Dichotomy_lb (x y:R) (P:R -> bool) (N:nat) {struct N} : R :=
+ match N with
+ | O => x
+ | S n =>
+ let down := Dichotomy_lb x y P n in
+ let up := Dichotomy_ub x y P n in
+ let z := (down + up) / 2 in if P z then down else z
+ end
+
+ with Dichotomy_ub (x y:R) (P:R -> bool) (N:nat) {struct N} : R :=
+ match N with
+ | O => y
+ | S n =>
+ let down := Dichotomy_lb x y P n in
+ let up := Dichotomy_ub x y P n in
+ let z := (down + up) / 2 in if P z then z else up
+ end.
-Definition dicho_lb [x,y:R;P:R->bool] : nat->R := [N:nat](Dichotomy_lb x y P N).
-Definition dicho_up [x,y:R;P:R->bool] : nat->R := [N:nat](Dichotomy_ub x y P N).
+Definition dicho_lb (x y:R) (P:R -> bool) (N:nat) : R := Dichotomy_lb x y P N.
+Definition dicho_up (x y:R) (P:R -> bool) (N:nat) : R := Dichotomy_ub x y P N.
(**********)
-Lemma dicho_comp : (x,y:R;P:R->bool;n:nat) ``x<=y`` -> ``(dicho_lb x y P n)<=(dicho_up x y P n)``.
-Intros.
-Induction n.
-Simpl; Assumption.
-Simpl.
-Case (P ``((Dichotomy_lb x y P n)+(Dichotomy_ub x y P n))/2``).
-Unfold Rdiv; Apply Rle_monotony_contra with ``2``.
-Sup0.
-Pattern 1 ``2``; Rewrite Rmult_sym.
-Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Idtac | DiscrR].
-Rewrite Rmult_1r.
-Rewrite double.
-Apply Rle_compatibility.
-Assumption.
-Unfold Rdiv; Apply Rle_monotony_contra with ``2``.
-Sup0.
-Pattern 3 ``2``; Rewrite Rmult_sym.
-Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Idtac | DiscrR].
-Rewrite Rmult_1r.
-Rewrite double.
-Rewrite <- (Rplus_sym (Dichotomy_ub x y P n)).
-Apply Rle_compatibility.
-Assumption.
+Lemma dicho_comp :
+ forall (x y:R) (P:R -> bool) (n:nat),
+ x <= y -> dicho_lb x y P n <= dicho_up x y P n.
+intros.
+induction n as [| n Hrecn].
+simpl in |- *; assumption.
+simpl in |- *.
+case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)).
+unfold Rdiv in |- *; apply Rmult_le_reg_l with 2.
+prove_sup0.
+pattern 2 at 1 in |- *; rewrite Rmult_comm.
+rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ].
+rewrite Rmult_1_r.
+rewrite double.
+apply Rplus_le_compat_l.
+assumption.
+unfold Rdiv in |- *; apply Rmult_le_reg_l with 2.
+prove_sup0.
+pattern 2 at 3 in |- *; rewrite Rmult_comm.
+rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ].
+rewrite Rmult_1_r.
+rewrite double.
+rewrite <- (Rplus_comm (Dichotomy_ub x y P n)).
+apply Rplus_le_compat_l.
+assumption.
Qed.
-Lemma dicho_lb_growing : (x,y:R;P:R->bool) ``x<=y`` -> (Un_growing (dicho_lb x y P)).
-Intros.
-Unfold Un_growing.
-Intro.
-Simpl.
-Case (P ``((Dichotomy_lb x y P n)+(Dichotomy_ub x y P n))/2``).
-Right; Reflexivity.
-Unfold Rdiv; Apply Rle_monotony_contra with ``2``.
-Sup0.
-Pattern 1 ``2``; Rewrite Rmult_sym.
-Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Idtac | DiscrR].
-Rewrite Rmult_1r.
-Rewrite double.
-Apply Rle_compatibility.
-Replace (Dichotomy_ub x y P n) with (dicho_up x y P n); [Apply dicho_comp; Assumption | Reflexivity].
+Lemma dicho_lb_growing :
+ forall (x y:R) (P:R -> bool), x <= y -> Un_growing (dicho_lb x y P).
+intros.
+unfold Un_growing in |- *.
+intro.
+simpl in |- *.
+case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)).
+right; reflexivity.
+unfold Rdiv in |- *; apply Rmult_le_reg_l with 2.
+prove_sup0.
+pattern 2 at 1 in |- *; rewrite Rmult_comm.
+rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ].
+rewrite Rmult_1_r.
+rewrite double.
+apply Rplus_le_compat_l.
+replace (Dichotomy_ub x y P n) with (dicho_up x y P n);
+ [ apply dicho_comp; assumption | reflexivity ].
Qed.
-Lemma dicho_up_decreasing : (x,y:R;P:R->bool) ``x<=y`` -> (Un_decreasing (dicho_up x y P)).
-Intros.
-Unfold Un_decreasing.
-Intro.
-Simpl.
-Case (P ``((Dichotomy_lb x y P n)+(Dichotomy_ub x y P n))/2``).
-Unfold Rdiv; Apply Rle_monotony_contra with ``2``.
-Sup0.
-Pattern 3 ``2``; Rewrite Rmult_sym.
-Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Idtac | DiscrR].
-Rewrite Rmult_1r.
-Rewrite double.
-Replace (Dichotomy_ub x y P n) with (dicho_up x y P n); [Idtac | Reflexivity].
-Replace (Dichotomy_lb x y P n) with (dicho_lb x y P n); [Idtac | Reflexivity].
-Rewrite <- (Rplus_sym ``(dicho_up x y P n)``).
-Apply Rle_compatibility.
-Apply dicho_comp; Assumption.
-Right; Reflexivity.
+Lemma dicho_up_decreasing :
+ forall (x y:R) (P:R -> bool), x <= y -> Un_decreasing (dicho_up x y P).
+intros.
+unfold Un_decreasing in |- *.
+intro.
+simpl in |- *.
+case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)).
+unfold Rdiv in |- *; apply Rmult_le_reg_l with 2.
+prove_sup0.
+pattern 2 at 3 in |- *; rewrite Rmult_comm.
+rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ].
+rewrite Rmult_1_r.
+rewrite double.
+replace (Dichotomy_ub x y P n) with (dicho_up x y P n);
+ [ idtac | reflexivity ].
+replace (Dichotomy_lb x y P n) with (dicho_lb x y P n);
+ [ idtac | reflexivity ].
+rewrite <- (Rplus_comm (dicho_up x y P n)).
+apply Rplus_le_compat_l.
+apply dicho_comp; assumption.
+right; reflexivity.
Qed.
-Lemma dicho_lb_maj_y : (x,y:R;P:R->bool) ``x<=y`` -> (n:nat)``(dicho_lb x y P n)<=y``.
-Intros.
-Induction n.
-Simpl; Assumption.
-Simpl.
-Case (P ``((Dichotomy_lb x y P n)+(Dichotomy_ub x y P n))/2``).
-Assumption.
-Unfold Rdiv; Apply Rle_monotony_contra with ``2``.
-Sup0.
-Pattern 3 ``2``; Rewrite Rmult_sym.
-Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Rewrite Rmult_1r | DiscrR].
-Rewrite double; Apply Rplus_le.
-Assumption.
-Pattern 2 y; Replace y with (Dichotomy_ub x y P O); [Idtac | Reflexivity].
-Apply decreasing_prop.
-Assert H0 := (dicho_up_decreasing x y P H).
-Assumption.
-Apply le_O_n.
+Lemma dicho_lb_maj_y :
+ forall (x y:R) (P:R -> bool), x <= y -> forall n:nat, dicho_lb x y P n <= y.
+intros.
+induction n as [| n Hrecn].
+simpl in |- *; assumption.
+simpl in |- *.
+case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)).
+assumption.
+unfold Rdiv in |- *; apply Rmult_le_reg_l with 2.
+prove_sup0.
+pattern 2 at 3 in |- *; rewrite Rmult_comm.
+rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ rewrite Rmult_1_r | discrR ].
+rewrite double; apply Rplus_le_compat.
+assumption.
+pattern y at 2 in |- *; replace y with (Dichotomy_ub x y P 0);
+ [ idtac | reflexivity ].
+apply decreasing_prop.
+assert (H0 := dicho_up_decreasing x y P H).
+assumption.
+apply le_O_n.
Qed.
-Lemma dicho_lb_maj : (x,y:R;P:R->bool) ``x<=y`` -> (has_ub (dicho_lb x y P)).
-Intros.
-Cut (n:nat)``(dicho_lb x y P n)<=y``.
-Intro.
-Unfold has_ub.
-Unfold bound.
-Exists y.
-Unfold is_upper_bound.
-Intros.
-Elim H1; Intros.
-Rewrite H2; Apply H0.
-Apply dicho_lb_maj_y; Assumption.
+Lemma dicho_lb_maj :
+ forall (x y:R) (P:R -> bool), x <= y -> has_ub (dicho_lb x y P).
+intros.
+cut (forall n:nat, dicho_lb x y P n <= y).
+intro.
+unfold has_ub in |- *.
+unfold bound in |- *.
+exists y.
+unfold is_upper_bound in |- *.
+intros.
+elim H1; intros.
+rewrite H2; apply H0.
+apply dicho_lb_maj_y; assumption.
Qed.
-Lemma dicho_up_min_x : (x,y:R;P:R->bool) ``x<=y`` -> (n:nat)``x<=(dicho_up x y P n)``.
-Intros.
-Induction n.
-Simpl; Assumption.
-Simpl.
-Case (P ``((Dichotomy_lb x y P n)+(Dichotomy_ub x y P n))/2``).
-Unfold Rdiv; Apply Rle_monotony_contra with ``2``.
-Sup0.
-Pattern 1 ``2``; Rewrite Rmult_sym.
-Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Rewrite Rmult_1r | DiscrR].
-Rewrite double; Apply Rplus_le.
-Pattern 1 x; Replace x with (Dichotomy_lb x y P O); [Idtac | Reflexivity].
-Apply tech9.
-Assert H0 := (dicho_lb_growing x y P H).
-Assumption.
-Apply le_O_n.
-Assumption.
-Assumption.
+Lemma dicho_up_min_x :
+ forall (x y:R) (P:R -> bool), x <= y -> forall n:nat, x <= dicho_up x y P n.
+intros.
+induction n as [| n Hrecn].
+simpl in |- *; assumption.
+simpl in |- *.
+case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)).
+unfold Rdiv in |- *; apply Rmult_le_reg_l with 2.
+prove_sup0.
+pattern 2 at 1 in |- *; rewrite Rmult_comm.
+rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ rewrite Rmult_1_r | discrR ].
+rewrite double; apply Rplus_le_compat.
+pattern x at 1 in |- *; replace x with (Dichotomy_lb x y P 0);
+ [ idtac | reflexivity ].
+apply tech9.
+assert (H0 := dicho_lb_growing x y P H).
+assumption.
+apply le_O_n.
+assumption.
+assumption.
Qed.
-Lemma dicho_up_min : (x,y:R;P:R->bool) ``x<=y`` -> (has_lb (dicho_up x y P)).
-Intros.
-Cut (n:nat)``x<=(dicho_up x y P n)``.
-Intro.
-Unfold has_lb.
-Unfold bound.
-Exists ``-x``.
-Unfold is_upper_bound.
-Intros.
-Elim H1; Intros.
-Rewrite H2.
-Unfold opp_seq.
-Apply Rle_Ropp1.
-Apply H0.
-Apply dicho_up_min_x; Assumption.
+Lemma dicho_up_min :
+ forall (x y:R) (P:R -> bool), x <= y -> has_lb (dicho_up x y P).
+intros.
+cut (forall n:nat, x <= dicho_up x y P n).
+intro.
+unfold has_lb in |- *.
+unfold bound in |- *.
+exists (- x).
+unfold is_upper_bound in |- *.
+intros.
+elim H1; intros.
+rewrite H2.
+unfold opp_seq in |- *.
+apply Ropp_le_contravar.
+apply H0.
+apply dicho_up_min_x; assumption.
Qed.
-Lemma dicho_lb_cv : (x,y:R;P:R->bool) ``x<=y`` -> (sigTT R [l:R](Un_cv (dicho_lb x y P) l)).
-Intros.
-Apply growing_cv.
-Apply dicho_lb_growing; Assumption.
-Apply dicho_lb_maj; Assumption.
+Lemma dicho_lb_cv :
+ forall (x y:R) (P:R -> bool),
+ x <= y -> sigT (fun l:R => Un_cv (dicho_lb x y P) l).
+intros.
+apply growing_cv.
+apply dicho_lb_growing; assumption.
+apply dicho_lb_maj; assumption.
Qed.
-Lemma dicho_up_cv : (x,y:R;P:R->bool) ``x<=y`` -> (sigTT R [l:R](Un_cv (dicho_up x y P) l)).
-Intros.
-Apply decreasing_cv.
-Apply dicho_up_decreasing; Assumption.
-Apply dicho_up_min; Assumption.
+Lemma dicho_up_cv :
+ forall (x y:R) (P:R -> bool),
+ x <= y -> sigT (fun l:R => Un_cv (dicho_up x y P) l).
+intros.
+apply decreasing_cv.
+apply dicho_up_decreasing; assumption.
+apply dicho_up_min; assumption.
Qed.
-Lemma dicho_lb_dicho_up : (x,y:R;P:R->bool;n:nat) ``x<=y`` -> ``(dicho_up x y P n)-(dicho_lb x y P n)==(y-x)/(pow 2 n)``.
-Intros.
-Induction n.
-Simpl.
-Unfold Rdiv; Rewrite Rinv_R1; Ring.
-Simpl.
-Case (P ``((Dichotomy_lb x y P n)+(Dichotomy_ub x y P n))/2``).
-Unfold Rdiv.
-Replace ``((Dichotomy_lb x y P n)+(Dichotomy_ub x y P n))*/2-
- (Dichotomy_lb x y P n)`` with ``((dicho_up x y P n)-(dicho_lb x y P n))/2``.
-Unfold Rdiv; Rewrite Hrecn.
-Unfold Rdiv.
-Rewrite Rinv_Rmult.
-Ring.
-DiscrR.
-Apply pow_nonzero; DiscrR.
-Pattern 2 (Dichotomy_lb x y P n); Rewrite (double_var (Dichotomy_lb x y P n)); Unfold dicho_up dicho_lb Rminus Rdiv; Ring.
-Replace ``(Dichotomy_ub x y P n)-((Dichotomy_lb x y P n)+
- (Dichotomy_ub x y P n))/2`` with ``((dicho_up x y P n)-(dicho_lb x y P n))/2``.
-Unfold Rdiv; Rewrite Hrecn.
-Unfold Rdiv.
-Rewrite Rinv_Rmult.
-Ring.
-DiscrR.
-Apply pow_nonzero; DiscrR.
-Pattern 1 (Dichotomy_ub x y P n); Rewrite (double_var (Dichotomy_ub x y P n)); Unfold dicho_up dicho_lb Rminus Rdiv; Ring.
+Lemma dicho_lb_dicho_up :
+ forall (x y:R) (P:R -> bool) (n:nat),
+ x <= y -> dicho_up x y P n - dicho_lb x y P n = (y - x) / 2 ^ n.
+intros.
+induction n as [| n Hrecn].
+simpl in |- *.
+unfold Rdiv in |- *; rewrite Rinv_1; ring.
+simpl in |- *.
+case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)).
+unfold Rdiv in |- *.
+replace
+ ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) * / 2 - Dichotomy_lb x y P n)
+ with ((dicho_up x y P n - dicho_lb x y P n) / 2).
+unfold Rdiv in |- *; rewrite Hrecn.
+unfold Rdiv in |- *.
+rewrite Rinv_mult_distr.
+ring.
+discrR.
+apply pow_nonzero; discrR.
+pattern (Dichotomy_lb x y P n) at 2 in |- *;
+ rewrite (double_var (Dichotomy_lb x y P n));
+ unfold dicho_up, dicho_lb, Rminus, Rdiv in |- *; ring.
+replace
+ (Dichotomy_ub x y P n - (Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)
+ with ((dicho_up x y P n - dicho_lb x y P n) / 2).
+unfold Rdiv in |- *; rewrite Hrecn.
+unfold Rdiv in |- *.
+rewrite Rinv_mult_distr.
+ring.
+discrR.
+apply pow_nonzero; discrR.
+pattern (Dichotomy_ub x y P n) at 1 in |- *;
+ rewrite (double_var (Dichotomy_ub x y P n));
+ unfold dicho_up, dicho_lb, Rminus, Rdiv in |- *; ring.
Qed.
-Definition pow_2_n := [n:nat](pow ``2`` n).
+Definition pow_2_n (n:nat) := 2 ^ n.
-Lemma pow_2_n_neq_R0 : (n:nat) ``(pow_2_n n)<>0``.
-Intro.
-Unfold pow_2_n.
-Apply pow_nonzero.
-DiscrR.
+Lemma pow_2_n_neq_R0 : forall n:nat, pow_2_n n <> 0.
+intro.
+unfold pow_2_n in |- *.
+apply pow_nonzero.
+discrR.
Qed.
-Lemma pow_2_n_growing : (Un_growing pow_2_n).
-Unfold Un_growing.
-Intro.
-Replace (S n) with (plus n (1)); [Unfold pow_2_n; Rewrite pow_add | Ring].
-Pattern 1 (pow ``2`` n); Rewrite <- Rmult_1r.
-Apply Rle_monotony.
-Left; Apply pow_lt; Sup0.
-Simpl.
-Rewrite Rmult_1r.
-Pattern 1 R1; Rewrite <- Rplus_Or; Apply Rle_compatibility; Left; Apply Rlt_R0_R1.
+Lemma pow_2_n_growing : Un_growing pow_2_n.
+unfold Un_growing in |- *.
+intro.
+replace (S n) with (n + 1)%nat;
+ [ unfold pow_2_n in |- *; rewrite pow_add | ring ].
+pattern (2 ^ n) at 1 in |- *; rewrite <- Rmult_1_r.
+apply Rmult_le_compat_l.
+left; apply pow_lt; prove_sup0.
+simpl in |- *.
+rewrite Rmult_1_r.
+pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left;
+ apply Rlt_0_1.
Qed.
-Lemma pow_2_n_infty : (cv_infty pow_2_n).
-Cut (N:nat)``(INR N)<=(pow 2 N)``.
-Intros.
-Unfold cv_infty.
-Intro.
-Case (total_order_T R0 M); Intro.
-Elim s; Intro.
-Pose N := (up M).
-Cut `0<=N`.
-Intro.
-Elim (IZN N H0); Intros N0 H1.
-Exists N0.
-Intros.
-Apply Rlt_le_trans with (INR N0).
-Rewrite INR_IZR_INZ.
-Rewrite <- H1.
-Unfold N.
-Assert H3 := (archimed M).
-Elim H3; Intros; Assumption.
-Apply Rle_trans with (pow_2_n N0).
-Unfold pow_2_n; Apply H.
-Apply Rle_sym2.
-Apply growing_prop.
-Apply pow_2_n_growing.
-Assumption.
-Apply le_IZR.
-Unfold N.
-Simpl.
-Assert H0 := (archimed M); Elim H0; Intros.
-Left; Apply Rlt_trans with M; Assumption.
-Exists O; Intros.
-Rewrite <- b.
-Unfold pow_2_n; Apply pow_lt; Sup0.
-Exists O; Intros.
-Apply Rlt_trans with R0.
-Assumption.
-Unfold pow_2_n; Apply pow_lt; Sup0.
-Induction N.
-Simpl.
-Left; Apply Rlt_R0_R1.
-Intros.
-Pattern 2 (S n); Replace (S n) with (plus n (1)); [Idtac | Ring].
-Rewrite S_INR; Rewrite pow_add.
-Simpl.
-Rewrite Rmult_1r.
-Apply Rle_trans with ``(pow 2 n)``.
-Rewrite <- (Rplus_sym R1).
-Rewrite <- (Rmult_1r (INR n)).
-Apply (poly n R1).
-Apply Rlt_R0_R1.
-Pattern 1 (pow ``2`` n); Rewrite <- Rplus_Or.
-Rewrite <- (Rmult_sym ``2``).
-Rewrite double.
-Apply Rle_compatibility.
-Left; Apply pow_lt; Sup0.
+Lemma pow_2_n_infty : cv_infty pow_2_n.
+cut (forall N:nat, INR N <= 2 ^ N).
+intros.
+unfold cv_infty in |- *.
+intro.
+case (total_order_T 0 M); intro.
+elim s; intro.
+pose (N := up M).
+cut (0 <= N)%Z.
+intro.
+elim (IZN N H0); intros N0 H1.
+exists N0.
+intros.
+apply Rlt_le_trans with (INR N0).
+rewrite INR_IZR_INZ.
+rewrite <- H1.
+unfold N in |- *.
+assert (H3 := archimed M).
+elim H3; intros; assumption.
+apply Rle_trans with (pow_2_n N0).
+unfold pow_2_n in |- *; apply H.
+apply Rge_le.
+apply growing_prop.
+apply pow_2_n_growing.
+assumption.
+apply le_IZR.
+unfold N in |- *.
+simpl in |- *.
+assert (H0 := archimed M); elim H0; intros.
+left; apply Rlt_trans with M; assumption.
+exists 0%nat; intros.
+rewrite <- b.
+unfold pow_2_n in |- *; apply pow_lt; prove_sup0.
+exists 0%nat; intros.
+apply Rlt_trans with 0.
+assumption.
+unfold pow_2_n in |- *; apply pow_lt; prove_sup0.
+simple induction N.
+simpl in |- *.
+left; apply Rlt_0_1.
+intros.
+pattern (S n) at 2 in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ].
+rewrite S_INR; rewrite pow_add.
+simpl in |- *.
+rewrite Rmult_1_r.
+apply Rle_trans with (2 ^ n).
+rewrite <- (Rplus_comm 1).
+rewrite <- (Rmult_1_r (INR n)).
+apply (poly n 1).
+apply Rlt_0_1.
+pattern (2 ^ n) at 1 in |- *; rewrite <- Rplus_0_r.
+rewrite <- (Rmult_comm 2).
+rewrite double.
+apply Rplus_le_compat_l.
+left; apply pow_lt; prove_sup0.
Qed.
-Lemma cv_dicho : (x,y,l1,l2:R;P:R->bool) ``x<=y`` -> (Un_cv (dicho_lb x y P) l1) -> (Un_cv (dicho_up x y P) l2) -> l1==l2.
-Intros.
-Assert H2 := (CV_minus ? ? ? ? H0 H1).
-Cut (Un_cv [i:nat]``(dicho_lb x y P i)-(dicho_up x y P i)`` R0).
-Intro.
-Assert H4 := (UL_sequence ? ? ? H2 H3).
-Symmetry; Apply Rminus_eq_right; Assumption.
-Unfold Un_cv; Unfold R_dist.
-Intros.
-Assert H4 := (cv_infty_cv_R0 pow_2_n pow_2_n_neq_R0 pow_2_n_infty).
-Case (total_order_T x y); Intro.
-Elim s; Intro.
-Unfold Un_cv in H4; Unfold R_dist in H4.
-Cut ``0<y-x``.
-Intro Hyp.
-Cut ``0<eps/(y-x)``.
-Intro.
-Elim (H4 ``eps/(y-x)`` H5); Intros N H6.
-Exists N; Intros.
-Replace ``(dicho_lb x y P n)-(dicho_up x y P n)-0`` with ``(dicho_lb x y P n)-(dicho_up x y P n)``; [Idtac | Ring].
-Rewrite <- Rabsolu_Ropp.
-Rewrite Ropp_distr3.
-Rewrite dicho_lb_dicho_up.
-Unfold Rdiv; Rewrite Rabsolu_mult.
-Rewrite (Rabsolu_right ``y-x``).
-Apply Rlt_monotony_contra with ``/(y-x)``.
-Apply Rlt_Rinv; Assumption.
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l.
-Replace ``/(pow 2 n)`` with ``/(pow 2 n)-0``; [Unfold pow_2_n Rdiv in H6; Rewrite <- (Rmult_sym eps); Apply H6; Assumption | Ring].
-Red; Intro; Rewrite H8 in Hyp; Elim (Rlt_antirefl ? Hyp).
-Apply Rle_sym1.
-Apply Rle_anti_compatibility with x; Rewrite Rplus_Or.
-Replace ``x+(y-x)`` with y; [Assumption | Ring].
-Assumption.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Assumption].
-Apply Rlt_anti_compatibility with x; Rewrite Rplus_Or.
-Replace ``x+(y-x)`` with y; [Assumption | Ring].
-Exists O; Intros.
-Replace ``(dicho_lb x y P n)-(dicho_up x y P n)-0`` with ``(dicho_lb x y P n)-(dicho_up x y P n)``; [Idtac | Ring].
-Rewrite <- Rabsolu_Ropp.
-Rewrite Ropp_distr3.
-Rewrite dicho_lb_dicho_up.
-Rewrite b.
-Unfold Rminus Rdiv; Rewrite Rplus_Ropp_r; Rewrite Rmult_Ol; Rewrite Rabsolu_R0; Assumption.
-Assumption.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r)).
+Lemma cv_dicho :
+ forall (x y l1 l2:R) (P:R -> bool),
+ x <= y ->
+ Un_cv (dicho_lb x y P) l1 -> Un_cv (dicho_up x y P) l2 -> l1 = l2.
+intros.
+assert (H2 := CV_minus _ _ _ _ H0 H1).
+cut (Un_cv (fun i:nat => dicho_lb x y P i - dicho_up x y P i) 0).
+intro.
+assert (H4 := UL_sequence _ _ _ H2 H3).
+symmetry in |- *; apply Rminus_diag_uniq_sym; assumption.
+unfold Un_cv in |- *; unfold R_dist in |- *.
+intros.
+assert (H4 := cv_infty_cv_R0 pow_2_n pow_2_n_neq_R0 pow_2_n_infty).
+case (total_order_T x y); intro.
+elim s; intro.
+unfold Un_cv in H4; unfold R_dist in H4.
+cut (0 < y - x).
+intro Hyp.
+cut (0 < eps / (y - x)).
+intro.
+elim (H4 (eps / (y - x)) H5); intros N H6.
+exists N; intros.
+replace (dicho_lb x y P n - dicho_up x y P n - 0) with
+ (dicho_lb x y P n - dicho_up x y P n); [ idtac | ring ].
+rewrite <- Rabs_Ropp.
+rewrite Ropp_minus_distr'.
+rewrite dicho_lb_dicho_up.
+unfold Rdiv in |- *; rewrite Rabs_mult.
+rewrite (Rabs_right (y - x)).
+apply Rmult_lt_reg_l with (/ (y - x)).
+apply Rinv_0_lt_compat; assumption.
+rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
+rewrite Rmult_1_l.
+replace (/ 2 ^ n) with (/ 2 ^ n - 0);
+ [ unfold pow_2_n, Rdiv in H6; rewrite <- (Rmult_comm eps); apply H6;
+ assumption
+ | ring ].
+red in |- *; intro; rewrite H8 in Hyp; elim (Rlt_irrefl _ Hyp).
+apply Rle_ge.
+apply Rplus_le_reg_l with x; rewrite Rplus_0_r.
+replace (x + (y - x)) with y; [ assumption | ring ].
+assumption.
+unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ assumption | apply Rinv_0_lt_compat; assumption ].
+apply Rplus_lt_reg_r with x; rewrite Rplus_0_r.
+replace (x + (y - x)) with y; [ assumption | ring ].
+exists 0%nat; intros.
+replace (dicho_lb x y P n - dicho_up x y P n - 0) with
+ (dicho_lb x y P n - dicho_up x y P n); [ idtac | ring ].
+rewrite <- Rabs_Ropp.
+rewrite Ropp_minus_distr'.
+rewrite dicho_lb_dicho_up.
+rewrite b.
+unfold Rminus, Rdiv in |- *; rewrite Rplus_opp_r; rewrite Rmult_0_l;
+ rewrite Rabs_R0; assumption.
+assumption.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)).
Qed.
-Definition cond_positivity [x:R] : bool := Cases (total_order_Rle R0 x) of
- (leftT _) => true
-| (rightT _) => false end.
+Definition cond_positivity (x:R) : bool :=
+ match Rle_dec 0 x with
+ | left _ => true
+ | right _ => false
+ end.
(* Sequential caracterisation of continuity *)
-Lemma continuity_seq : (f:R->R;Un:nat->R;l:R) (continuity_pt f l) -> (Un_cv Un l) -> (Un_cv [i:nat](f (Un i)) (f l)).
-Unfold continuity_pt Un_cv; Unfold continue_in.
-Unfold limit1_in.
-Unfold limit_in.
-Unfold dist.
-Simpl.
-Unfold R_dist.
-Intros.
-Elim (H eps H1); Intros alp H2.
-Elim H2; Intros.
-Elim (H0 alp H3); Intros N H5.
-Exists N; Intros.
-Case (Req_EM (Un n) l); Intro.
-Rewrite H7; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption.
-Apply H4.
-Split.
-Unfold D_x no_cond.
-Split.
-Trivial.
-Apply not_sym; Assumption.
-Apply H5; Assumption.
+Lemma continuity_seq :
+ forall (f:R -> R) (Un:nat -> R) (l:R),
+ continuity_pt f l -> Un_cv Un l -> Un_cv (fun i:nat => f (Un i)) (f l).
+unfold continuity_pt, Un_cv in |- *; unfold continue_in in |- *.
+unfold limit1_in in |- *.
+unfold limit_in in |- *.
+unfold dist in |- *.
+simpl in |- *.
+unfold R_dist in |- *.
+intros.
+elim (H eps H1); intros alp H2.
+elim H2; intros.
+elim (H0 alp H3); intros N H5.
+exists N; intros.
+case (Req_dec (Un n) l); intro.
+rewrite H7; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+ assumption.
+apply H4.
+split.
+unfold D_x, no_cond in |- *.
+split.
+trivial.
+apply (sym_not_eq (A:=R)); assumption.
+apply H5; assumption.
Qed.
-Lemma dicho_lb_car : (x,y:R;P:R->bool;n:nat) (P x)=false -> (P (dicho_lb x y P n))=false.
-Intros.
-Induction n.
-Simpl.
-Assumption.
-Simpl.
-Assert X := (sumbool_of_bool (P ``((Dichotomy_lb x y P n)+(Dichotomy_ub x y P n))/2``)).
-Elim X; Intro.
-Rewrite a.
-Unfold dicho_lb in Hrecn; Assumption.
-Rewrite b.
-Assumption.
+Lemma dicho_lb_car :
+ forall (x y:R) (P:R -> bool) (n:nat),
+ P x = false -> P (dicho_lb x y P n) = false.
+intros.
+induction n as [| n Hrecn].
+simpl in |- *.
+assumption.
+simpl in |- *.
+assert
+ (X :=
+ sumbool_of_bool (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2))).
+elim X; intro.
+rewrite a.
+unfold dicho_lb in Hrecn; assumption.
+rewrite b.
+assumption.
Qed.
-Lemma dicho_up_car : (x,y:R;P:R->bool;n:nat) (P y)=true -> (P (dicho_up x y P n))=true.
-Intros.
-Induction n.
-Simpl.
-Assumption.
-Simpl.
-Assert X := (sumbool_of_bool (P ``((Dichotomy_lb x y P n)+(Dichotomy_ub x y P n))/2``)).
-Elim X; Intro.
-Rewrite a.
-Unfold dicho_lb in Hrecn; Assumption.
-Rewrite b.
-Assumption.
+Lemma dicho_up_car :
+ forall (x y:R) (P:R -> bool) (n:nat),
+ P y = true -> P (dicho_up x y P n) = true.
+intros.
+induction n as [| n Hrecn].
+simpl in |- *.
+assumption.
+simpl in |- *.
+assert
+ (X :=
+ sumbool_of_bool (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2))).
+elim X; intro.
+rewrite a.
+unfold dicho_lb in Hrecn; assumption.
+rewrite b.
+assumption.
Qed.
(* Intermediate Value Theorem *)
-Lemma IVT : (f:R->R;x,y:R) (continuity f) -> ``x<y`` -> ``(f x)<0`` -> ``0<(f y)`` -> (sigTT R [z:R]``x<=z<=y``/\``(f z)==0``).
-Intros.
-Cut ``x<=y``.
-Intro.
-Generalize (dicho_lb_cv x y [z:R](cond_positivity (f z)) H3).
-Generalize (dicho_up_cv x y [z:R](cond_positivity (f z)) H3).
-Intros.
-Elim X; Intros.
-Elim X0; Intros.
-Assert H4 := (cv_dicho ? ? ? ? ? H3 p0 p).
-Rewrite H4 in p0.
-Apply existTT with x0.
-Split.
-Split.
-Apply Rle_trans with (dicho_lb x y [z:R](cond_positivity (f z)) O).
-Simpl.
-Right; Reflexivity.
-Apply growing_ineq.
-Apply dicho_lb_growing; Assumption.
-Assumption.
-Apply Rle_trans with (dicho_up x y [z:R](cond_positivity (f z)) O).
-Apply decreasing_ineq.
-Apply dicho_up_decreasing; Assumption.
-Assumption.
-Right; Reflexivity.
-2:Left; Assumption.
-Pose Vn := [n:nat](dicho_lb x y [z:R](cond_positivity (f z)) n).
-Pose Wn := [n:nat](dicho_up x y [z:R](cond_positivity (f z)) n).
-Cut ((n:nat)``(f (Vn n))<=0``)->``(f x0)<=0``.
-Cut ((n:nat)``0<=(f (Wn n))``)->``0<=(f x0)``.
-Intros.
-Cut (n:nat)``(f (Vn n))<=0``.
-Cut (n:nat)``0<=(f (Wn n))``.
-Intros.
-Assert H9 := (H6 H8).
-Assert H10 := (H5 H7).
-Apply Rle_antisym; Assumption.
-Intro.
-Unfold Wn.
-Cut (z:R) (cond_positivity z)=true <-> ``0<=z``.
-Intro.
-Assert H8 := (dicho_up_car x y [z:R](cond_positivity (f z)) n).
-Elim (H7 (f (dicho_up x y [z:R](cond_positivity (f z)) n))); Intros.
-Apply H9.
-Apply H8.
-Elim (H7 (f y)); Intros.
-Apply H12.
-Left; Assumption.
-Intro.
-Unfold cond_positivity.
-Case (total_order_Rle R0 z); Intro.
-Split.
-Intro; Assumption.
-Intro; Reflexivity.
-Split.
-Intro; Elim diff_false_true; Assumption.
-Intro.
-Elim n0; Assumption.
-Unfold Vn.
-Cut (z:R) (cond_positivity z)=false <-> ``z<0``.
-Intros.
-Assert H8 := (dicho_lb_car x y [z:R](cond_positivity (f z)) n).
-Left.
-Elim (H7 (f (dicho_lb x y [z:R](cond_positivity (f z)) n))); Intros.
-Apply H9.
-Apply H8.
-Elim (H7 (f x)); Intros.
-Apply H12.
-Assumption.
-Intro.
-Unfold cond_positivity.
-Case (total_order_Rle R0 z); Intro.
-Split.
-Intro; Elim diff_true_false; Assumption.
-Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r H7)).
-Split.
-Intro; Auto with real.
-Intro; Reflexivity.
-Cut (Un_cv Wn x0).
-Intros.
-Assert H7 := (continuity_seq f Wn x0 (H x0) H5).
-Case (total_order_T R0 (f x0)); Intro.
-Elim s; Intro.
-Left; Assumption.
-Rewrite <- b; Right; Reflexivity.
-Unfold Un_cv in H7; Unfold R_dist in H7.
-Cut ``0< -(f x0)``.
-Intro.
-Elim (H7 ``-(f x0)`` H8); Intros.
-Cut (ge x2 x2); [Intro | Unfold ge; Apply le_n].
-Assert H11 := (H9 x2 H10).
-Rewrite Rabsolu_right in H11.
-Pattern 1 ``-(f x0)`` in H11; Rewrite <- Rplus_Or in H11.
-Unfold Rminus in H11; Rewrite (Rplus_sym (f (Wn x2))) in H11.
-Assert H12 := (Rlt_anti_compatibility ? ? ? H11).
-Assert H13 := (H6 x2).
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H13 H12)).
-Apply Rle_sym1; Left; Unfold Rminus; Apply ge0_plus_gt0_is_gt0.
-Apply H6.
-Exact H8.
-Apply Rgt_RO_Ropp; Assumption.
-Unfold Wn; Assumption.
-Cut (Un_cv Vn x0).
-Intros.
-Assert H7 := (continuity_seq f Vn x0 (H x0) H5).
-Case (total_order_T R0 (f x0)); Intro.
-Elim s; Intro.
-Unfold Un_cv in H7; Unfold R_dist in H7.
-Elim (H7 ``(f x0)`` a); Intros.
-Cut (ge x2 x2); [Intro | Unfold ge; Apply le_n].
-Assert H10 := (H8 x2 H9).
-Rewrite Rabsolu_left in H10.
-Pattern 2 ``(f x0)`` in H10; Rewrite <- Rplus_Or in H10.
-Rewrite Ropp_distr3 in H10.
-Unfold Rminus in H10.
-Assert H11 := (Rlt_anti_compatibility ? ? ? H10).
-Assert H12 := (H6 x2).
-Cut ``0<(f (Vn x2))``.
-Intro.
-Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? H13 H12)).
-Rewrite <- (Ropp_Ropp (f (Vn x2))).
-Apply Rgt_RO_Ropp; Assumption.
-Apply Rlt_anti_compatibility with ``(f x0)-(f (Vn x2))``.
-Rewrite Rplus_Or; Replace ``(f x0)-(f (Vn x2))+((f (Vn x2))-(f x0))`` with R0; [Unfold Rminus; Apply gt0_plus_ge0_is_gt0 | Ring].
-Assumption.
-Apply Rge_RO_Ropp; Apply Rle_sym1; Apply H6.
-Right; Rewrite <- b; Reflexivity.
-Left; Assumption.
-Unfold Vn; Assumption.
+Lemma IVT :
+ forall (f:R -> R) (x y:R),
+ continuity f ->
+ x < y -> f x < 0 -> 0 < f y -> sigT (fun z:R => x <= z <= y /\ f z = 0).
+intros.
+cut (x <= y).
+intro.
+generalize (dicho_lb_cv x y (fun z:R => cond_positivity (f z)) H3).
+generalize (dicho_up_cv x y (fun z:R => cond_positivity (f z)) H3).
+intros.
+elim X; intros.
+elim X0; intros.
+assert (H4 := cv_dicho _ _ _ _ _ H3 p0 p).
+rewrite H4 in p0.
+apply existT with x0.
+split.
+split.
+apply Rle_trans with (dicho_lb x y (fun z:R => cond_positivity (f z)) 0).
+simpl in |- *.
+right; reflexivity.
+apply growing_ineq.
+apply dicho_lb_growing; assumption.
+assumption.
+apply Rle_trans with (dicho_up x y (fun z:R => cond_positivity (f z)) 0).
+apply decreasing_ineq.
+apply dicho_up_decreasing; assumption.
+assumption.
+right; reflexivity.
+2: left; assumption.
+pose (Vn := fun n:nat => dicho_lb x y (fun z:R => cond_positivity (f z)) n).
+pose (Wn := fun n:nat => dicho_up x y (fun z:R => cond_positivity (f z)) n).
+cut ((forall n:nat, f (Vn n) <= 0) -> f x0 <= 0).
+cut ((forall n:nat, 0 <= f (Wn n)) -> 0 <= f x0).
+intros.
+cut (forall n:nat, f (Vn n) <= 0).
+cut (forall n:nat, 0 <= f (Wn n)).
+intros.
+assert (H9 := H6 H8).
+assert (H10 := H5 H7).
+apply Rle_antisym; assumption.
+intro.
+unfold Wn in |- *.
+cut (forall z:R, cond_positivity z = true <-> 0 <= z).
+intro.
+assert (H8 := dicho_up_car x y (fun z:R => cond_positivity (f z)) n).
+elim (H7 (f (dicho_up x y (fun z:R => cond_positivity (f z)) n))); intros.
+apply H9.
+apply H8.
+elim (H7 (f y)); intros.
+apply H12.
+left; assumption.
+intro.
+unfold cond_positivity in |- *.
+case (Rle_dec 0 z); intro.
+split.
+intro; assumption.
+intro; reflexivity.
+split.
+intro; elim diff_false_true; assumption.
+intro.
+elim n0; assumption.
+unfold Vn in |- *.
+cut (forall z:R, cond_positivity z = false <-> z < 0).
+intros.
+assert (H8 := dicho_lb_car x y (fun z:R => cond_positivity (f z)) n).
+left.
+elim (H7 (f (dicho_lb x y (fun z:R => cond_positivity (f z)) n))); intros.
+apply H9.
+apply H8.
+elim (H7 (f x)); intros.
+apply H12.
+assumption.
+intro.
+unfold cond_positivity in |- *.
+case (Rle_dec 0 z); intro.
+split.
+intro; elim diff_true_false; assumption.
+intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H7)).
+split.
+intro; auto with real.
+intro; reflexivity.
+cut (Un_cv Wn x0).
+intros.
+assert (H7 := continuity_seq f Wn x0 (H x0) H5).
+case (total_order_T 0 (f x0)); intro.
+elim s; intro.
+left; assumption.
+rewrite <- b; right; reflexivity.
+unfold Un_cv in H7; unfold R_dist in H7.
+cut (0 < - f x0).
+intro.
+elim (H7 (- f x0) H8); intros.
+cut (x2 >= x2)%nat; [ intro | unfold ge in |- *; apply le_n ].
+assert (H11 := H9 x2 H10).
+rewrite Rabs_right in H11.
+pattern (- f x0) at 1 in H11; rewrite <- Rplus_0_r in H11.
+unfold Rminus in H11; rewrite (Rplus_comm (f (Wn x2))) in H11.
+assert (H12 := Rplus_lt_reg_r _ _ _ H11).
+assert (H13 := H6 x2).
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H13 H12)).
+apply Rle_ge; left; unfold Rminus in |- *; apply Rplus_le_lt_0_compat.
+apply H6.
+exact H8.
+apply Ropp_0_gt_lt_contravar; assumption.
+unfold Wn in |- *; assumption.
+cut (Un_cv Vn x0).
+intros.
+assert (H7 := continuity_seq f Vn x0 (H x0) H5).
+case (total_order_T 0 (f x0)); intro.
+elim s; intro.
+unfold Un_cv in H7; unfold R_dist in H7.
+elim (H7 (f x0) a); intros.
+cut (x2 >= x2)%nat; [ intro | unfold ge in |- *; apply le_n ].
+assert (H10 := H8 x2 H9).
+rewrite Rabs_left in H10.
+pattern (f x0) at 2 in H10; rewrite <- Rplus_0_r in H10.
+rewrite Ropp_minus_distr' in H10.
+unfold Rminus in H10.
+assert (H11 := Rplus_lt_reg_r _ _ _ H10).
+assert (H12 := H6 x2).
+cut (0 < f (Vn x2)).
+intro.
+elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H13 H12)).
+rewrite <- (Ropp_involutive (f (Vn x2))).
+apply Ropp_0_gt_lt_contravar; assumption.
+apply Rplus_lt_reg_r with (f x0 - f (Vn x2)).
+rewrite Rplus_0_r; replace (f x0 - f (Vn x2) + (f (Vn x2) - f x0)) with 0;
+ [ unfold Rminus in |- *; apply Rplus_lt_le_0_compat | ring ].
+assumption.
+apply Ropp_0_ge_le_contravar; apply Rle_ge; apply H6.
+right; rewrite <- b; reflexivity.
+left; assumption.
+unfold Vn in |- *; assumption.
Qed.
-Lemma IVT_cor : (f:R->R;x,y:R) (continuity f) -> ``x<=y`` -> ``(f x)*(f y)<=0`` -> (sigTT R [z:R]``x<=z<=y``/\``(f z)==0``).
-Intros.
-Case (total_order_T R0 (f x)); Intro.
-Case (total_order_T R0 (f y)); Intro.
-Elim s; Intro.
-Elim s0; Intro.
-Cut ``0<(f x)*(f y)``; [Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H1 H2)) | Apply Rmult_lt_pos; Assumption].
-Exists y.
-Split.
-Split; [Assumption | Right; Reflexivity].
-Symmetry; Exact b.
-Exists x.
-Split.
-Split; [Right; Reflexivity | Assumption].
-Symmetry; Exact b.
-Elim s; Intro.
-Cut ``x<y``.
-Intro.
-Assert H3 := (IVT (opp_fct f) x y (continuity_opp f H) H2).
-Cut ``(opp_fct f x)<0``.
-Cut ``0<(opp_fct f y)``.
-Intros.
-Elim (H3 H5 H4); Intros.
-Apply existTT with x0.
-Elim p; Intros.
-Split.
-Assumption.
-Unfold opp_fct in H7.
-Rewrite <- (Ropp_Ropp (f x0)).
-Apply eq_RoppO; Assumption.
-Unfold opp_fct; Apply Rgt_RO_Ropp; Assumption.
-Unfold opp_fct.
-Apply Rlt_anti_compatibility with (f x); Rewrite Rplus_Ropp_r; Rewrite Rplus_Or; Assumption.
-Inversion H0.
-Assumption.
-Rewrite H2 in a.
-Elim (Rlt_antirefl ? (Rlt_trans ? ? ? r a)).
-Apply existTT with x.
-Split.
-Split; [Right; Reflexivity | Assumption].
-Symmetry; Assumption.
-Case (total_order_T R0 (f y)); Intro.
-Elim s; Intro.
-Cut ``x<y``.
-Intro.
-Apply IVT; Assumption.
-Inversion H0.
-Assumption.
-Rewrite H2 in r.
-Elim (Rlt_antirefl ? (Rlt_trans ? ? ? r a)).
-Apply existTT with y.
-Split.
-Split; [Assumption | Right; Reflexivity].
-Symmetry; Assumption.
-Cut ``0<(f x)*(f y)``.
-Intro.
-Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? H2 H1)).
-Rewrite <- Ropp_mul2; Apply Rmult_lt_pos; Apply Rgt_RO_Ropp; Assumption.
+Lemma IVT_cor :
+ forall (f:R -> R) (x y:R),
+ continuity f ->
+ x <= y -> f x * f y <= 0 -> sigT (fun z:R => x <= z <= y /\ f z = 0).
+intros.
+case (total_order_T 0 (f x)); intro.
+case (total_order_T 0 (f y)); intro.
+elim s; intro.
+elim s0; intro.
+cut (0 < f x * f y);
+ [ intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 H2))
+ | apply Rmult_lt_0_compat; assumption ].
+exists y.
+split.
+split; [ assumption | right; reflexivity ].
+symmetry in |- *; exact b.
+exists x.
+split.
+split; [ right; reflexivity | assumption ].
+symmetry in |- *; exact b.
+elim s; intro.
+cut (x < y).
+intro.
+assert (H3 := IVT (- f)%F x y (continuity_opp f H) H2).
+cut ((- f)%F x < 0).
+cut (0 < (- f)%F y).
+intros.
+elim (H3 H5 H4); intros.
+apply existT with x0.
+elim p; intros.
+split.
+assumption.
+unfold opp_fct in H7.
+rewrite <- (Ropp_involutive (f x0)).
+apply Ropp_eq_0_compat; assumption.
+unfold opp_fct in |- *; apply Ropp_0_gt_lt_contravar; assumption.
+unfold opp_fct in |- *.
+apply Rplus_lt_reg_r with (f x); rewrite Rplus_opp_r; rewrite Rplus_0_r;
+ assumption.
+inversion H0.
+assumption.
+rewrite H2 in a.
+elim (Rlt_irrefl _ (Rlt_trans _ _ _ r a)).
+apply existT with x.
+split.
+split; [ right; reflexivity | assumption ].
+symmetry in |- *; assumption.
+case (total_order_T 0 (f y)); intro.
+elim s; intro.
+cut (x < y).
+intro.
+apply IVT; assumption.
+inversion H0.
+assumption.
+rewrite H2 in r.
+elim (Rlt_irrefl _ (Rlt_trans _ _ _ r a)).
+apply existT with y.
+split.
+split; [ assumption | right; reflexivity ].
+symmetry in |- *; assumption.
+cut (0 < f x * f y).
+intro.
+elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H2 H1)).
+rewrite <- Rmult_opp_opp; apply Rmult_lt_0_compat;
+ apply Ropp_0_gt_lt_contravar; assumption.
Qed.
(* We can now define the square root function as the reciprocal transformation of the square root function *)
-Lemma Rsqrt_exists : (y:R) ``0<=y`` -> (sigTT R [z:R]``0<=z``/\``y==(Rsqr z)``).
-Intros.
-Pose f := [x:R]``(Rsqr x)-y``.
-Cut ``(f 0)<=0``.
-Intro.
-Cut (continuity f).
-Intro.
-Case (total_order_T y R1); Intro.
-Elim s; Intro.
-Cut ``0<=(f 1)``.
-Intro.
-Cut ``(f 0)*(f 1)<=0``.
-Intro.
-Assert X := (IVT_cor f R0 R1 H1 (Rlt_le ? ? Rlt_R0_R1) H3).
-Elim X; Intros t H4.
-Apply existTT with t.
-Elim H4; Intros.
-Split.
-Elim H5; Intros; Assumption.
-Unfold f in H6.
-Apply Rminus_eq_right; Exact H6.
-Rewrite Rmult_sym; Pattern 2 R0; Rewrite <- (Rmult_Or (f R1)).
-Apply Rle_monotony; Assumption.
-Unfold f.
-Rewrite Rsqr_1.
-Apply Rle_anti_compatibility with y.
-Rewrite Rplus_Or; Rewrite Rplus_sym; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Left; Assumption.
-Apply existTT with R1.
-Split.
-Left; Apply Rlt_R0_R1.
-Rewrite b; Symmetry; Apply Rsqr_1.
-Cut ``0<=(f y)``.
-Intro.
-Cut ``(f 0)*(f y)<=0``.
-Intro.
-Assert X := (IVT_cor f R0 y H1 H H3).
-Elim X; Intros t H4.
-Apply existTT with t.
-Elim H4; Intros.
-Split.
-Elim H5; Intros; Assumption.
-Unfold f in H6.
-Apply Rminus_eq_right; Exact H6.
-Rewrite Rmult_sym; Pattern 2 R0; Rewrite <- (Rmult_Or (f y)).
-Apply Rle_monotony; Assumption.
-Unfold f.
-Apply Rle_anti_compatibility with y.
-Rewrite Rplus_Or; Rewrite Rplus_sym; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or.
-Pattern 1 y; Rewrite <- Rmult_1r.
-Unfold Rsqr; Apply Rle_monotony.
-Assumption.
-Left; Exact r.
-Replace f with (minus_fct Rsqr (fct_cte y)).
-Apply continuity_minus.
-Apply derivable_continuous; Apply derivable_Rsqr.
-Apply derivable_continuous; Apply derivable_const.
-Reflexivity.
-Unfold f; Rewrite Rsqr_O.
-Unfold Rminus; Rewrite Rplus_Ol.
-Apply Rle_sym2.
-Apply Rle_RO_Ropp; Assumption.
+Lemma Rsqrt_exists :
+ forall y:R, 0 <= y -> sigT (fun z:R => 0 <= z /\ y = Rsqr z).
+intros.
+pose (f := fun x:R => Rsqr x - y).
+cut (f 0 <= 0).
+intro.
+cut (continuity f).
+intro.
+case (total_order_T y 1); intro.
+elim s; intro.
+cut (0 <= f 1).
+intro.
+cut (f 0 * f 1 <= 0).
+intro.
+assert (X := IVT_cor f 0 1 H1 (Rlt_le _ _ Rlt_0_1) H3).
+elim X; intros t H4.
+apply existT with t.
+elim H4; intros.
+split.
+elim H5; intros; assumption.
+unfold f in H6.
+apply Rminus_diag_uniq_sym; exact H6.
+rewrite Rmult_comm; pattern 0 at 2 in |- *; rewrite <- (Rmult_0_r (f 1)).
+apply Rmult_le_compat_l; assumption.
+unfold f in |- *.
+rewrite Rsqr_1.
+apply Rplus_le_reg_l with y.
+rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus in |- *;
+ rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r;
+ left; assumption.
+apply existT with 1.
+split.
+left; apply Rlt_0_1.
+rewrite b; symmetry in |- *; apply Rsqr_1.
+cut (0 <= f y).
+intro.
+cut (f 0 * f y <= 0).
+intro.
+assert (X := IVT_cor f 0 y H1 H H3).
+elim X; intros t H4.
+apply existT with t.
+elim H4; intros.
+split.
+elim H5; intros; assumption.
+unfold f in H6.
+apply Rminus_diag_uniq_sym; exact H6.
+rewrite Rmult_comm; pattern 0 at 2 in |- *; rewrite <- (Rmult_0_r (f y)).
+apply Rmult_le_compat_l; assumption.
+unfold f in |- *.
+apply Rplus_le_reg_l with y.
+rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus in |- *;
+ rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r.
+pattern y at 1 in |- *; rewrite <- Rmult_1_r.
+unfold Rsqr in |- *; apply Rmult_le_compat_l.
+assumption.
+left; exact r.
+replace f with (Rsqr - fct_cte y)%F.
+apply continuity_minus.
+apply derivable_continuous; apply derivable_Rsqr.
+apply derivable_continuous; apply derivable_const.
+reflexivity.
+unfold f in |- *; rewrite Rsqr_0.
+unfold Rminus in |- *; rewrite Rplus_0_l.
+apply Rge_le.
+apply Ropp_0_le_ge_contravar; assumption.
Qed.
(* Definition of the square root: R+->R *)
-Definition Rsqrt [y:nonnegreal] : R := Cases (Rsqrt_exists (nonneg y) (cond_nonneg y)) of (existTT a b) => a end.
+Definition Rsqrt (y:nonnegreal) : R :=
+ match Rsqrt_exists (nonneg y) (cond_nonneg y) with
+ | existT a b => a
+ end.
(**********)
-Lemma Rsqrt_positivity : (x:nonnegreal) ``0<=(Rsqrt x)``.
-Intro.
-Assert X := (Rsqrt_exists (nonneg x) (cond_nonneg x)).
-Elim X; Intros.
-Cut x0==(Rsqrt x).
-Intros.
-Elim p; Intros.
-Rewrite H in H0; Assumption.
-Unfold Rsqrt.
-Case (Rsqrt_exists x (cond_nonneg x)).
-Intros.
-Elim p; Elim a; Intros.
-Apply Rsqr_inj.
-Assumption.
-Assumption.
-Rewrite <- H0; Rewrite <- H2; Reflexivity.
+Lemma Rsqrt_positivity : forall x:nonnegreal, 0 <= Rsqrt x.
+intro.
+assert (X := Rsqrt_exists (nonneg x) (cond_nonneg x)).
+elim X; intros.
+cut (x0 = Rsqrt x).
+intros.
+elim p; intros.
+rewrite H in H0; assumption.
+unfold Rsqrt in |- *.
+case (Rsqrt_exists x (cond_nonneg x)).
+intros.
+elim p; elim a; intros.
+apply Rsqr_inj.
+assumption.
+assumption.
+rewrite <- H0; rewrite <- H2; reflexivity.
Qed.
(**********)
-Lemma Rsqrt_Rsqrt : (x:nonnegreal) ``(Rsqrt x)*(Rsqrt x)==x``.
-Intros.
-Assert X := (Rsqrt_exists (nonneg x) (cond_nonneg x)).
-Elim X; Intros.
-Cut x0==(Rsqrt x).
-Intros.
-Rewrite <- H.
-Elim p; Intros.
-Rewrite H1; Reflexivity.
-Unfold Rsqrt.
-Case (Rsqrt_exists x (cond_nonneg x)).
-Intros.
-Elim p; Elim a; Intros.
-Apply Rsqr_inj.
-Assumption.
-Assumption.
-Rewrite <- H0; Rewrite <- H2; Reflexivity.
-Qed.
+Lemma Rsqrt_Rsqrt : forall x:nonnegreal, Rsqrt x * Rsqrt x = x.
+intros.
+assert (X := Rsqrt_exists (nonneg x) (cond_nonneg x)).
+elim X; intros.
+cut (x0 = Rsqrt x).
+intros.
+rewrite <- H.
+elim p; intros.
+rewrite H1; reflexivity.
+unfold Rsqrt in |- *.
+case (Rsqrt_exists x (cond_nonneg x)).
+intros.
+elim p; elim a; intros.
+apply Rsqr_inj.
+assumption.
+assumption.
+rewrite <- H0; rewrite <- H2; reflexivity.
+Qed. \ No newline at end of file
diff --git a/theories/Reals/Rsyntax.v b/theories/Reals/Rsyntax.v
index 53f8aec07..b453ef9db 100644
--- a/theories/Reals/Rsyntax.v
+++ b/theories/Reals/Rsyntax.v
@@ -9,228 +9,5 @@
Require Export Rdefinitions.
-Axiom NRplus : R->R.
-Axiom NRmult : R->R.
-
-V7only[
-Grammar rnatural ident :=
- nat_id [ prim:var($id) ] -> [$id]
-
-with rnegnumber : constr :=
- neg_expr [ "-" rnumber ($c) ] -> [ (Ropp $c) ]
-
-with rnumber :=
-
-with rformula : constr :=
- form_expr [ rexpr($p) ] -> [ $p ]
-(* | form_eq [ rexpr($p) "==" rexpr($c) ] -> [ (eqT R $p $c) ] *)
-| form_eq [ rexpr($p) "==" rexpr($c) ] -> [ (eqT ? $p $c) ]
-| form_eq2 [ rexpr($p) "=" rexpr($c) ] -> [ (eqT ? $p $c) ]
-| form_le [ rexpr($p) "<=" rexpr($c) ] -> [ (Rle $p $c) ]
-| form_lt [ rexpr($p) "<" rexpr($c) ] -> [ (Rlt $p $c) ]
-| form_ge [ rexpr($p) ">=" rexpr($c) ] -> [ (Rge $p $c) ]
-| form_gt [ rexpr($p) ">" rexpr($c) ] -> [ (Rgt $p $c) ]
-(*
-| form_eq_eq [ rexpr($p) "==" rexpr($c) "==" rexpr($c1) ]
- -> [ (eqT R $p $c)/\(eqT R $c $c1) ]
-*)
-| form_eq_eq [ rexpr($p) "==" rexpr($c) "==" rexpr($c1) ]
- -> [ (eqT ? $p $c)/\(eqT ? $c $c1) ]
-| form_le_le [ rexpr($p) "<=" rexpr($c) "<=" rexpr($c1) ]
- -> [ (Rle $p $c)/\(Rle $c $c1) ]
-| form_le_lt [ rexpr($p) "<=" rexpr($c) "<" rexpr($c1) ]
- -> [ (Rle $p $c)/\(Rlt $c $c1) ]
-| form_lt_le [ rexpr($p) "<" rexpr($c) "<=" rexpr($c1) ]
- -> [ (Rlt $p $c)/\(Rle $c $c1) ]
-| form_lt_lt [ rexpr($p) "<" rexpr($c) "<" rexpr($c1) ]
- -> [ (Rlt $p $c)/\(Rlt $c $c1) ]
-| form_neq [ rexpr($p) "<>" rexpr($c) ] -> [ ~(eqT ? $p $c) ]
-
-with rexpr : constr :=
- expr_plus [ rexpr($p) "+" rexpr($c) ] -> [ (Rplus $p $c) ]
-| expr_minus [ rexpr($p) "-" rexpr($c) ] -> [ (Rminus $p $c) ]
-| rexpr2 [ rexpr2($e) ] -> [ $e ]
-
-with rexpr2 : constr :=
- expr_mult [ rexpr2($p) "*" rexpr2($c) ] -> [ (Rmult $p $c) ]
-| rexpr0 [ rexpr0($e) ] -> [ $e ]
-
-
-with rexpr0 : constr :=
- expr_id [ constr:global($c) ] -> [ $c ]
-| expr_com [ "[" constr:constr($c) "]" ] -> [ $c ]
-| expr_appl [ "(" rapplication($a) ")" ] -> [ $a ]
-| expr_num [ rnumber($s) ] -> [ $s ]
-| expr_negnum [ "-" rnegnumber($n) ] -> [ $n ]
-| expr_div [ rexpr0($p) "/" rexpr0($c) ] -> [ (Rdiv $p $c) ]
-| expr_opp [ "-" rexpr0($c) ] -> [ (Ropp $c) ]
-| expr_inv [ "/" rexpr0($c) ] -> [ (Rinv $c) ]
-| expr_meta [ meta($m) ] -> [ $m ]
-
-with meta :=
-| rimpl [ "?" ] -> [ ? ]
-| rmeta0 [ "?" "0" ] -> [ ?0 ]
-| rmeta1 [ "?" "1" ] -> [ ?1 ]
-| rmeta2 [ "?" "2" ] -> [ ?2 ]
-| rmeta3 [ "?" "3" ] -> [ ?3 ]
-| rmeta4 [ "?" "4" ] -> [ ?4 ]
-| rmeta5 [ "?" "5" ] -> [ ?5 ]
-
-with rapplication : constr :=
- apply [ rapplication($p) rexpr($c1) ] -> [ ($p $c1) ]
-| pair [ rexpr($p) "," rexpr($c) ] -> [ ($p, $c) ]
-| appl0 [ rexpr($a) ] -> [ $a ].
-
-Grammar constr constr0 :=
- r_in_com [ "``" rnatural:rformula($c) "``" ] -> [ $c ].
-
-Grammar constr atomic_pattern :=
- r_in_pattern [ "``" rnatural:rnumber($c) "``" ] -> [ $c ].
-
-(*i* pp **)
-
-Syntax constr
- level 0:
- Rle [ (Rle $n1 $n2) ] ->
- [[<hov 0> "``" (REXPR $n1) [1 0] "<= " (REXPR $n2) "``"]]
- | Rlt [ (Rlt $n1 $n2) ] ->
- [[<hov 0> "``" (REXPR $n1) [1 0] "< "(REXPR $n2) "``" ]]
- | Rge [ (Rge $n1 $n2) ] ->
- [[<hov 0> "``" (REXPR $n1) [1 0] ">= "(REXPR $n2) "``" ]]
- | Rgt [ (Rgt $n1 $n2) ] ->
- [[<hov 0> "``" (REXPR $n1) [1 0] "> "(REXPR $n2) "``" ]]
- | Req [ (eqT R $n1 $n2) ] ->
- [[<hov 0> "``" (REXPR $n1) [1 0] "= "(REXPR $n2)"``"]]
- | Rneq [ ~(eqT R $n1 $n2) ] ->
- [[<hov 0> "``" (REXPR $n1) [1 0] "<> "(REXPR $n2) "``"]]
- | Rle_Rle [ (Rle $n1 $n2)/\(Rle $n2 $n3) ] ->
- [[<hov 0> "``" (REXPR $n1) [1 0] "<= " (REXPR $n2)
- [1 0] "<= " (REXPR $n3) "``"]]
- | Rle_Rlt [ (Rle $n1 $n2)/\(Rlt $n2 $n3) ] ->
- [[<hov 0> "``" (REXPR $n1) [1 0] "<= "(REXPR $n2)
- [1 0] "< " (REXPR $n3) "``"]]
- | Rlt_Rle [ (Rlt $n1 $n2)/\(Rle $n2 $n3) ] ->
- [[<hov 0> "``" (REXPR $n1) [1 0] "< " (REXPR $n2)
- [1 0] "<= " (REXPR $n3) "``"]]
- | Rlt_Rlt [ (Rlt $n1 $n2)/\(Rlt $n2 $n3) ] ->
- [[<hov 0> "``" (REXPR $n1) [1 0] "< " (REXPR $n2)
- [1 0] "< " (REXPR $n3) "``"]]
- | Rzero [ R0 ] -> [ "``0``" ]
- | Rone [ R1 ] -> [ "``1``" ]
- ;
-
- level 7:
- Rplus [ (Rplus $n1 $n2) ]
- -> [ [<hov 0> "``"(REXPR $n1):E "+" [0 0] (REXPR $n2):L "``"] ]
- | Rodd_outside [(Rplus R1 $r)] -> [ $r:"r_printer_odd_outside"]
- | Rminus [ (Rminus $n1 $n2) ]
- -> [ [<hov 0> "``"(REXPR $n1):E "-" [0 0] (REXPR $n2):L "``"] ]
- ;
-
- level 6:
- Rmult [ (Rmult $n1 $n2) ]
- -> [ [<hov 0> "``"(REXPR $n1):E "*" [0 0] (REXPR $n2):L "``"] ]
- | Reven_outside [ (Rmult (Rplus R1 R1) $r) ] -> [ $r:"r_printer_even_outside"]
- | Rdiv [ (Rdiv $n1 $n2) ]
- -> [ [<hov 0> "``"(REXPR $n1):E "/" [0 0] (REXPR $n2):L "``"] ]
- ;
-
- level 8:
- Ropp [(Ropp $n1)] -> [ [<hov 0> "``" "-"(REXPR $n1):E "``"] ]
- | Rinv [(Rinv $n1)] -> [ [<hov 0> "``" "/"(REXPR $n1):E "``"] ]
- ;
-
- level 0:
- rescape_inside [<< (REXPR $r) >>] -> [ "[" $r:E "]" ]
- ;
-
- level 4:
- Rappl_inside [<<(REXPR (APPLIST $h ($LIST $t)))>>]
- -> [ [<hov 0> "("(REXPR $h):E [1 0] (RAPPLINSIDETAIL ($LIST $t)):E ")"] ]
- | Rappl_inside_tail [<<(RAPPLINSIDETAIL $h ($LIST $t))>>]
- -> [(REXPR $h):E [1 0] (RAPPLINSIDETAIL ($LIST $t)):E]
- | Rappl_inside_one [<<(RAPPLINSIDETAIL $e)>>] ->[(REXPR $e):E]
- | rpair_inside [<<(REXPR <<(pair $s1 $s2 $r1 $r2)>>)>>]
- -> [ [<hov 0> "("(REXPR $r1):E "," [1 0] (REXPR $r2):E ")"] ]
- ;
-
- level 3:
- rvar_inside [<<(REXPR ($VAR $i))>>] -> [$i]
- | rsecvar_inside [<<(REXPR (SECVAR $i))>>] -> [(SECVAR $i)]
- | rconst_inside [<<(REXPR (CONST $c))>>] -> [(CONST $c)]
- | rmutind_inside [<<(REXPR (MUTIND $i $n))>>]
- -> [(MUTIND $i $n)]
- | rmutconstruct_inside [<<(REXPR (MUTCONSTRUCT $c1 $c2 $c3))>>]
- -> [ (MUTCONSTRUCT $c1 $c2 $c3) ]
- | rimplicit_head_inside [<<(REXPR (XTRA "!" $c))>>] -> [ $c ]
- | rimplicit_arg_inside [<<(REXPR (XTRA "!" $n $c))>>] -> [ ]
-
- ;
-
-
- level 7:
- Rplus_inside
- [<<(REXPR <<(Rplus $n1 $n2)>>)>>]
- -> [ (REXPR $n1):E "+" [0 0] (REXPR $n2):L ]
- | Rminus_inside
- [<<(REXPR <<(Rminus $n1 $n2)>>)>>]
- -> [ (REXPR $n1):E "-" [0 0] (REXPR $n2):L ]
- | NRplus_inside
- [<<(REXPR <<(NRplus $r)>>)>>] -> [ "(" "1" "+" (REXPR $r):L ")"]
- ;
-
- level 6:
- Rmult_inside
- [<<(REXPR <<(Rmult $n1 $n2)>>)>>]
- -> [ (REXPR $n1):E "*" (REXPR $n2):L ]
- | NRmult_inside
- [<<(REXPR <<(NRmult $r)>>)>>] -> [ "(" "2" "*" (REXPR $r):L ")"]
- ;
-
- level 5:
- Ropp_inside [<<(REXPR <<(Ropp $n1)>>)>>] -> [ " -" (REXPR $n1):E ]
- | Rinv_inside [<<(REXPR <<(Rinv $n1)>>)>>] -> [ "/" (REXPR $n1):E ]
- | Rdiv_inside
- [<<(REXPR <<(Rdiv $n1 $n2)>>)>>]
- -> [ (REXPR $n1):E "/" [0 0] (REXPR $n2):L ]
- ;
-
- level 0:
- Rzero_inside [<<(REXPR <<R0>>)>>] -> ["0"]
- | Rone_inside [<<(REXPR <<R1>>)>>] -> ["1"]
- | Rodd_inside [<<(REXPR <<(Rplus R1 $r)>>)>>] -> [ $r:"r_printer_odd" ]
- | Reven_inside [<<(REXPR <<(Rmult (Rplus R1 R1) $r)>>)>>] -> [ $r:"r_printer_even" ]
-.
-
-(* For parsing/printing based on scopes *)
-Module R_scope.
-
-Infix "<=" Rle (at level 5, no associativity) : R_scope V8only.
-Infix "<" Rlt (at level 5, no associativity) : R_scope V8only.
-Infix ">=" Rge (at level 5, no associativity) : R_scope V8only.
-Infix ">" Rgt (at level 5, no associativity) : R_scope V8only.
-Infix "+" Rplus (at level 4) : R_scope V8only.
-Infix "-" Rminus (at level 4) : R_scope V8only.
-Infix "*" Rmult (at level 3) : R_scope V8only.
-Infix "/" Rdiv (at level 3) : R_scope V8only.
-Notation "- x" := (Ropp x) (at level 0) : R_scope V8only.
-Notation "x == y == z" := (eqT R x y)/\(eqT R y z)
- (at level 5, y at level 4, no associtivity): R_scope.
-Notation "x <= y <= z" := (Rle x y)/\(Rle y z)
- (at level 5, y at level 4) : R_scope
- V8only.
-Notation "x <= y < z" := (Rle x y)/\(Rlt y z)
- (at level 5, y at level 4) : R_scope
- V8only.
-Notation "x < y < z" := (Rlt x y)/\(Rlt y z)
- (at level 5, y at level 4) : R_scope
- V8only.
-Notation "x < y <= z" := (Rlt x y)/\(Rle y z)
- (at level 5, y at level 4) : R_scope
- V8only.
-Notation "/ x" := (Rinv x) (at level 0): R_scope
- V8only.
-
-Open Local Scope R_scope.
-End R_scope.
-].
+Axiom NRplus : R -> R.
+Axiom NRmult : R -> R.
diff --git a/theories/Reals/Rtopology.v b/theories/Reals/Rtopology.v
index c59db60ce..17b884d45 100644
--- a/theories/Reals/Rtopology.v
+++ b/theories/Reals/Rtopology.v
@@ -8,879 +8,1263 @@
(*i $Id$ i*)
-Require Rbase.
-Require Rfunctions.
-Require Ranalysis1.
-Require RList.
-Require Classical_Prop.
-Require Classical_Pred_Type.
-V7only [Import R_scope.]. Open Local Scope R_scope.
-
-Definition included [D1,D2:R->Prop] : Prop := (x:R)(D1 x)->(D2 x).
-Definition disc [x:R;delta:posreal] : R->Prop := [y:R]``(Rabsolu (y-x))<delta``.
-Definition neighbourhood [V:R->Prop;x:R] : Prop := (EXT delta:posreal | (included (disc x delta) V)).
-Definition open_set [D:R->Prop] : Prop := (x:R) (D x)->(neighbourhood D x).
-Definition complementary [D:R->Prop] : R->Prop := [c:R]~(D c).
-Definition closed_set [D:R->Prop] : Prop := (open_set (complementary D)).
-Definition intersection_domain [D1,D2:R->Prop] : R->Prop := [c:R](D1 c)/\(D2 c).
-Definition union_domain [D1,D2:R->Prop] : R->Prop := [c:R](D1 c)\/(D2 c).
-Definition interior [D:R->Prop] : R->Prop := [x:R](neighbourhood D x).
-
-Lemma interior_P1 : (D:R->Prop) (included (interior D) D).
-Intros; Unfold included; Unfold interior; Intros; Unfold neighbourhood in H; Elim H; Intros; Unfold included in H0; Apply H0; Unfold disc; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply (cond_pos x0).
+Require Import Rbase.
+Require Import Rfunctions.
+Require Import Ranalysis1.
+Require Import RList.
+Require Import Classical_Prop.
+Require Import Classical_Pred_Type. Open Local Scope R_scope.
+
+Definition included (D1 D2:R -> Prop) : Prop := forall x:R, D1 x -> D2 x.
+Definition disc (x:R) (delta:posreal) (y:R) : Prop := Rabs (y - x) < delta.
+Definition neighbourhood (V:R -> Prop) (x:R) : Prop :=
+ exists delta : posreal | included (disc x delta) V.
+Definition open_set (D:R -> Prop) : Prop :=
+ forall x:R, D x -> neighbourhood D x.
+Definition complementary (D:R -> Prop) (c:R) : Prop := ~ D c.
+Definition closed_set (D:R -> Prop) : Prop := open_set (complementary D).
+Definition intersection_domain (D1 D2:R -> Prop) (c:R) : Prop := D1 c /\ D2 c.
+Definition union_domain (D1 D2:R -> Prop) (c:R) : Prop := D1 c \/ D2 c.
+Definition interior (D:R -> Prop) (x:R) : Prop := neighbourhood D x.
+
+Lemma interior_P1 : forall D:R -> Prop, included (interior D) D.
+intros; unfold included in |- *; unfold interior in |- *; intros;
+ unfold neighbourhood in H; elim H; intros; unfold included in H0;
+ apply H0; unfold disc in |- *; unfold Rminus in |- *;
+ rewrite Rplus_opp_r; rewrite Rabs_R0; apply (cond_pos x0).
Qed.
-Lemma interior_P2 : (D:R->Prop) (open_set D) -> (included D (interior D)).
-Intros; Unfold open_set in H; Unfold included; Intros; Assert H1 := (H ? H0); Unfold interior; Apply H1.
+Lemma interior_P2 : forall D:R -> Prop, open_set D -> included D (interior D).
+intros; unfold open_set in H; unfold included in |- *; intros;
+ assert (H1 := H _ H0); unfold interior in |- *; apply H1.
Qed.
-Definition point_adherent [D:R->Prop;x:R] : Prop := (V:R->Prop) (neighbourhood V x) -> (EXT y:R | (intersection_domain V D y)).
-Definition adherence [D:R->Prop] : R->Prop := [x:R](point_adherent D x).
-
-Lemma adherence_P1 : (D:R->Prop) (included D (adherence D)).
-Intro; Unfold included; Intros; Unfold adherence; Unfold point_adherent; Intros; Exists x; Unfold intersection_domain; Split.
-Unfold neighbourhood in H0; Elim H0; Intros; Unfold included in H1; Apply H1; Unfold disc; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply (cond_pos x0).
-Apply H.
+Definition point_adherent (D:R -> Prop) (x:R) : Prop :=
+ forall V:R -> Prop,
+ neighbourhood V x -> exists y : R | intersection_domain V D y.
+Definition adherence (D:R -> Prop) (x:R) : Prop := point_adherent D x.
+
+Lemma adherence_P1 : forall D:R -> Prop, included D (adherence D).
+intro; unfold included in |- *; intros; unfold adherence in |- *;
+ unfold point_adherent in |- *; intros; exists x;
+ unfold intersection_domain in |- *; split.
+unfold neighbourhood in H0; elim H0; intros; unfold included in H1; apply H1;
+ unfold disc in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r;
+ rewrite Rabs_R0; apply (cond_pos x0).
+apply H.
Qed.
-Lemma included_trans : (D1,D2,D3:R->Prop) (included D1 D2) -> (included D2 D3) -> (included D1 D3).
-Unfold included; Intros; Apply H0; Apply H; Apply H1.
+Lemma included_trans :
+ forall D1 D2 D3:R -> Prop,
+ included D1 D2 -> included D2 D3 -> included D1 D3.
+unfold included in |- *; intros; apply H0; apply H; apply H1.
Qed.
-Lemma interior_P3 : (D:R->Prop) (open_set (interior D)).
-Intro; Unfold open_set interior; Unfold neighbourhood; Intros; Elim H; Intros.
-Exists x0; Unfold included; Intros.
-Pose del := ``x0-(Rabsolu (x-x1))``.
-Cut ``0<del``.
-Intro; Exists (mkposreal del H2); Intros.
-Cut (included (disc x1 (mkposreal del H2)) (disc x x0)).
-Intro; Assert H5 := (included_trans ? ? ? H4 H0).
-Apply H5; Apply H3.
-Unfold included; Unfold disc; Intros.
-Apply Rle_lt_trans with ``(Rabsolu (x3-x1))+(Rabsolu (x1-x))``.
-Replace ``x3-x`` with ``(x3-x1)+(x1-x)``; [Apply Rabsolu_triang | Ring].
-Replace (pos x0) with ``del+(Rabsolu (x1-x))``.
-Do 2 Rewrite <- (Rplus_sym (Rabsolu ``x1-x``)); Apply Rlt_compatibility; Apply H4.
-Unfold del; Rewrite <- (Rabsolu_Ropp ``x-x1``); Rewrite Ropp_distr2; Ring.
-Unfold del; Apply Rlt_anti_compatibility with ``(Rabsolu (x-x1))``; Rewrite Rplus_Or; Replace ``(Rabsolu (x-x1))+(x0-(Rabsolu (x-x1)))`` with (pos x0); [Idtac | Ring].
-Unfold disc in H1; Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H1.
+Lemma interior_P3 : forall D:R -> Prop, open_set (interior D).
+intro; unfold open_set, interior in |- *; unfold neighbourhood in |- *;
+ intros; elim H; intros.
+exists x0; unfold included in |- *; intros.
+pose (del := x0 - Rabs (x - x1)).
+cut (0 < del).
+intro; exists (mkposreal del H2); intros.
+cut (included (disc x1 (mkposreal del H2)) (disc x x0)).
+intro; assert (H5 := included_trans _ _ _ H4 H0).
+apply H5; apply H3.
+unfold included in |- *; unfold disc in |- *; intros.
+apply Rle_lt_trans with (Rabs (x3 - x1) + Rabs (x1 - x)).
+replace (x3 - x) with (x3 - x1 + (x1 - x)); [ apply Rabs_triang | ring ].
+replace (pos x0) with (del + Rabs (x1 - x)).
+do 2 rewrite <- (Rplus_comm (Rabs (x1 - x))); apply Rplus_lt_compat_l;
+ apply H4.
+unfold del in |- *; rewrite <- (Rabs_Ropp (x - x1)); rewrite Ropp_minus_distr;
+ ring.
+unfold del in |- *; apply Rplus_lt_reg_r with (Rabs (x - x1));
+ rewrite Rplus_0_r;
+ replace (Rabs (x - x1) + (x0 - Rabs (x - x1))) with (pos x0);
+ [ idtac | ring ].
+unfold disc in H1; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H1.
Qed.
-Lemma complementary_P1 : (D:R->Prop) ~(EXT y:R | (intersection_domain D (complementary D) y)).
-Intro; Red; Intro; Elim H; Intros; Unfold intersection_domain complementary in H0; Elim H0; Intros; Elim H2; Assumption.
+Lemma complementary_P1 :
+ forall D:R -> Prop,
+ ~ ( exists y : R | intersection_domain D (complementary D) y).
+intro; red in |- *; intro; elim H; intros;
+ unfold intersection_domain, complementary in H0; elim H0;
+ intros; elim H2; assumption.
Qed.
-Lemma adherence_P2 : (D:R->Prop) (closed_set D) -> (included (adherence D) D).
-Unfold closed_set; Unfold open_set complementary; Intros; Unfold included adherence; Intros; Assert H1 := (classic (D x)); Elim H1; Intro.
-Assumption.
-Assert H3 := (H ? H2); Assert H4 := (H0 ? H3); Elim H4; Intros; Unfold intersection_domain in H5; Elim H5; Intros; Elim H6; Assumption.
+Lemma adherence_P2 :
+ forall D:R -> Prop, closed_set D -> included (adherence D) D.
+unfold closed_set in |- *; unfold open_set, complementary in |- *; intros;
+ unfold included, adherence in |- *; intros; assert (H1 := classic (D x));
+ elim H1; intro.
+assumption.
+assert (H3 := H _ H2); assert (H4 := H0 _ H3); elim H4; intros;
+ unfold intersection_domain in H5; elim H5; intros;
+ elim H6; assumption.
Qed.
-Lemma adherence_P3 : (D:R->Prop) (closed_set (adherence D)).
-Intro; Unfold closed_set adherence; Unfold open_set complementary point_adherent; Intros; Pose P := [V:R->Prop](neighbourhood V x)->(EXT y:R | (intersection_domain V D y)); Assert H0 := (not_all_ex_not ? P H); Elim H0; Intros V0 H1; Unfold P in H1; Assert H2 := (imply_to_and ? ? H1); Unfold neighbourhood; Elim H2; Intros; Unfold neighbourhood in H3; Elim H3; Intros; Exists x0; Unfold included; Intros; Red; Intro.
-Assert H8 := (H7 V0); Cut (EXT delta:posreal | (x:R)(disc x1 delta x)->(V0 x)).
-Intro; Assert H10 := (H8 H9); Elim H4; Assumption.
-Cut ``0<x0-(Rabsolu (x-x1))``.
-Intro; Pose del := (mkposreal ? H9); Exists del; Intros; Unfold included in H5; Apply H5; Unfold disc; Apply Rle_lt_trans with ``(Rabsolu (x2-x1))+(Rabsolu (x1-x))``.
-Replace ``x2-x`` with ``(x2-x1)+(x1-x)``; [Apply Rabsolu_triang | Ring].
-Replace (pos x0) with ``del+(Rabsolu (x1-x))``.
-Do 2 Rewrite <- (Rplus_sym ``(Rabsolu (x1-x))``); Apply Rlt_compatibility; Apply H10.
-Unfold del; Simpl; Rewrite <- (Rabsolu_Ropp ``x-x1``); Rewrite Ropp_distr2; Ring.
-Apply Rlt_anti_compatibility with ``(Rabsolu (x-x1))``; Rewrite Rplus_Or; Replace ``(Rabsolu (x-x1))+(x0-(Rabsolu (x-x1)))`` with (pos x0); [Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H6 | Ring].
+Lemma adherence_P3 : forall D:R -> Prop, closed_set (adherence D).
+intro; unfold closed_set, adherence in |- *;
+ unfold open_set, complementary, point_adherent in |- *;
+ intros;
+ pose
+ (P :=
+ fun V:R -> Prop =>
+ neighbourhood V x -> exists y : R | intersection_domain V D y);
+ assert (H0 := not_all_ex_not _ P H); elim H0; intros V0 H1;
+ unfold P in H1; assert (H2 := imply_to_and _ _ H1);
+ unfold neighbourhood in |- *; elim H2; intros; unfold neighbourhood in H3;
+ elim H3; intros; exists x0; unfold included in |- *;
+ intros; red in |- *; intro.
+assert (H8 := H7 V0);
+ cut ( exists delta : posreal | (forall x:R, disc x1 delta x -> V0 x)).
+intro; assert (H10 := H8 H9); elim H4; assumption.
+cut (0 < x0 - Rabs (x - x1)).
+intro; pose (del := mkposreal _ H9); exists del; intros;
+ unfold included in H5; apply H5; unfold disc in |- *;
+ apply Rle_lt_trans with (Rabs (x2 - x1) + Rabs (x1 - x)).
+replace (x2 - x) with (x2 - x1 + (x1 - x)); [ apply Rabs_triang | ring ].
+replace (pos x0) with (del + Rabs (x1 - x)).
+do 2 rewrite <- (Rplus_comm (Rabs (x1 - x))); apply Rplus_lt_compat_l;
+ apply H10.
+unfold del in |- *; simpl in |- *; rewrite <- (Rabs_Ropp (x - x1));
+ rewrite Ropp_minus_distr; ring.
+apply Rplus_lt_reg_r with (Rabs (x - x1)); rewrite Rplus_0_r;
+ replace (Rabs (x - x1) + (x0 - Rabs (x - x1))) with (pos x0);
+ [ rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H6 | ring ].
Qed.
-Definition eq_Dom [D1,D2:R->Prop] : Prop := (included D1 D2)/\(included D2 D1).
+Definition eq_Dom (D1 D2:R -> Prop) : Prop :=
+ included D1 D2 /\ included D2 D1.
-Infix "=_D" eq_Dom (at level 5, no associativity).
+Infix "=_D" := eq_Dom (at level 70, no associativity).
-Lemma open_set_P1 : (D:R->Prop) (open_set D) <-> D =_D (interior D).
-Intro; Split.
-Intro; Unfold eq_Dom; Split.
-Apply interior_P2; Assumption.
-Apply interior_P1.
-Intro; Unfold eq_Dom in H; Elim H; Clear H; Intros; Unfold open_set; Intros; Unfold included interior in H; Unfold included in H0; Apply (H ? H1).
+Lemma open_set_P1 : forall D:R -> Prop, open_set D <-> D =_D interior D.
+intro; split.
+intro; unfold eq_Dom in |- *; split.
+apply interior_P2; assumption.
+apply interior_P1.
+intro; unfold eq_Dom in H; elim H; clear H; intros; unfold open_set in |- *;
+ intros; unfold included, interior in H; unfold included in H0;
+ apply (H _ H1).
Qed.
-Lemma closed_set_P1 : (D:R->Prop) (closed_set D) <-> D =_D (adherence D).
-Intro; Split.
-Intro; Unfold eq_Dom; Split.
-Apply adherence_P1.
-Apply adherence_P2; Assumption.
-Unfold eq_Dom; Unfold included; Intros; Assert H0 := (adherence_P3 D); Unfold closed_set in H0; Unfold closed_set; Unfold open_set; Unfold open_set in H0; Intros; Assert H2 : (complementary (adherence D) x).
-Unfold complementary; Unfold complementary in H1; Red; Intro; Elim H; Clear H; Intros _ H; Elim H1; Apply (H ? H2).
-Assert H3 := (H0 ? H2); Unfold neighbourhood; Unfold neighbourhood in H3; Elim H3; Intros; Exists x0; Unfold included; Unfold included in H4; Intros; Assert H6 := (H4 ? H5); Unfold complementary in H6; Unfold complementary; Red; Intro; Elim H; Clear H; Intros H _; Elim H6; Apply (H ? H7).
+Lemma closed_set_P1 : forall D:R -> Prop, closed_set D <-> D =_D adherence D.
+intro; split.
+intro; unfold eq_Dom in |- *; split.
+apply adherence_P1.
+apply adherence_P2; assumption.
+unfold eq_Dom in |- *; unfold included in |- *; intros;
+ assert (H0 := adherence_P3 D); unfold closed_set in H0;
+ unfold closed_set in |- *; unfold open_set in |- *;
+ unfold open_set in H0; intros; assert (H2 : complementary (adherence D) x).
+unfold complementary in |- *; unfold complementary in H1; red in |- *; intro;
+ elim H; clear H; intros _ H; elim H1; apply (H _ H2).
+assert (H3 := H0 _ H2); unfold neighbourhood in |- *;
+ unfold neighbourhood in H3; elim H3; intros; exists x0;
+ unfold included in |- *; unfold included in H4; intros;
+ assert (H6 := H4 _ H5); unfold complementary in H6;
+ unfold complementary in |- *; red in |- *; intro;
+ elim H; clear H; intros H _; elim H6; apply (H _ H7).
Qed.
-Lemma neighbourhood_P1 : (D1,D2:R->Prop;x:R) (included D1 D2) -> (neighbourhood D1 x) -> (neighbourhood D2 x).
-Unfold included neighbourhood; Intros; Elim H0; Intros; Exists x0; Intros; Unfold included; Unfold included in H1; Intros; Apply (H ? (H1 ? H2)).
+Lemma neighbourhood_P1 :
+ forall (D1 D2:R -> Prop) (x:R),
+ included D1 D2 -> neighbourhood D1 x -> neighbourhood D2 x.
+unfold included, neighbourhood in |- *; intros; elim H0; intros; exists x0;
+ intros; unfold included in |- *; unfold included in H1;
+ intros; apply (H _ (H1 _ H2)).
Qed.
-Lemma open_set_P2 : (D1,D2:R->Prop) (open_set D1) -> (open_set D2) -> (open_set (union_domain D1 D2)).
-Unfold open_set; Intros; Unfold union_domain in H1; Elim H1; Intro.
-Apply neighbourhood_P1 with D1.
-Unfold included union_domain; Tauto.
-Apply H; Assumption.
-Apply neighbourhood_P1 with D2.
-Unfold included union_domain; Tauto.
-Apply H0; Assumption.
+Lemma open_set_P2 :
+ forall D1 D2:R -> Prop,
+ open_set D1 -> open_set D2 -> open_set (union_domain D1 D2).
+unfold open_set in |- *; intros; unfold union_domain in H1; elim H1; intro.
+apply neighbourhood_P1 with D1.
+unfold included, union_domain in |- *; tauto.
+apply H; assumption.
+apply neighbourhood_P1 with D2.
+unfold included, union_domain in |- *; tauto.
+apply H0; assumption.
Qed.
-Lemma open_set_P3 : (D1,D2:R->Prop) (open_set D1) -> (open_set D2) -> (open_set (intersection_domain D1 D2)).
-Unfold open_set; Intros; Unfold intersection_domain in H1; Elim H1; Intros.
-Assert H4 := (H ? H2); Assert H5 := (H0 ? H3); Unfold intersection_domain; Unfold neighbourhood in H4 H5; Elim H4; Clear H; Intros del1 H; Elim H5; Clear H0; Intros del2 H0; Cut ``0<(Rmin del1 del2)``.
-Intro; Pose del := (mkposreal ? H6).
-Exists del; Unfold included; Intros; Unfold included in H H0; Unfold disc in H H0 H7.
-Split.
-Apply H; Apply Rlt_le_trans with (pos del).
-Apply H7.
-Unfold del; Simpl; Apply Rmin_l.
-Apply H0; Apply Rlt_le_trans with (pos del).
-Apply H7.
-Unfold del; Simpl; Apply Rmin_r.
-Unfold Rmin; Case (total_order_Rle del1 del2); Intro.
-Apply (cond_pos del1).
-Apply (cond_pos del2).
+Lemma open_set_P3 :
+ forall D1 D2:R -> Prop,
+ open_set D1 -> open_set D2 -> open_set (intersection_domain D1 D2).
+unfold open_set in |- *; intros; unfold intersection_domain in H1; elim H1;
+ intros.
+assert (H4 := H _ H2); assert (H5 := H0 _ H3);
+ unfold intersection_domain in |- *; unfold neighbourhood in H4, H5;
+ elim H4; clear H; intros del1 H; elim H5; clear H0;
+ intros del2 H0; cut (0 < Rmin del1 del2).
+intro; pose (del := mkposreal _ H6).
+exists del; unfold included in |- *; intros; unfold included in H, H0;
+ unfold disc in H, H0, H7.
+split.
+apply H; apply Rlt_le_trans with (pos del).
+apply H7.
+unfold del in |- *; simpl in |- *; apply Rmin_l.
+apply H0; apply Rlt_le_trans with (pos del).
+apply H7.
+unfold del in |- *; simpl in |- *; apply Rmin_r.
+unfold Rmin in |- *; case (Rle_dec del1 del2); intro.
+apply (cond_pos del1).
+apply (cond_pos del2).
Qed.
-Lemma open_set_P4 : (open_set [x:R]False).
-Unfold open_set; Intros; Elim H.
+Lemma open_set_P4 : open_set (fun x:R => False).
+unfold open_set in |- *; intros; elim H.
Qed.
-Lemma open_set_P5 : (open_set [x:R]True).
-Unfold open_set; Intros; Unfold neighbourhood.
-Exists (mkposreal R1 Rlt_R0_R1); Unfold included; Intros; Trivial.
+Lemma open_set_P5 : open_set (fun x:R => True).
+unfold open_set in |- *; intros; unfold neighbourhood in |- *.
+exists (mkposreal 1 Rlt_0_1); unfold included in |- *; intros; trivial.
Qed.
-Lemma disc_P1 : (x:R;del:posreal) (open_set (disc x del)).
-Intros; Assert H := (open_set_P1 (disc x del)).
-Elim H; Intros; Apply H1.
-Unfold eq_Dom; Split.
-Unfold included interior disc; Intros; Cut ``0<del-(Rabsolu (x-x0))``.
-Intro; Pose del2 := (mkposreal ? H3).
-Exists del2; Unfold included; Intros.
-Apply Rle_lt_trans with ``(Rabsolu (x1-x0))+(Rabsolu (x0 -x))``.
-Replace ``x1-x`` with ``(x1-x0)+(x0-x)``; [Apply Rabsolu_triang | Ring].
-Replace (pos del) with ``del2 + (Rabsolu (x0-x))``.
-Do 2 Rewrite <- (Rplus_sym ``(Rabsolu (x0-x))``); Apply Rlt_compatibility.
-Apply H4.
-Unfold del2; Simpl; Rewrite <- (Rabsolu_Ropp ``x-x0``); Rewrite Ropp_distr2; Ring.
-Apply Rlt_anti_compatibility with ``(Rabsolu (x-x0))``; Rewrite Rplus_Or; Replace ``(Rabsolu (x-x0))+(del-(Rabsolu (x-x0)))`` with (pos del); [Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H2 | Ring].
-Apply interior_P1.
+Lemma disc_P1 : forall (x:R) (del:posreal), open_set (disc x del).
+intros; assert (H := open_set_P1 (disc x del)).
+elim H; intros; apply H1.
+unfold eq_Dom in |- *; split.
+unfold included, interior, disc in |- *; intros;
+ cut (0 < del - Rabs (x - x0)).
+intro; pose (del2 := mkposreal _ H3).
+exists del2; unfold included in |- *; intros.
+apply Rle_lt_trans with (Rabs (x1 - x0) + Rabs (x0 - x)).
+replace (x1 - x) with (x1 - x0 + (x0 - x)); [ apply Rabs_triang | ring ].
+replace (pos del) with (del2 + Rabs (x0 - x)).
+do 2 rewrite <- (Rplus_comm (Rabs (x0 - x))); apply Rplus_lt_compat_l.
+apply H4.
+unfold del2 in |- *; simpl in |- *; rewrite <- (Rabs_Ropp (x - x0));
+ rewrite Ropp_minus_distr; ring.
+apply Rplus_lt_reg_r with (Rabs (x - x0)); rewrite Rplus_0_r;
+ replace (Rabs (x - x0) + (del - Rabs (x - x0))) with (pos del);
+ [ rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H2 | ring ].
+apply interior_P1.
Qed.
-Lemma continuity_P1 : (f:R->R;x:R) (continuity_pt f x) <-> (W:R->Prop)(neighbourhood W (f x)) -> (EXT V:R->Prop | (neighbourhood V x) /\ ((y:R)(V y)->(W (f y)))).
-Intros; Split.
-Intros; Unfold neighbourhood in H0.
-Elim H0; Intros del1 H1.
-Unfold continuity_pt in H; Unfold continue_in in H; Unfold limit1_in in H; Unfold limit_in in H; Simpl in H; Unfold R_dist in H.
-Assert H2 := (H del1 (cond_pos del1)).
-Elim H2; Intros del2 H3.
-Elim H3; Intros.
-Exists (disc x (mkposreal del2 H4)).
-Intros; Unfold included in H1; Split.
-Unfold neighbourhood disc.
-Exists (mkposreal del2 H4).
-Unfold included; Intros; Assumption.
-Intros; Apply H1; Unfold disc; Case (Req_EM y x); Intro.
-Rewrite H7; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply (cond_pos del1).
-Apply H5; Split.
-Unfold D_x no_cond; Split.
-Trivial.
-Apply not_sym; Apply H7.
-Unfold disc in H6; Apply H6.
-Intros; Unfold continuity_pt; Unfold continue_in; Unfold limit1_in; Unfold limit_in; Intros.
-Assert H1 := (H (disc (f x) (mkposreal eps H0))).
-Cut (neighbourhood (disc (f x) (mkposreal eps H0)) (f x)).
-Intro; Assert H3 := (H1 H2).
-Elim H3; Intros D H4; Elim H4; Intros; Unfold neighbourhood in H5; Elim H5; Intros del1 H7.
-Exists (pos del1); Split.
-Apply (cond_pos del1).
-Intros; Elim H8; Intros; Simpl in H10; Unfold R_dist in H10; Simpl; Unfold R_dist; Apply (H6 ? (H7 ? H10)).
-Unfold neighbourhood disc; Exists (mkposreal eps H0); Unfold included; Intros; Assumption.
+Lemma continuity_P1 :
+ forall (f:R -> R) (x:R),
+ continuity_pt f x <->
+ (forall W:R -> Prop,
+ neighbourhood W (f x) ->
+ exists V : R -> Prop
+ | neighbourhood V x /\ (forall y:R, V y -> W (f y))).
+intros; split.
+intros; unfold neighbourhood in H0.
+elim H0; intros del1 H1.
+unfold continuity_pt in H; unfold continue_in in H; unfold limit1_in in H;
+ unfold limit_in in H; simpl in H; unfold R_dist in H.
+assert (H2 := H del1 (cond_pos del1)).
+elim H2; intros del2 H3.
+elim H3; intros.
+exists (disc x (mkposreal del2 H4)).
+intros; unfold included in H1; split.
+unfold neighbourhood, disc in |- *.
+exists (mkposreal del2 H4).
+unfold included in |- *; intros; assumption.
+intros; apply H1; unfold disc in |- *; case (Req_dec y x); intro.
+rewrite H7; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+ apply (cond_pos del1).
+apply H5; split.
+unfold D_x, no_cond in |- *; split.
+trivial.
+apply (sym_not_eq (A:=R)); apply H7.
+unfold disc in H6; apply H6.
+intros; unfold continuity_pt in |- *; unfold continue_in in |- *;
+ unfold limit1_in in |- *; unfold limit_in in |- *;
+ intros.
+assert (H1 := H (disc (f x) (mkposreal eps H0))).
+cut (neighbourhood (disc (f x) (mkposreal eps H0)) (f x)).
+intro; assert (H3 := H1 H2).
+elim H3; intros D H4; elim H4; intros; unfold neighbourhood in H5; elim H5;
+ intros del1 H7.
+exists (pos del1); split.
+apply (cond_pos del1).
+intros; elim H8; intros; simpl in H10; unfold R_dist in H10; simpl in |- *;
+ unfold R_dist in |- *; apply (H6 _ (H7 _ H10)).
+unfold neighbourhood, disc in |- *; exists (mkposreal eps H0);
+ unfold included in |- *; intros; assumption.
Qed.
-Definition image_rec [f:R->R;D:R->Prop] : R->Prop := [x:R](D (f x)).
+Definition image_rec (f:R -> R) (D:R -> Prop) (x:R) : Prop := D (f x).
(**********)
-Lemma continuity_P2 : (f:R->R;D:R->Prop) (continuity f) -> (open_set D) -> (open_set (image_rec f D)).
-Intros; Unfold open_set in H0; Unfold open_set; Intros; Assert H2 := (continuity_P1 f x); Elim H2; Intros H3 _; Assert H4 := (H3 (H x)); Unfold neighbourhood image_rec; Unfold image_rec in H1; Assert H5 := (H4 D (H0 (f x) H1)); Elim H5; Intros V0 H6; Elim H6; Intros; Unfold neighbourhood in H7; Elim H7; Intros del H9; Exists del; Unfold included in H9; Unfold included; Intros; Apply (H8 ? (H9 ? H10)).
+Lemma continuity_P2 :
+ forall (f:R -> R) (D:R -> Prop),
+ continuity f -> open_set D -> open_set (image_rec f D).
+intros; unfold open_set in H0; unfold open_set in |- *; intros;
+ assert (H2 := continuity_P1 f x); elim H2; intros H3 _;
+ assert (H4 := H3 (H x)); unfold neighbourhood, image_rec in |- *;
+ unfold image_rec in H1; assert (H5 := H4 D (H0 (f x) H1));
+ elim H5; intros V0 H6; elim H6; intros; unfold neighbourhood in H7;
+ elim H7; intros del H9; exists del; unfold included in H9;
+ unfold included in |- *; intros; apply (H8 _ (H9 _ H10)).
Qed.
(**********)
-Lemma continuity_P3 : (f:R->R) (continuity f) <-> (D:R->Prop) (open_set D)->(open_set (image_rec f D)).
-Intros; Split.
-Intros; Apply continuity_P2; Assumption.
-Intros; Unfold continuity; Unfold continuity_pt; Unfold continue_in; Unfold limit1_in; Unfold limit_in; Simpl; Unfold R_dist; Intros; Cut (open_set (disc (f x) (mkposreal ? H0))).
-Intro; Assert H2 := (H ? H1).
-Unfold open_set image_rec in H2; Cut (disc (f x) (mkposreal ? H0) (f x)).
-Intro; Assert H4 := (H2 ? H3).
-Unfold neighbourhood in H4; Elim H4; Intros del H5.
-Exists (pos del); Split.
-Apply (cond_pos del).
-Intros; Unfold included in H5; Apply H5; Elim H6; Intros; Apply H8.
-Unfold disc; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply H0.
-Apply disc_P1.
+Lemma continuity_P3 :
+ forall f:R -> R,
+ continuity f <->
+ (forall D:R -> Prop, open_set D -> open_set (image_rec f D)).
+intros; split.
+intros; apply continuity_P2; assumption.
+intros; unfold continuity in |- *; unfold continuity_pt in |- *;
+ unfold continue_in in |- *; unfold limit1_in in |- *;
+ unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *;
+ intros; cut (open_set (disc (f x) (mkposreal _ H0))).
+intro; assert (H2 := H _ H1).
+unfold open_set, image_rec in H2; cut (disc (f x) (mkposreal _ H0) (f x)).
+intro; assert (H4 := H2 _ H3).
+unfold neighbourhood in H4; elim H4; intros del H5.
+exists (pos del); split.
+apply (cond_pos del).
+intros; unfold included in H5; apply H5; elim H6; intros; apply H8.
+unfold disc in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r;
+ rewrite Rabs_R0; apply H0.
+apply disc_P1.
Qed.
(**********)
-Theorem Rsepare : (x,y:R) ``x<>y``->(EXT V:R->Prop | (EXT W:R->Prop | (neighbourhood V x)/\(neighbourhood W y)/\~(EXT y:R | (intersection_domain V W y)))).
-Intros x y Hsep; Pose D := ``(Rabsolu (x-y))``.
-Cut ``0<D/2``.
-Intro; Exists (disc x (mkposreal ? H)).
-Exists (disc y (mkposreal ? H)); Split.
-Unfold neighbourhood; Exists (mkposreal ? H); Unfold included; Tauto.
-Split.
-Unfold neighbourhood; Exists (mkposreal ? H); Unfold included; Tauto.
-Red; Intro; Elim H0; Intros; Unfold intersection_domain in H1; Elim H1; Intros.
-Cut ``D<D``.
-Intro; Elim (Rlt_antirefl ? H4).
-Change ``(Rabsolu (x-y))<D``; Apply Rle_lt_trans with ``(Rabsolu (x-x0))+(Rabsolu (x0-y))``.
-Replace ``x-y`` with ``(x-x0)+(x0-y)``; [Apply Rabsolu_triang | Ring].
-Rewrite (double_var D); Apply Rplus_lt.
-Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H2.
-Apply H3.
-Unfold Rdiv; Apply Rmult_lt_pos.
-Unfold D; Apply Rabsolu_pos_lt; Apply (Rminus_eq_contra ? ? Hsep).
-Apply Rlt_Rinv; Sup0.
+Theorem Rsepare :
+ forall x y:R,
+ x <> y ->
+ exists V : R -> Prop
+ | ( exists W : R -> Prop
+ | neighbourhood V x /\
+ neighbourhood W y /\ ~ ( exists y : R | intersection_domain V W y)).
+intros x y Hsep; pose (D := Rabs (x - y)).
+cut (0 < D / 2).
+intro; exists (disc x (mkposreal _ H)).
+exists (disc y (mkposreal _ H)); split.
+unfold neighbourhood in |- *; exists (mkposreal _ H); unfold included in |- *;
+ tauto.
+split.
+unfold neighbourhood in |- *; exists (mkposreal _ H); unfold included in |- *;
+ tauto.
+red in |- *; intro; elim H0; intros; unfold intersection_domain in H1;
+ elim H1; intros.
+cut (D < D).
+intro; elim (Rlt_irrefl _ H4).
+change (Rabs (x - y) < D) in |- *;
+ apply Rle_lt_trans with (Rabs (x - x0) + Rabs (x0 - y)).
+replace (x - y) with (x - x0 + (x0 - y)); [ apply Rabs_triang | ring ].
+rewrite (double_var D); apply Rplus_lt_compat.
+rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H2.
+apply H3.
+unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+unfold D in |- *; apply Rabs_pos_lt; apply (Rminus_eq_contra _ _ Hsep).
+apply Rinv_0_lt_compat; prove_sup0.
Qed.
-Record family : Type := mkfamily {
- ind : R->Prop;
- f :> R->R->Prop;
- cond_fam : (x:R)(EXT y:R|(f x y))->(ind x) }.
+Record family : Type := mkfamily
+ {ind : R -> Prop;
+ f :> R -> R -> Prop;
+ cond_fam : forall x:R, ( exists y : R | f x y) -> ind x}.
-Definition family_open_set [f:family] : Prop := (x:R) (open_set (f x)).
+Definition family_open_set (f:family) : Prop := forall x:R, open_set (f x).
-Definition domain_finite [D:R->Prop] : Prop := (EXT l:Rlist | (x:R)(D x)<->(In x l)).
+Definition domain_finite (D:R -> Prop) : Prop :=
+ exists l : Rlist | (forall x:R, D x <-> In x l).
-Definition family_finite [f:family] : Prop := (domain_finite (ind f)).
+Definition family_finite (f:family) : Prop := domain_finite (ind f).
-Definition covering [D:R->Prop;f:family] : Prop := (x:R) (D x)->(EXT y:R | (f y x)).
+Definition covering (D:R -> Prop) (f:family) : Prop :=
+ forall x:R, D x -> exists y : R | f y x.
-Definition covering_open_set [D:R->Prop;f:family] : Prop := (covering D f)/\(family_open_set f).
+Definition covering_open_set (D:R -> Prop) (f:family) : Prop :=
+ covering D f /\ family_open_set f.
-Definition covering_finite [D:R->Prop;f:family] : Prop := (covering D f)/\(family_finite f).
+Definition covering_finite (D:R -> Prop) (f:family) : Prop :=
+ covering D f /\ family_finite f.
-Lemma restriction_family : (f:family;D:R->Prop) (x:R)(EXT y:R|([z1:R][z2:R](f z1 z2)/\(D z1) x y))->(intersection_domain (ind f) D x).
-Intros; Elim H; Intros; Unfold intersection_domain; Elim H0; Intros; Split.
-Apply (cond_fam f0); Exists x0; Assumption.
-Assumption.
+Lemma restriction_family :
+ forall (f:family) (D:R -> Prop) (x:R),
+ ( exists y : R | (fun z1 z2:R => f z1 z2 /\ D z1) x y) ->
+ intersection_domain (ind f) D x.
+intros; elim H; intros; unfold intersection_domain in |- *; elim H0; intros;
+ split.
+apply (cond_fam f0); exists x0; assumption.
+assumption.
Qed.
-Definition subfamily [f:family;D:R->Prop] : family := (mkfamily (intersection_domain (ind f) D) [x:R][y:R](f x y)/\(D x) (restriction_family f D)).
+Definition subfamily (f:family) (D:R -> Prop) : family :=
+ mkfamily (intersection_domain (ind f) D) (fun x y:R => f x y /\ D x)
+ (restriction_family f D).
-Definition compact [X:R->Prop] : Prop := (f:family) (covering_open_set X f) -> (EXT D:R->Prop | (covering_finite X (subfamily f D))).
+Definition compact (X:R -> Prop) : Prop :=
+ forall f:family,
+ covering_open_set X f ->
+ exists D : R -> Prop | covering_finite X (subfamily f D).
(**********)
-Lemma family_P1 : (f:family;D:R->Prop) (family_open_set f) -> (family_open_set (subfamily f D)).
-Unfold family_open_set; Intros; Unfold subfamily; Simpl; Assert H0 := (classic (D x)).
-Elim H0; Intro.
-Cut (open_set (f0 x))->(open_set [y:R](f0 x y)/\(D x)).
-Intro; Apply H2; Apply H.
-Unfold open_set; Unfold neighbourhood; Intros; Elim H3; Intros; Assert H6 := (H2 ? H4); Elim H6; Intros; Exists x1; Unfold included; Intros; Split.
-Apply (H7 ? H8).
-Assumption.
-Cut (open_set [y:R]False) -> (open_set [y:R](f0 x y)/\(D x)).
-Intro; Apply H2; Apply open_set_P4.
-Unfold open_set; Unfold neighbourhood; Intros; Elim H3; Intros; Elim H1; Assumption.
+Lemma family_P1 :
+ forall (f:family) (D:R -> Prop),
+ family_open_set f -> family_open_set (subfamily f D).
+unfold family_open_set in |- *; intros; unfold subfamily in |- *;
+ simpl in |- *; assert (H0 := classic (D x)).
+elim H0; intro.
+cut (open_set (f0 x) -> open_set (fun y:R => f0 x y /\ D x)).
+intro; apply H2; apply H.
+unfold open_set in |- *; unfold neighbourhood in |- *; intros; elim H3;
+ intros; assert (H6 := H2 _ H4); elim H6; intros; exists x1;
+ unfold included in |- *; intros; split.
+apply (H7 _ H8).
+assumption.
+cut (open_set (fun y:R => False) -> open_set (fun y:R => f0 x y /\ D x)).
+intro; apply H2; apply open_set_P4.
+unfold open_set in |- *; unfold neighbourhood in |- *; intros; elim H3;
+ intros; elim H1; assumption.
Qed.
-Definition bounded [D:R->Prop] : Prop := (EXT m:R | (EXT M:R | (x:R)(D x)->``m<=x<=M``)).
+Definition bounded (D:R -> Prop) : Prop :=
+ exists m : R | ( exists M : R | (forall x:R, D x -> m <= x <= M)).
-Lemma open_set_P6 : (D1,D2:R->Prop) (open_set D1) -> D1 =_D D2 -> (open_set D2).
-Unfold open_set; Unfold neighbourhood; Intros.
-Unfold eq_Dom in H0; Elim H0; Intros.
-Assert H4 := (H ? (H3 ? H1)).
-Elim H4; Intros.
-Exists x0; Apply included_trans with D1; Assumption.
+Lemma open_set_P6 :
+ forall D1 D2:R -> Prop, open_set D1 -> D1 =_D D2 -> open_set D2.
+unfold open_set in |- *; unfold neighbourhood in |- *; intros.
+unfold eq_Dom in H0; elim H0; intros.
+assert (H4 := H _ (H3 _ H1)).
+elim H4; intros.
+exists x0; apply included_trans with D1; assumption.
Qed.
(**********)
-Lemma compact_P1 : (X:R->Prop) (compact X) -> (bounded X).
-Intros; Unfold compact in H; Pose D := [x:R]True; Pose g := [x:R][y:R]``(Rabsolu y)<x``; Cut (x:R)(EXT y|(g x y))->True; [Intro | Intro; Trivial].
-Pose f0 := (mkfamily D g H0); Assert H1 := (H f0); Cut (covering_open_set X f0).
-Intro; Assert H3 := (H1 H2); Elim H3; Intros D' H4; Unfold covering_finite in H4; Elim H4; Intros; Unfold family_finite in H6; Unfold domain_finite in H6; Elim H6; Intros l H7; Unfold bounded; Pose r := (MaxRlist l).
-Exists ``-r``; Exists r; Intros.
-Unfold covering in H5; Assert H9 := (H5 ? H8); Elim H9; Intros; Unfold subfamily in H10; Simpl in H10; Elim H10; Intros; Assert H13 := (H7 x0); Simpl in H13; Cut (intersection_domain D D' x0).
-Elim H13; Clear H13; Intros.
-Assert H16 := (H13 H15); Unfold g in H11; Split.
-Cut ``x0<=r``.
-Intro; Cut ``(Rabsolu x)<r``.
-Intro; Assert H19 := (Rabsolu_def2 x r H18); Elim H19; Intros; Left; Assumption.
-Apply Rlt_le_trans with x0; Assumption.
-Apply (MaxRlist_P1 l x0 H16).
-Cut ``x0<=r``.
-Intro; Apply Rle_trans with (Rabsolu x).
-Apply Rle_Rabsolu.
-Apply Rle_trans with x0.
-Left; Apply H11.
-Assumption.
-Apply (MaxRlist_P1 l x0 H16).
-Unfold intersection_domain D; Tauto.
-Unfold covering_open_set; Split.
-Unfold covering; Intros; Simpl; Exists ``(Rabsolu x)+1``; Unfold g; Pattern 1 (Rabsolu x); Rewrite <- Rplus_Or; Apply Rlt_compatibility; Apply Rlt_R0_R1.
-Unfold family_open_set; Intro; Case (total_order R0 x); Intro.
-Apply open_set_P6 with (disc R0 (mkposreal ? H2)).
-Apply disc_P1.
-Unfold eq_Dom; Unfold f0; Simpl; Unfold g disc; Split.
-Unfold included; Intros; Unfold Rminus in H3; Rewrite Ropp_O in H3; Rewrite Rplus_Or in H3; Apply H3.
-Unfold included; Intros; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply H3.
-Apply open_set_P6 with [x:R]False.
-Apply open_set_P4.
-Unfold eq_Dom; Split.
-Unfold included; Intros; Elim H3.
-Unfold included f0; Simpl; Unfold g; Intros; Elim H2; Intro; [Rewrite <- H4 in H3; Assert H5 := (Rabsolu_pos x0); Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H5 H3)) | Assert H6 := (Rabsolu_pos x0); Assert H7 := (Rlt_trans ? ? ? H3 H4); Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H6 H7))].
+Lemma compact_P1 : forall X:R -> Prop, compact X -> bounded X.
+intros; unfold compact in H; pose (D := fun x:R => True);
+ pose (g := fun x y:R => Rabs y < x);
+ cut (forall x:R, ( exists y : _ | g x y) -> True);
+ [ intro | intro; trivial ].
+pose (f0 := mkfamily D g H0); assert (H1 := H f0);
+ cut (covering_open_set X f0).
+intro; assert (H3 := H1 H2); elim H3; intros D' H4;
+ unfold covering_finite in H4; elim H4; intros; unfold family_finite in H6;
+ unfold domain_finite in H6; elim H6; intros l H7;
+ unfold bounded in |- *; pose (r := MaxRlist l).
+exists (- r); exists r; intros.
+unfold covering in H5; assert (H9 := H5 _ H8); elim H9; intros;
+ unfold subfamily in H10; simpl in H10; elim H10; intros;
+ assert (H13 := H7 x0); simpl in H13; cut (intersection_domain D D' x0).
+elim H13; clear H13; intros.
+assert (H16 := H13 H15); unfold g in H11; split.
+cut (x0 <= r).
+intro; cut (Rabs x < r).
+intro; assert (H19 := Rabs_def2 x r H18); elim H19; intros; left; assumption.
+apply Rlt_le_trans with x0; assumption.
+apply (MaxRlist_P1 l x0 H16).
+cut (x0 <= r).
+intro; apply Rle_trans with (Rabs x).
+apply RRle_abs.
+apply Rle_trans with x0.
+left; apply H11.
+assumption.
+apply (MaxRlist_P1 l x0 H16).
+unfold intersection_domain, D in |- *; tauto.
+unfold covering_open_set in |- *; split.
+unfold covering in |- *; intros; simpl in |- *; exists (Rabs x + 1);
+ unfold g in |- *; pattern (Rabs x) at 1 in |- *; rewrite <- Rplus_0_r;
+ apply Rplus_lt_compat_l; apply Rlt_0_1.
+unfold family_open_set in |- *; intro; case (Rtotal_order 0 x); intro.
+apply open_set_P6 with (disc 0 (mkposreal _ H2)).
+apply disc_P1.
+unfold eq_Dom in |- *; unfold f0 in |- *; simpl in |- *;
+ unfold g, disc in |- *; split.
+unfold included in |- *; intros; unfold Rminus in H3; rewrite Ropp_0 in H3;
+ rewrite Rplus_0_r in H3; apply H3.
+unfold included in |- *; intros; unfold Rminus in |- *; rewrite Ropp_0;
+ rewrite Rplus_0_r; apply H3.
+apply open_set_P6 with (fun x:R => False).
+apply open_set_P4.
+unfold eq_Dom in |- *; split.
+unfold included in |- *; intros; elim H3.
+unfold included, f0 in |- *; simpl in |- *; unfold g in |- *; intros; elim H2;
+ intro;
+ [ rewrite <- H4 in H3; assert (H5 := Rabs_pos x0);
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H5 H3))
+ | assert (H6 := Rabs_pos x0); assert (H7 := Rlt_trans _ _ _ H3 H4);
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H6 H7)) ].
Qed.
(**********)
-Lemma compact_P2 : (X:R->Prop) (compact X) -> (closed_set X).
-Intros; Assert H0 := (closed_set_P1 X); Elim H0; Clear H0; Intros _ H0; Apply H0; Clear H0.
-Unfold eq_Dom; Split.
-Apply adherence_P1.
-Unfold included; Unfold adherence; Unfold point_adherent; Intros; Unfold compact in H; Assert H1 := (classic (X x)); Elim H1; Clear H1; Intro.
-Assumption.
-Cut (y:R)(X y)->``0<(Rabsolu (y-x))/2``.
-Intro; Pose D := X; Pose g := [y:R][z:R]``(Rabsolu (y-z))<(Rabsolu (y-x))/2``/\(D y); Cut (x:R)(EXT y|(g x y))->(D x).
-Intro; Pose f0 := (mkfamily D g H3); Assert H4 := (H f0); Cut (covering_open_set X f0).
-Intro; Assert H6 := (H4 H5); Elim H6; Clear H6; Intros D' H6.
-Unfold covering_finite in H6; Decompose [and] H6; Unfold covering subfamily in H7; Simpl in H7; Unfold family_finite subfamily in H8; Simpl in H8; Unfold domain_finite in H8; Elim H8; Clear H8; Intros l H8; Pose alp := (MinRlist (AbsList l x)); Cut ``0<alp``.
-Intro; Assert H10 := (H0 (disc x (mkposreal ? H9))); Cut (neighbourhood (disc x (mkposreal alp H9)) x).
-Intro; Assert H12 := (H10 H11); Elim H12; Clear H12; Intros y H12; Unfold intersection_domain in H12; Elim H12; Clear H12; Intros; Assert H14 := (H7 ? H13); Elim H14; Clear H14; Intros y0 H14; Elim H14; Clear H14; Intros; Unfold g in H14; Elim H14; Clear H14; Intros; Unfold disc in H12; Simpl in H12; Cut ``alp<=(Rabsolu (y0-x))/2``.
-Intro; Assert H18 := (Rlt_le_trans ? ? ? H12 H17); Cut ``(Rabsolu (y0-x))<(Rabsolu (y0-x))``.
-Intro; Elim (Rlt_antirefl ? H19).
-Apply Rle_lt_trans with ``(Rabsolu (y0-y))+(Rabsolu (y-x))``.
-Replace ``y0-x`` with ``(y0-y)+(y-x)``; [Apply Rabsolu_triang | Ring].
-Rewrite (double_var ``(Rabsolu (y0-x))``); Apply Rplus_lt; Assumption.
-Apply (MinRlist_P1 (AbsList l x) ``(Rabsolu (y0-x))/2``); Apply AbsList_P1; Elim (H8 y0); Clear H8; Intros; Apply H8; Unfold intersection_domain; Split; Assumption.
-Assert H11 := (disc_P1 x (mkposreal alp H9)); Unfold open_set in H11; Apply H11.
-Unfold disc; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply H9.
-Unfold alp; Apply MinRlist_P2; Intros; Assert H10 := (AbsList_P2 ? ? ? H9); Elim H10; Clear H10; Intros z H10; Elim H10; Clear H10; Intros; Rewrite H11; Apply H2; Elim (H8 z); Clear H8; Intros; Assert H13 := (H12 H10); Unfold intersection_domain D in H13; Elim H13; Clear H13; Intros; Assumption.
-Unfold covering_open_set; Split.
-Unfold covering; Intros; Exists x0; Simpl; Unfold g; Split.
-Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Unfold Rminus in H2; Apply (H2 ? H5).
-Apply H5.
-Unfold family_open_set; Intro; Simpl; Unfold g; Elim (classic (D x0)); Intro.
-Apply open_set_P6 with (disc x0 (mkposreal ? (H2 ? H5))).
-Apply disc_P1.
-Unfold eq_Dom; Split.
-Unfold included disc; Simpl; Intros; Split.
-Rewrite <- (Rabsolu_Ropp ``x0-x1``); Rewrite Ropp_distr2; Apply H6.
-Apply H5.
-Unfold included disc; Simpl; Intros; Elim H6; Intros; Rewrite <- (Rabsolu_Ropp ``x1-x0``); Rewrite Ropp_distr2; Apply H7.
-Apply open_set_P6 with [z:R]False.
-Apply open_set_P4.
-Unfold eq_Dom; Split.
-Unfold included; Intros; Elim H6.
-Unfold included; Intros; Elim H6; Intros; Elim H5; Assumption.
-Intros; Elim H3; Intros; Unfold g in H4; Elim H4; Clear H4; Intros _ H4; Apply H4.
-Intros; Unfold Rdiv; Apply Rmult_lt_pos.
-Apply Rabsolu_pos_lt; Apply Rminus_eq_contra; Red; Intro; Rewrite H3 in H2; Elim H1; Apply H2.
-Apply Rlt_Rinv; Sup0.
+Lemma compact_P2 : forall X:R -> Prop, compact X -> closed_set X.
+intros; assert (H0 := closed_set_P1 X); elim H0; clear H0; intros _ H0;
+ apply H0; clear H0.
+unfold eq_Dom in |- *; split.
+apply adherence_P1.
+unfold included in |- *; unfold adherence in |- *;
+ unfold point_adherent in |- *; intros; unfold compact in H;
+ assert (H1 := classic (X x)); elim H1; clear H1; intro.
+assumption.
+cut (forall y:R, X y -> 0 < Rabs (y - x) / 2).
+intro; pose (D := X);
+ pose (g := fun y z:R => Rabs (y - z) < Rabs (y - x) / 2 /\ D y);
+ cut (forall x:R, ( exists y : _ | g x y) -> D x).
+intro; pose (f0 := mkfamily D g H3); assert (H4 := H f0);
+ cut (covering_open_set X f0).
+intro; assert (H6 := H4 H5); elim H6; clear H6; intros D' H6.
+unfold covering_finite in H6; decompose [and] H6;
+ unfold covering, subfamily in H7; simpl in H7;
+ unfold family_finite, subfamily in H8; simpl in H8;
+ unfold domain_finite in H8; elim H8; clear H8; intros l H8;
+ pose (alp := MinRlist (AbsList l x)); cut (0 < alp).
+intro; assert (H10 := H0 (disc x (mkposreal _ H9)));
+ cut (neighbourhood (disc x (mkposreal alp H9)) x).
+intro; assert (H12 := H10 H11); elim H12; clear H12; intros y H12;
+ unfold intersection_domain in H12; elim H12; clear H12;
+ intros; assert (H14 := H7 _ H13); elim H14; clear H14;
+ intros y0 H14; elim H14; clear H14; intros; unfold g in H14;
+ elim H14; clear H14; intros; unfold disc in H12; simpl in H12;
+ cut (alp <= Rabs (y0 - x) / 2).
+intro; assert (H18 := Rlt_le_trans _ _ _ H12 H17);
+ cut (Rabs (y0 - x) < Rabs (y0 - x)).
+intro; elim (Rlt_irrefl _ H19).
+apply Rle_lt_trans with (Rabs (y0 - y) + Rabs (y - x)).
+replace (y0 - x) with (y0 - y + (y - x)); [ apply Rabs_triang | ring ].
+rewrite (double_var (Rabs (y0 - x))); apply Rplus_lt_compat; assumption.
+apply (MinRlist_P1 (AbsList l x) (Rabs (y0 - x) / 2)); apply AbsList_P1;
+ elim (H8 y0); clear H8; intros; apply H8; unfold intersection_domain in |- *;
+ split; assumption.
+assert (H11 := disc_P1 x (mkposreal alp H9)); unfold open_set in H11;
+ apply H11.
+unfold disc in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r;
+ rewrite Rabs_R0; apply H9.
+unfold alp in |- *; apply MinRlist_P2; intros;
+ assert (H10 := AbsList_P2 _ _ _ H9); elim H10; clear H10;
+ intros z H10; elim H10; clear H10; intros; rewrite H11;
+ apply H2; elim (H8 z); clear H8; intros; assert (H13 := H12 H10);
+ unfold intersection_domain, D in H13; elim H13; clear H13;
+ intros; assumption.
+unfold covering_open_set in |- *; split.
+unfold covering in |- *; intros; exists x0; simpl in |- *; unfold g in |- *;
+ split.
+unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+ unfold Rminus in H2; apply (H2 _ H5).
+apply H5.
+unfold family_open_set in |- *; intro; simpl in |- *; unfold g in |- *;
+ elim (classic (D x0)); intro.
+apply open_set_P6 with (disc x0 (mkposreal _ (H2 _ H5))).
+apply disc_P1.
+unfold eq_Dom in |- *; split.
+unfold included, disc in |- *; simpl in |- *; intros; split.
+rewrite <- (Rabs_Ropp (x0 - x1)); rewrite Ropp_minus_distr; apply H6.
+apply H5.
+unfold included, disc in |- *; simpl in |- *; intros; elim H6; intros;
+ rewrite <- (Rabs_Ropp (x1 - x0)); rewrite Ropp_minus_distr;
+ apply H7.
+apply open_set_P6 with (fun z:R => False).
+apply open_set_P4.
+unfold eq_Dom in |- *; split.
+unfold included in |- *; intros; elim H6.
+unfold included in |- *; intros; elim H6; intros; elim H5; assumption.
+intros; elim H3; intros; unfold g in H4; elim H4; clear H4; intros _ H4;
+ apply H4.
+intros; unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+apply Rabs_pos_lt; apply Rminus_eq_contra; red in |- *; intro;
+ rewrite H3 in H2; elim H1; apply H2.
+apply Rinv_0_lt_compat; prove_sup0.
Qed.
(**********)
-Lemma compact_EMP : (compact [_:R]False).
-Unfold compact; Intros; Exists [x:R]False; Unfold covering_finite; Split.
-Unfold covering; Intros; Elim H0.
-Unfold family_finite; Unfold domain_finite; Exists nil; Intro.
-Split.
-Simpl; Unfold intersection_domain; Intros; Elim H0.
-Elim H0; Clear H0; Intros _ H0; Elim H0.
-Simpl; Intro; Elim H0.
+Lemma compact_EMP : compact (fun _:R => False).
+unfold compact in |- *; intros; exists (fun x:R => False);
+ unfold covering_finite in |- *; split.
+unfold covering in |- *; intros; elim H0.
+unfold family_finite in |- *; unfold domain_finite in |- *; exists nil; intro.
+split.
+simpl in |- *; unfold intersection_domain in |- *; intros; elim H0.
+elim H0; clear H0; intros _ H0; elim H0.
+simpl in |- *; intro; elim H0.
Qed.
-Lemma compact_eqDom : (X1,X2:R->Prop) (compact X1) -> X1 =_D X2 -> (compact X2).
-Unfold compact; Intros; Unfold eq_Dom in H0; Elim H0; Clear H0; Unfold included; Intros; Assert H3 : (covering_open_set X1 f0).
-Unfold covering_open_set; Unfold covering_open_set in H1; Elim H1; Clear H1; Intros; Split.
-Unfold covering in H1; Unfold covering; Intros; Apply (H1 ? (H0 ? H4)).
-Apply H3.
-Elim (H ? H3); Intros D H4; Exists D; Unfold covering_finite; Unfold covering_finite in H4; Elim H4; Intros; Split.
-Unfold covering in H5; Unfold covering; Intros; Apply (H5 ? (H2 ? H7)).
-Apply H6.
+Lemma compact_eqDom :
+ forall X1 X2:R -> Prop, compact X1 -> X1 =_D X2 -> compact X2.
+unfold compact in |- *; intros; unfold eq_Dom in H0; elim H0; clear H0;
+ unfold included in |- *; intros; assert (H3 : covering_open_set X1 f0).
+unfold covering_open_set in |- *; unfold covering_open_set in H1; elim H1;
+ clear H1; intros; split.
+unfold covering in H1; unfold covering in |- *; intros;
+ apply (H1 _ (H0 _ H4)).
+apply H3.
+elim (H _ H3); intros D H4; exists D; unfold covering_finite in |- *;
+ unfold covering_finite in H4; elim H4; intros; split.
+unfold covering in H5; unfold covering in |- *; intros;
+ apply (H5 _ (H2 _ H7)).
+apply H6.
Qed.
(* Borel-Lebesgue's lemma *)
-Lemma compact_P3 : (a,b:R) (compact [c:R]``a<=c<=b``).
-Intros; Case (total_order_Rle a b); Intro.
-Unfold compact; Intros; Pose A := [x:R]``a<=x<=b``/\(EXT D:R->Prop | (covering_finite [c:R]``a <= c <= x`` (subfamily f0 D))); Cut (A a).
-Intro; Cut (bound A).
-Intro; Cut (EXT a0:R | (A a0)).
-Intro; Assert H3 := (complet A H1 H2); Elim H3; Clear H3; Intros m H3; Unfold is_lub in H3; Cut ``a<=m<=b``.
-Intro; Unfold covering_open_set in H; Elim H; Clear H; Intros; Unfold covering in H; Assert H6 := (H m H4); Elim H6; Clear H6; Intros y0 H6; Unfold family_open_set in H5; Assert H7 := (H5 y0); Unfold open_set in H7; Assert H8 := (H7 m H6); Unfold neighbourhood in H8; Elim H8; Clear H8; Intros eps H8; Cut (EXT x:R | (A x)/\``m-eps<x<=m``).
-Intro; Elim H9; Clear H9; Intros x H9; Elim H9; Clear H9; Intros; Case (Req_EM m b); Intro.
-Rewrite H11 in H10; Rewrite H11 in H8; Unfold A in H9; Elim H9; Clear H9; Intros; Elim H12; Clear H12; Intros Dx H12; Pose Db := [x:R](Dx x)\/x==y0; Exists Db; Unfold covering_finite; Split.
-Unfold covering; Unfold covering_finite in H12; Elim H12; Clear H12; Intros; Unfold covering in H12; Case (total_order_Rle x0 x); Intro.
-Cut ``a<=x0<=x``.
-Intro; Assert H16 := (H12 x0 H15); Elim H16; Clear H16; Intros; Exists x1; Simpl in H16; Simpl; Unfold Db; Elim H16; Clear H16; Intros; Split; [Apply H16 | Left; Apply H17].
-Split.
-Elim H14; Intros; Assumption.
-Assumption.
-Exists y0; Simpl; Split.
-Apply H8; Unfold disc; Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Rewrite Rabsolu_right.
-Apply Rlt_trans with ``b-x``.
-Unfold Rminus; Apply Rlt_compatibility; Apply Rlt_Ropp; Auto with real.
-Elim H10; Intros H15 _; Apply Rlt_anti_compatibility with ``x-eps``; Replace ``x-eps+(b-x)`` with ``b-eps``; [Replace ``x-eps+eps`` with x; [Apply H15 | Ring] | Ring].
-Apply Rge_minus; Apply Rle_sym1; Elim H14; Intros _ H15; Apply H15.
-Unfold Db; Right; Reflexivity.
-Unfold family_finite; Unfold domain_finite; Unfold covering_finite in H12; Elim H12; Clear H12; Intros; Unfold family_finite in H13; Unfold domain_finite in H13; Elim H13; Clear H13; Intros l H13; Exists (cons y0 l); Intro; Split.
-Intro; Simpl in H14; Unfold intersection_domain in H14; Elim (H13 x0); Clear H13; Intros; Case (Req_EM x0 y0); Intro.
-Simpl; Left; Apply H16.
-Simpl; Right; Apply H13.
-Simpl; Unfold intersection_domain; Unfold Db in H14; Decompose [and or] H14.
-Split; Assumption.
-Elim H16; Assumption.
-Intro; Simpl in H14; Elim H14; Intro; Simpl; Unfold intersection_domain.
-Split.
-Apply (cond_fam f0); Rewrite H15; Exists m; Apply H6.
-Unfold Db; Right; Assumption.
-Simpl; Unfold intersection_domain; Elim (H13 x0).
-Intros _ H16; Assert H17 := (H16 H15); Simpl in H17; Unfold intersection_domain in H17; Split.
-Elim H17; Intros; Assumption.
-Unfold Db; Left; Elim H17; Intros; Assumption.
-Pose m' := (Rmin ``m+eps/2`` b); Cut (A m').
-Intro; Elim H3; Intros; Unfold is_upper_bound in H13; Assert H15 := (H13 m' H12); Cut ``m<m'``.
-Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H15 H16)).
-Unfold m'; Unfold Rmin; Case (total_order_Rle ``m+eps/2`` b); Intro.
-Pattern 1 m; Rewrite <- Rplus_Or; Apply Rlt_compatibility; Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos eps) | Apply Rlt_Rinv; Sup0].
-Elim H4; Intros.
-Elim H17; Intro.
-Assumption.
-Elim H11; Assumption.
-Unfold A; Split.
-Split.
-Apply Rle_trans with m.
-Elim H4; Intros; Assumption.
-Unfold m'; Unfold Rmin; Case (total_order_Rle ``m+eps/2`` b); Intro.
-Pattern 1 m; Rewrite <- Rplus_Or; Apply Rle_compatibility; Left; Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos eps) | Apply Rlt_Rinv; Sup0].
-Elim H4; Intros.
-Elim H13; Intro.
-Assumption.
-Elim H11; Assumption.
-Unfold m'; Apply Rmin_r.
-Unfold A in H9; Elim H9; Clear H9; Intros; Elim H12; Clear H12; Intros Dx H12; Pose Db := [x:R](Dx x)\/x==y0; Exists Db; Unfold covering_finite; Split.
-Unfold covering; Unfold covering_finite in H12; Elim H12; Clear H12; Intros; Unfold covering in H12; Case (total_order_Rle x0 x); Intro.
-Cut ``a<=x0<=x``.
-Intro; Assert H16 := (H12 x0 H15); Elim H16; Clear H16; Intros; Exists x1; Simpl in H16; Simpl; Unfold Db.
-Elim H16; Clear H16; Intros; Split; [Apply H16 | Left; Apply H17].
-Elim H14; Intros; Split; Assumption.
-Exists y0; Simpl; Split.
-Apply H8; Unfold disc; Unfold Rabsolu; Case (case_Rabsolu ``x0-m``); Intro.
-Rewrite Ropp_distr2; Apply Rlt_trans with ``m-x``.
-Unfold Rminus; Apply Rlt_compatibility; Apply Rlt_Ropp; Auto with real.
-Apply Rlt_anti_compatibility with ``x-eps``; Replace ``x-eps+(m-x)`` with ``m-eps``.
-Replace ``x-eps+eps`` with x.
-Elim H10; Intros; Assumption.
-Ring.
-Ring.
-Apply Rle_lt_trans with ``m'-m``.
-Unfold Rminus; Do 2 Rewrite <- (Rplus_sym ``-m``); Apply Rle_compatibility; Elim H14; Intros; Assumption.
-Apply Rlt_anti_compatibility with m; Replace ``m+(m'-m)`` with m'.
-Apply Rle_lt_trans with ``m+eps/2``.
-Unfold m'; Apply Rmin_l.
-Apply Rlt_compatibility; Apply Rlt_monotony_contra with ``2``.
-Sup0.
-Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1l; Pattern 1 (pos eps); Rewrite <- Rplus_Or; Rewrite double; Apply Rlt_compatibility; Apply (cond_pos eps).
-DiscrR.
-Ring.
-Unfold Db; Right; Reflexivity.
-Unfold family_finite; Unfold domain_finite; Unfold covering_finite in H12; Elim H12; Clear H12; Intros; Unfold family_finite in H13; Unfold domain_finite in H13; Elim H13; Clear H13; Intros l H13; Exists (cons y0 l); Intro; Split.
-Intro; Simpl in H14; Unfold intersection_domain in H14; Elim (H13 x0); Clear H13; Intros; Case (Req_EM x0 y0); Intro.
-Simpl; Left; Apply H16.
-Simpl; Right; Apply H13; Simpl; Unfold intersection_domain; Unfold Db in H14; Decompose [and or] H14.
-Split; Assumption.
-Elim H16; Assumption.
-Intro; Simpl in H14; Elim H14; Intro; Simpl; Unfold intersection_domain.
-Split.
-Apply (cond_fam f0); Rewrite H15; Exists m; Apply H6.
-Unfold Db; Right; Assumption.
-Elim (H13 x0); Intros _ H16.
-Assert H17 := (H16 H15).
-Simpl in H17.
-Unfold intersection_domain in H17.
-Split.
-Elim H17; Intros; Assumption.
-Unfold Db; Left; Elim H17; Intros; Assumption.
-Elim (classic (EXT x:R | (A x)/\``m-eps < x <= m``)); Intro.
-Assumption.
-Elim H3; Intros; Cut (is_upper_bound A ``m-eps``).
-Intro; Assert H13 := (H11 ? H12); Cut ``m-eps<m``.
-Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H13 H14)).
-Pattern 2 m; Rewrite <- Rplus_Or; Unfold Rminus; Apply Rlt_compatibility; Apply Ropp_Rlt; Rewrite Ropp_Ropp; Rewrite Ropp_O; Apply (cond_pos eps).
-Pose P := [n:R](A n)/\``m-eps<n<=m``; Assert H12 := (not_ex_all_not ? P H9); Unfold P in H12; Unfold is_upper_bound; Intros; Assert H14 := (not_and_or ? ? (H12 x)); Elim H14; Intro.
-Elim H15; Apply H13.
-Elim (not_and_or ? ? H15); Intro.
-Case (total_order_Rle x ``m-eps``); Intro.
-Assumption.
-Elim H16; Auto with real.
-Unfold is_upper_bound in H10; Assert H17 := (H10 x H13); Elim H16; Apply H17.
-Elim H3; Clear H3; Intros.
-Unfold is_upper_bound in H3.
-Split.
-Apply (H3 ? H0).
-Apply (H4 b); Unfold is_upper_bound; Intros; Unfold A in H5; Elim H5; Clear H5; Intros H5 _; Elim H5; Clear H5; Intros _ H5; Apply H5.
-Exists a; Apply H0.
-Unfold bound; Exists b; Unfold is_upper_bound; Intros; Unfold A in H1; Elim H1; Clear H1; Intros H1 _; Elim H1; Clear H1; Intros _ H1; Apply H1.
-Unfold A; Split.
-Split; [Right; Reflexivity | Apply r].
-Unfold covering_open_set in H; Elim H; Clear H; Intros; Unfold covering in H; Cut ``a<=a<=b``.
-Intro; Elim (H ? H1); Intros y0 H2; Pose D':=[x:R]x==y0; Exists D'; Unfold covering_finite; Split.
-Unfold covering; Simpl; Intros; Cut x==a.
-Intro; Exists y0; Split.
-Rewrite H4; Apply H2.
-Unfold D'; Reflexivity.
-Elim H3; Intros; Apply Rle_antisym; Assumption.
-Unfold family_finite; Unfold domain_finite; Exists (cons y0 nil); Intro; Split.
-Simpl; Unfold intersection_domain; Intro; Elim H3; Clear H3; Intros; Unfold D' in H4; Left; Apply H4.
-Simpl; Unfold intersection_domain; Intro; Elim H3; Intro.
-Split; [Rewrite H4; Apply (cond_fam f0); Exists a; Apply H2 | Apply H4].
-Elim H4.
-Split; [Right; Reflexivity | Apply r].
-Apply compact_eqDom with [c:R]False.
-Apply compact_EMP.
-Unfold eq_Dom; Split.
-Unfold included; Intros; Elim H.
-Unfold included; Intros; Elim H; Clear H; Intros; Assert H1 := (Rle_trans ? ? ? H H0); Elim n; Apply H1.
+Lemma compact_P3 : forall a b:R, compact (fun c:R => a <= c <= b).
+intros; case (Rle_dec a b); intro.
+unfold compact in |- *; intros;
+ pose
+ (A :=
+ fun x:R =>
+ a <= x <= b /\
+ ( exists D : R -> Prop
+ | covering_finite (fun c:R => a <= c <= x) (subfamily f0 D)));
+ cut (A a).
+intro; cut (bound A).
+intro; cut ( exists a0 : R | A a0).
+intro; assert (H3 := completeness A H1 H2); elim H3; clear H3; intros m H3;
+ unfold is_lub in H3; cut (a <= m <= b).
+intro; unfold covering_open_set in H; elim H; clear H; intros;
+ unfold covering in H; assert (H6 := H m H4); elim H6;
+ clear H6; intros y0 H6; unfold family_open_set in H5;
+ assert (H7 := H5 y0); unfold open_set in H7; assert (H8 := H7 m H6);
+ unfold neighbourhood in H8; elim H8; clear H8; intros eps H8;
+ cut ( exists x : R | A x /\ m - eps < x <= m).
+intro; elim H9; clear H9; intros x H9; elim H9; clear H9; intros;
+ case (Req_dec m b); intro.
+rewrite H11 in H10; rewrite H11 in H8; unfold A in H9; elim H9; clear H9;
+ intros; elim H12; clear H12; intros Dx H12;
+ pose (Db := fun x:R => Dx x \/ x = y0); exists Db;
+ unfold covering_finite in |- *; split.
+unfold covering in |- *; unfold covering_finite in H12; elim H12; clear H12;
+ intros; unfold covering in H12; case (Rle_dec x0 x);
+ intro.
+cut (a <= x0 <= x).
+intro; assert (H16 := H12 x0 H15); elim H16; clear H16; intros; exists x1;
+ simpl in H16; simpl in |- *; unfold Db in |- *; elim H16;
+ clear H16; intros; split; [ apply H16 | left; apply H17 ].
+split.
+elim H14; intros; assumption.
+assumption.
+exists y0; simpl in |- *; split.
+apply H8; unfold disc in |- *; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr;
+ rewrite Rabs_right.
+apply Rlt_trans with (b - x).
+unfold Rminus in |- *; apply Rplus_lt_compat_l; apply Ropp_lt_gt_contravar;
+ auto with real.
+elim H10; intros H15 _; apply Rplus_lt_reg_r with (x - eps);
+ replace (x - eps + (b - x)) with (b - eps);
+ [ replace (x - eps + eps) with x; [ apply H15 | ring ] | ring ].
+apply Rge_minus; apply Rle_ge; elim H14; intros _ H15; apply H15.
+unfold Db in |- *; right; reflexivity.
+unfold family_finite in |- *; unfold domain_finite in |- *;
+ unfold covering_finite in H12; elim H12; clear H12;
+ intros; unfold family_finite in H13; unfold domain_finite in H13;
+ elim H13; clear H13; intros l H13; exists (cons y0 l);
+ intro; split.
+intro; simpl in H14; unfold intersection_domain in H14; elim (H13 x0);
+ clear H13; intros; case (Req_dec x0 y0); intro.
+simpl in |- *; left; apply H16.
+simpl in |- *; right; apply H13.
+simpl in |- *; unfold intersection_domain in |- *; unfold Db in H14;
+ decompose [and or] H14.
+split; assumption.
+elim H16; assumption.
+intro; simpl in H14; elim H14; intro; simpl in |- *;
+ unfold intersection_domain in |- *.
+split.
+apply (cond_fam f0); rewrite H15; exists m; apply H6.
+unfold Db in |- *; right; assumption.
+simpl in |- *; unfold intersection_domain in |- *; elim (H13 x0).
+intros _ H16; assert (H17 := H16 H15); simpl in H17;
+ unfold intersection_domain in H17; split.
+elim H17; intros; assumption.
+unfold Db in |- *; left; elim H17; intros; assumption.
+pose (m' := Rmin (m + eps / 2) b); cut (A m').
+intro; elim H3; intros; unfold is_upper_bound in H13;
+ assert (H15 := H13 m' H12); cut (m < m').
+intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H15 H16)).
+unfold m' in |- *; unfold Rmin in |- *; case (Rle_dec (m + eps / 2) b); intro.
+pattern m at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
+ unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ apply (cond_pos eps) | apply Rinv_0_lt_compat; prove_sup0 ].
+elim H4; intros.
+elim H17; intro.
+assumption.
+elim H11; assumption.
+unfold A in |- *; split.
+split.
+apply Rle_trans with m.
+elim H4; intros; assumption.
+unfold m' in |- *; unfold Rmin in |- *; case (Rle_dec (m + eps / 2) b); intro.
+pattern m at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left;
+ unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ apply (cond_pos eps) | apply Rinv_0_lt_compat; prove_sup0 ].
+elim H4; intros.
+elim H13; intro.
+assumption.
+elim H11; assumption.
+unfold m' in |- *; apply Rmin_r.
+unfold A in H9; elim H9; clear H9; intros; elim H12; clear H12; intros Dx H12;
+ pose (Db := fun x:R => Dx x \/ x = y0); exists Db;
+ unfold covering_finite in |- *; split.
+unfold covering in |- *; unfold covering_finite in H12; elim H12; clear H12;
+ intros; unfold covering in H12; case (Rle_dec x0 x);
+ intro.
+cut (a <= x0 <= x).
+intro; assert (H16 := H12 x0 H15); elim H16; clear H16; intros; exists x1;
+ simpl in H16; simpl in |- *; unfold Db in |- *.
+elim H16; clear H16; intros; split; [ apply H16 | left; apply H17 ].
+elim H14; intros; split; assumption.
+exists y0; simpl in |- *; split.
+apply H8; unfold disc in |- *; unfold Rabs in |- *; case (Rcase_abs (x0 - m));
+ intro.
+rewrite Ropp_minus_distr; apply Rlt_trans with (m - x).
+unfold Rminus in |- *; apply Rplus_lt_compat_l; apply Ropp_lt_gt_contravar;
+ auto with real.
+apply Rplus_lt_reg_r with (x - eps);
+ replace (x - eps + (m - x)) with (m - eps).
+replace (x - eps + eps) with x.
+elim H10; intros; assumption.
+ring.
+ring.
+apply Rle_lt_trans with (m' - m).
+unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (- m));
+ apply Rplus_le_compat_l; elim H14; intros; assumption.
+apply Rplus_lt_reg_r with m; replace (m + (m' - m)) with m'.
+apply Rle_lt_trans with (m + eps / 2).
+unfold m' in |- *; apply Rmin_l.
+apply Rplus_lt_compat_l; apply Rmult_lt_reg_l with 2.
+prove_sup0.
+unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+ rewrite <- Rinv_r_sym.
+rewrite Rmult_1_l; pattern (pos eps) at 1 in |- *; rewrite <- Rplus_0_r;
+ rewrite double; apply Rplus_lt_compat_l; apply (cond_pos eps).
+discrR.
+ring.
+unfold Db in |- *; right; reflexivity.
+unfold family_finite in |- *; unfold domain_finite in |- *;
+ unfold covering_finite in H12; elim H12; clear H12;
+ intros; unfold family_finite in H13; unfold domain_finite in H13;
+ elim H13; clear H13; intros l H13; exists (cons y0 l);
+ intro; split.
+intro; simpl in H14; unfold intersection_domain in H14; elim (H13 x0);
+ clear H13; intros; case (Req_dec x0 y0); intro.
+simpl in |- *; left; apply H16.
+simpl in |- *; right; apply H13; simpl in |- *;
+ unfold intersection_domain in |- *; unfold Db in H14;
+ decompose [and or] H14.
+split; assumption.
+elim H16; assumption.
+intro; simpl in H14; elim H14; intro; simpl in |- *;
+ unfold intersection_domain in |- *.
+split.
+apply (cond_fam f0); rewrite H15; exists m; apply H6.
+unfold Db in |- *; right; assumption.
+elim (H13 x0); intros _ H16.
+assert (H17 := H16 H15).
+simpl in H17.
+unfold intersection_domain in H17.
+split.
+elim H17; intros; assumption.
+unfold Db in |- *; left; elim H17; intros; assumption.
+elim (classic ( exists x : R | A x /\ m - eps < x <= m)); intro.
+assumption.
+elim H3; intros; cut (is_upper_bound A (m - eps)).
+intro; assert (H13 := H11 _ H12); cut (m - eps < m).
+intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H13 H14)).
+pattern m at 2 in |- *; rewrite <- Rplus_0_r; unfold Rminus in |- *;
+ apply Rplus_lt_compat_l; apply Ropp_lt_cancel; rewrite Ropp_involutive;
+ rewrite Ropp_0; apply (cond_pos eps).
+pose (P := fun n:R => A n /\ m - eps < n <= m);
+ assert (H12 := not_ex_all_not _ P H9); unfold P in H12;
+ unfold is_upper_bound in |- *; intros;
+ assert (H14 := not_and_or _ _ (H12 x)); elim H14;
+ intro.
+elim H15; apply H13.
+elim (not_and_or _ _ H15); intro.
+case (Rle_dec x (m - eps)); intro.
+assumption.
+elim H16; auto with real.
+unfold is_upper_bound in H10; assert (H17 := H10 x H13); elim H16; apply H17.
+elim H3; clear H3; intros.
+unfold is_upper_bound in H3.
+split.
+apply (H3 _ H0).
+apply (H4 b); unfold is_upper_bound in |- *; intros; unfold A in H5; elim H5;
+ clear H5; intros H5 _; elim H5; clear H5; intros _ H5;
+ apply H5.
+exists a; apply H0.
+unfold bound in |- *; exists b; unfold is_upper_bound in |- *; intros;
+ unfold A in H1; elim H1; clear H1; intros H1 _; elim H1;
+ clear H1; intros _ H1; apply H1.
+unfold A in |- *; split.
+split; [ right; reflexivity | apply r ].
+unfold covering_open_set in H; elim H; clear H; intros; unfold covering in H;
+ cut (a <= a <= b).
+intro; elim (H _ H1); intros y0 H2; pose (D' := fun x:R => x = y0); exists D';
+ unfold covering_finite in |- *; split.
+unfold covering in |- *; simpl in |- *; intros; cut (x = a).
+intro; exists y0; split.
+rewrite H4; apply H2.
+unfold D' in |- *; reflexivity.
+elim H3; intros; apply Rle_antisym; assumption.
+unfold family_finite in |- *; unfold domain_finite in |- *;
+ exists (cons y0 nil); intro; split.
+simpl in |- *; unfold intersection_domain in |- *; intro; elim H3; clear H3;
+ intros; unfold D' in H4; left; apply H4.
+simpl in |- *; unfold intersection_domain in |- *; intro; elim H3; intro.
+split; [ rewrite H4; apply (cond_fam f0); exists a; apply H2 | apply H4 ].
+elim H4.
+split; [ right; reflexivity | apply r ].
+apply compact_eqDom with (fun c:R => False).
+apply compact_EMP.
+unfold eq_Dom in |- *; split.
+unfold included in |- *; intros; elim H.
+unfold included in |- *; intros; elim H; clear H; intros;
+ assert (H1 := Rle_trans _ _ _ H H0); elim n; apply H1.
Qed.
-Lemma compact_P4 : (X,F:R->Prop) (compact X) -> (closed_set F) -> (included F X) -> (compact F).
-Unfold compact; Intros; Elim (classic (EXT z:R | (F z))); Intro Hyp_F_NE.
-Pose D := (ind f0); Pose g := (f f0); Unfold closed_set in H0.
-Pose g' := [x:R][y:R](f0 x y)\/((complementary F y)/\(D x)).
-Pose D' := D.
-Cut (x:R)(EXT y:R | (g' x y))->(D' x).
-Intro; Pose f' := (mkfamily D' g' H3); Cut (covering_open_set X f').
-Intro; Elim (H ? H4); Intros DX H5; Exists DX.
-Unfold covering_finite; Unfold covering_finite in H5; Elim H5; Clear H5; Intros.
-Split.
-Unfold covering; Unfold covering in H5; Intros.
-Elim (H5 ? (H1 ? H7)); Intros y0 H8; Exists y0; Simpl in H8; Simpl; Elim H8; Clear H8; Intros.
-Split.
-Unfold g' in H8; Elim H8; Intro.
-Apply H10.
-Elim H10; Intros H11 _; Unfold complementary in H11; Elim H11; Apply H7.
-Apply H9.
-Unfold family_finite; Unfold domain_finite; Unfold family_finite in H6; Unfold domain_finite in H6; Elim H6; Clear H6; Intros l H6; Exists l; Intro; Assert H7 := (H6 x); Elim H7; Clear H7; Intros.
-Split.
-Intro; Apply H7; Simpl; Unfold intersection_domain; Simpl in H9; Unfold intersection_domain in H9; Unfold D'; Apply H9.
-Intro; Assert H10 := (H8 H9); Simpl in H10; Unfold intersection_domain in H10; Simpl; Unfold intersection_domain; Unfold D' in H10; Apply H10.
-Unfold covering_open_set; Unfold covering_open_set in H2; Elim H2; Clear H2; Intros.
-Split.
-Unfold covering; Unfold covering in H2; Intros.
-Elim (classic (F x)); Intro.
-Elim (H2 ? H6); Intros y0 H7; Exists y0; Simpl; Unfold g'; Left; Assumption.
-Cut (EXT z:R | (D z)).
-Intro; Elim H7; Clear H7; Intros x0 H7; Exists x0; Simpl; Unfold g'; Right.
-Split.
-Unfold complementary; Apply H6.
-Apply H7.
-Elim Hyp_F_NE; Intros z0 H7.
-Assert H8 := (H2 ? H7).
-Elim H8; Clear H8; Intros t H8; Exists t; Apply (cond_fam f0); Exists z0; Apply H8.
-Unfold family_open_set; Intro; Simpl; Unfold g'; Elim (classic (D x)); Intro.
-Apply open_set_P6 with (union_domain (f0 x) (complementary F)).
-Apply open_set_P2.
-Unfold family_open_set in H4; Apply H4.
-Apply H0.
-Unfold eq_Dom; Split.
-Unfold included union_domain complementary; Intros.
-Elim H6; Intro; [Left; Apply H7 | Right; Split; Assumption].
-Unfold included union_domain complementary; Intros.
-Elim H6; Intro; [Left; Apply H7 | Right; Elim H7; Intros; Apply H8].
-Apply open_set_P6 with (f0 x).
-Unfold family_open_set in H4; Apply H4.
-Unfold eq_Dom; Split.
-Unfold included complementary; Intros; Left; Apply H6.
-Unfold included complementary; Intros.
-Elim H6; Intro.
-Apply H7.
-Elim H7; Intros _ H8; Elim H5; Apply H8.
-Intros; Elim H3; Intros y0 H4; Unfold g' in H4; Elim H4; Intro.
-Apply (cond_fam f0); Exists y0; Apply H5.
-Elim H5; Clear H5; Intros _ H5; Apply H5.
+Lemma compact_P4 :
+ forall X F:R -> Prop, compact X -> closed_set F -> included F X -> compact F.
+unfold compact in |- *; intros; elim (classic ( exists z : R | F z));
+ intro Hyp_F_NE.
+pose (D := ind f0); pose (g := f f0); unfold closed_set in H0.
+pose (g' := fun x y:R => f0 x y \/ complementary F y /\ D x).
+pose (D' := D).
+cut (forall x:R, ( exists y : R | g' x y) -> D' x).
+intro; pose (f' := mkfamily D' g' H3); cut (covering_open_set X f').
+intro; elim (H _ H4); intros DX H5; exists DX.
+unfold covering_finite in |- *; unfold covering_finite in H5; elim H5;
+ clear H5; intros.
+split.
+unfold covering in |- *; unfold covering in H5; intros.
+elim (H5 _ (H1 _ H7)); intros y0 H8; exists y0; simpl in H8; simpl in |- *;
+ elim H8; clear H8; intros.
+split.
+unfold g' in H8; elim H8; intro.
+apply H10.
+elim H10; intros H11 _; unfold complementary in H11; elim H11; apply H7.
+apply H9.
+unfold family_finite in |- *; unfold domain_finite in |- *;
+ unfold family_finite in H6; unfold domain_finite in H6;
+ elim H6; clear H6; intros l H6; exists l; intro; assert (H7 := H6 x);
+ elim H7; clear H7; intros.
+split.
+intro; apply H7; simpl in |- *; unfold intersection_domain in |- *;
+ simpl in H9; unfold intersection_domain in H9; unfold D' in |- *;
+ apply H9.
+intro; assert (H10 := H8 H9); simpl in H10; unfold intersection_domain in H10;
+ simpl in |- *; unfold intersection_domain in |- *;
+ unfold D' in H10; apply H10.
+unfold covering_open_set in |- *; unfold covering_open_set in H2; elim H2;
+ clear H2; intros.
+split.
+unfold covering in |- *; unfold covering in H2; intros.
+elim (classic (F x)); intro.
+elim (H2 _ H6); intros y0 H7; exists y0; simpl in |- *; unfold g' in |- *;
+ left; assumption.
+cut ( exists z : R | D z).
+intro; elim H7; clear H7; intros x0 H7; exists x0; simpl in |- *;
+ unfold g' in |- *; right.
+split.
+unfold complementary in |- *; apply H6.
+apply H7.
+elim Hyp_F_NE; intros z0 H7.
+assert (H8 := H2 _ H7).
+elim H8; clear H8; intros t H8; exists t; apply (cond_fam f0); exists z0;
+ apply H8.
+unfold family_open_set in |- *; intro; simpl in |- *; unfold g' in |- *;
+ elim (classic (D x)); intro.
+apply open_set_P6 with (union_domain (f0 x) (complementary F)).
+apply open_set_P2.
+unfold family_open_set in H4; apply H4.
+apply H0.
+unfold eq_Dom in |- *; split.
+unfold included, union_domain, complementary in |- *; intros.
+elim H6; intro; [ left; apply H7 | right; split; assumption ].
+unfold included, union_domain, complementary in |- *; intros.
+elim H6; intro; [ left; apply H7 | right; elim H7; intros; apply H8 ].
+apply open_set_P6 with (f0 x).
+unfold family_open_set in H4; apply H4.
+unfold eq_Dom in |- *; split.
+unfold included, complementary in |- *; intros; left; apply H6.
+unfold included, complementary in |- *; intros.
+elim H6; intro.
+apply H7.
+elim H7; intros _ H8; elim H5; apply H8.
+intros; elim H3; intros y0 H4; unfold g' in H4; elim H4; intro.
+apply (cond_fam f0); exists y0; apply H5.
+elim H5; clear H5; intros _ H5; apply H5.
(* Cas ou F est l'ensemble vide *)
-Cut (compact F).
-Intro; Apply (H3 f0 H2).
-Apply compact_eqDom with [_:R]False.
-Apply compact_EMP.
-Unfold eq_Dom; Split.
-Unfold included; Intros; Elim H3.
-Assert H3 := (not_ex_all_not ? ? Hyp_F_NE); Unfold included; Intros; Elim (H3 x); Apply H4.
+cut (compact F).
+intro; apply (H3 f0 H2).
+apply compact_eqDom with (fun _:R => False).
+apply compact_EMP.
+unfold eq_Dom in |- *; split.
+unfold included in |- *; intros; elim H3.
+assert (H3 := not_ex_all_not _ _ Hyp_F_NE); unfold included in |- *; intros;
+ elim (H3 x); apply H4.
Qed.
(**********)
-Lemma compact_P5 : (X:R->Prop) (closed_set X)->(bounded X)->(compact X).
-Intros; Unfold bounded in H0.
-Elim H0; Clear H0; Intros m H0.
-Elim H0; Clear H0; Intros M H0.
-Assert H1 := (compact_P3 m M).
-Apply (compact_P4 [c:R]``m<=c<=M`` X H1 H H0).
+Lemma compact_P5 : forall X:R -> Prop, closed_set X -> bounded X -> compact X.
+intros; unfold bounded in H0.
+elim H0; clear H0; intros m H0.
+elim H0; clear H0; intros M H0.
+assert (H1 := compact_P3 m M).
+apply (compact_P4 (fun c:R => m <= c <= M) X H1 H H0).
Qed.
(**********)
-Lemma compact_carac : (X:R->Prop) (compact X)<->(closed_set X)/\(bounded X).
-Intro; Split.
-Intro; Split; [Apply (compact_P2 ? H) | Apply (compact_P1 ? H)].
-Intro; Elim H; Clear H; Intros; Apply (compact_P5 ? H H0).
+Lemma compact_carac :
+ forall X:R -> Prop, compact X <-> closed_set X /\ bounded X.
+intro; split.
+intro; split; [ apply (compact_P2 _ H) | apply (compact_P1 _ H) ].
+intro; elim H; clear H; intros; apply (compact_P5 _ H H0).
Qed.
-Definition image_dir [f:R->R;D:R->Prop] : R->Prop := [x:R](EXT y:R | x==(f y)/\(D y)).
+Definition image_dir (f:R -> R) (D:R -> Prop) (x:R) : Prop :=
+ exists y : R | x = f y /\ D y.
(**********)
-Lemma continuity_compact : (f:R->R;X:R->Prop) ((x:R)(continuity_pt f x)) -> (compact X) -> (compact (image_dir f X)).
-Unfold compact; Intros; Unfold covering_open_set in H1.
-Elim H1; Clear H1; Intros.
-Pose D := (ind f1).
-Pose g := [x:R][y:R](image_rec f0 (f1 x) y).
-Cut (x:R)(EXT y:R | (g x y))->(D x).
-Intro; Pose f' := (mkfamily D g H3).
-Cut (covering_open_set X f').
-Intro; Elim (H0 f' H4); Intros D' H5; Exists D'.
-Unfold covering_finite in H5; Elim H5; Clear H5; Intros; Unfold covering_finite; Split.
-Unfold covering image_dir; Simpl; Unfold covering in H5; Intros; Elim H7; Intros y H8; Elim H8; Intros; Assert H11 := (H5 ? H10); Simpl in H11; Elim H11; Intros z H12; Exists z; Unfold g in H12; Unfold image_rec in H12; Rewrite H9; Apply H12.
-Unfold family_finite in H6; Unfold domain_finite in H6; Unfold family_finite; Unfold domain_finite; Elim H6; Intros l H7; Exists l; Intro; Elim (H7 x); Intros; Split; Intro.
-Apply H8; Simpl in H10; Simpl; Apply H10.
-Apply (H9 H10).
-Unfold covering_open_set; Split.
-Unfold covering; Intros; Simpl; Unfold covering in H1; Unfold image_dir in H1; Unfold g; Unfold image_rec; Apply H1.
-Exists x; Split; [Reflexivity | Apply H4].
-Unfold family_open_set; Unfold family_open_set in H2; Intro; Simpl; Unfold g; Cut ([y:R](image_rec f0 (f1 x) y))==(image_rec f0 (f1 x)).
-Intro; Rewrite H4.
-Apply (continuity_P2 f0 (f1 x) H (H2 x)).
-Reflexivity.
-Intros; Apply (cond_fam f1); Unfold g in H3; Unfold image_rec in H3; Elim H3; Intros; Exists (f0 x0); Apply H4.
+Lemma continuity_compact :
+ forall (f:R -> R) (X:R -> Prop),
+ (forall x:R, continuity_pt f x) -> compact X -> compact (image_dir f X).
+unfold compact in |- *; intros; unfold covering_open_set in H1.
+elim H1; clear H1; intros.
+pose (D := ind f1).
+pose (g := fun x y:R => image_rec f0 (f1 x) y).
+cut (forall x:R, ( exists y : R | g x y) -> D x).
+intro; pose (f' := mkfamily D g H3).
+cut (covering_open_set X f').
+intro; elim (H0 f' H4); intros D' H5; exists D'.
+unfold covering_finite in H5; elim H5; clear H5; intros;
+ unfold covering_finite in |- *; split.
+unfold covering, image_dir in |- *; simpl in |- *; unfold covering in H5;
+ intros; elim H7; intros y H8; elim H8; intros; assert (H11 := H5 _ H10);
+ simpl in H11; elim H11; intros z H12; exists z; unfold g in H12;
+ unfold image_rec in H12; rewrite H9; apply H12.
+unfold family_finite in H6; unfold domain_finite in H6;
+ unfold family_finite in |- *; unfold domain_finite in |- *;
+ elim H6; intros l H7; exists l; intro; elim (H7 x);
+ intros; split; intro.
+apply H8; simpl in H10; simpl in |- *; apply H10.
+apply (H9 H10).
+unfold covering_open_set in |- *; split.
+unfold covering in |- *; intros; simpl in |- *; unfold covering in H1;
+ unfold image_dir in H1; unfold g in |- *; unfold image_rec in |- *;
+ apply H1.
+exists x; split; [ reflexivity | apply H4 ].
+unfold family_open_set in |- *; unfold family_open_set in H2; intro;
+ simpl in |- *; unfold g in |- *;
+ cut ((fun y:R => image_rec f0 (f1 x) y) = image_rec f0 (f1 x)).
+intro; rewrite H4.
+apply (continuity_P2 f0 (f1 x) H (H2 x)).
+reflexivity.
+intros; apply (cond_fam f1); unfold g in H3; unfold image_rec in H3; elim H3;
+ intros; exists (f0 x0); apply H4.
Qed.
-Lemma Rlt_Rminus : (a,b:R) ``a<b`` -> ``0<b-a``.
-Intros; Apply Rlt_anti_compatibility with a; Rewrite Rplus_Or; Replace ``a+(b-a)`` with b; [Assumption | Ring].
+Lemma Rlt_Rminus : forall a b:R, a < b -> 0 < b - a.
+intros; apply Rplus_lt_reg_r with a; rewrite Rplus_0_r;
+ replace (a + (b - a)) with b; [ assumption | ring ].
Qed.
-Lemma prolongement_C0 : (f:R->R;a,b:R) ``a<=b`` -> ((c:R)``a<=c<=b``->(continuity_pt f c)) -> (EXT g:R->R | (continuity g)/\((c:R)``a<=c<=b``->(g c)==(f c))).
-Intros; Elim H; Intro.
-Pose h := [x:R](Cases (total_order_Rle x a) of
- (leftT _) => (f0 a)
-| (rightT _) => (Cases (total_order_Rle x b) of
- (leftT _) => (f0 x)
- | (rightT _) => (f0 b) end) end).
-Assert H2 : ``0<b-a``.
-Apply Rlt_Rminus; Assumption.
-Exists h; Split.
-Unfold continuity; Intro; Case (total_order x a); Intro.
-Unfold continuity_pt; Unfold continue_in; Unfold limit1_in; Unfold limit_in; Simpl; Unfold R_dist; Intros; Exists ``a-x``; Split.
-Change ``0<a-x``; Apply Rlt_Rminus; Assumption.
-Intros; Elim H5; Clear H5; Intros _ H5; Unfold h.
-Case (total_order_Rle x a); Intro.
-Case (total_order_Rle x0 a); Intro.
-Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption.
-Elim n; Left; Apply Rlt_anti_compatibility with ``-x``; Do 2 Rewrite (Rplus_sym ``-x``); Apply Rle_lt_trans with ``(Rabsolu (x0-x))``.
-Apply Rle_Rabsolu.
-Assumption.
-Elim n; Left; Assumption.
-Elim H3; Intro.
-Assert H5 : ``a<=a<=b``.
-Split; [Right; Reflexivity | Left; Assumption].
-Assert H6 := (H0 ? H5); Unfold continuity_pt in H6; Unfold continue_in in H6; Unfold limit1_in in H6; Unfold limit_in in H6; Simpl in H6; Unfold R_dist in H6; Unfold continuity_pt; Unfold continue_in; Unfold limit1_in; Unfold limit_in; Simpl; Unfold R_dist; Intros; Elim (H6 ? H7); Intros; Exists (Rmin x0 ``b-a``); Split.
-Unfold Rmin; Case (total_order_Rle x0 ``b-a``); Intro.
-Elim H8; Intros; Assumption.
-Change ``0<b-a``; Apply Rlt_Rminus; Assumption.
-Intros; Elim H9; Clear H9; Intros _ H9; Cut ``x1<b``.
-Intro; Unfold h; Case (total_order_Rle x a); Intro.
-Case (total_order_Rle x1 a); Intro.
-Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption.
-Case (total_order_Rle x1 b); Intro.
-Elim H8; Intros; Apply H12; Split.
-Unfold D_x no_cond; Split.
-Trivial.
-Red; Intro; Elim n; Right; Symmetry; Assumption.
-Apply Rlt_le_trans with (Rmin x0 ``b-a``).
-Rewrite H4 in H9; Apply H9.
-Apply Rmin_l.
-Elim n0; Left; Assumption.
-Elim n; Right; Assumption.
-Apply Rlt_anti_compatibility with ``-a``; Do 2 Rewrite (Rplus_sym ``-a``); Rewrite H4 in H9; Apply Rle_lt_trans with ``(Rabsolu (x1-a))``.
-Apply Rle_Rabsolu.
-Apply Rlt_le_trans with ``(Rmin x0 (b-a))``.
-Assumption.
-Apply Rmin_r.
-Case (total_order x b); Intro.
-Assert H6 : ``a<=x<=b``.
-Split; Left; Assumption.
-Assert H7 := (H0 ? H6); Unfold continuity_pt in H7; Unfold continue_in in H7; Unfold limit1_in in H7; Unfold limit_in in H7; Simpl in H7; Unfold R_dist in H7; Unfold continuity_pt; Unfold continue_in; Unfold limit1_in; Unfold limit_in; Simpl; Unfold R_dist; Intros; Elim (H7 ? H8); Intros; Elim H9; Clear H9; Intros.
-Assert H11 : ``0<x-a``.
-Apply Rlt_Rminus; Assumption.
-Assert H12 : ``0<b-x``.
-Apply Rlt_Rminus; Assumption.
-Exists (Rmin x0 (Rmin ``x-a`` ``b-x``)); Split.
-Unfold Rmin; Case (total_order_Rle ``x-a`` ``b-x``); Intro.
-Case (total_order_Rle x0 ``x-a``); Intro.
-Assumption.
-Assumption.
-Case (total_order_Rle x0 ``b-x``); Intro.
-Assumption.
-Assumption.
-Intros; Elim H13; Clear H13; Intros; Cut ``a<x1<b``.
-Intro; Elim H15; Clear H15; Intros; Unfold h; Case (total_order_Rle x a); Intro.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r H4)).
-Case (total_order_Rle x b); Intro.
-Case (total_order_Rle x1 a); Intro.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r0 H15)).
-Case (total_order_Rle x1 b); Intro.
-Apply H10; Split.
-Assumption.
-Apply Rlt_le_trans with ``(Rmin x0 (Rmin (x-a) (b-x)))``.
-Assumption.
-Apply Rmin_l.
-Elim n1; Left; Assumption.
-Elim n0; Left; Assumption.
-Split.
-Apply Ropp_Rlt; Apply Rlt_anti_compatibility with x; Apply Rle_lt_trans with ``(Rabsolu (x1-x))``.
-Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply Rle_Rabsolu.
-Apply Rlt_le_trans with ``(Rmin x0 (Rmin (x-a) (b-x)))``.
-Assumption.
-Apply Rle_trans with ``(Rmin (x-a) (b-x))``.
-Apply Rmin_r.
-Apply Rmin_l.
-Apply Rlt_anti_compatibility with ``-x``; Do 2 Rewrite (Rplus_sym ``-x``); Apply Rle_lt_trans with ``(Rabsolu (x1-x))``.
-Apply Rle_Rabsolu.
-Apply Rlt_le_trans with ``(Rmin x0 (Rmin (x-a) (b-x)))``.
-Assumption.
-Apply Rle_trans with ``(Rmin (x-a) (b-x))``; Apply Rmin_r.
-Elim H5; Intro.
-Assert H7 : ``a<=b<=b``.
-Split; [Left; Assumption | Right; Reflexivity].
-Assert H8 := (H0 ? H7); Unfold continuity_pt in H8; Unfold continue_in in H8; Unfold limit1_in in H8; Unfold limit_in in H8; Simpl in H8; Unfold R_dist in H8; Unfold continuity_pt; Unfold continue_in; Unfold limit1_in; Unfold limit_in; Simpl; Unfold R_dist; Intros; Elim (H8 ? H9); Intros; Exists (Rmin x0 ``b-a``); Split.
-Unfold Rmin; Case (total_order_Rle x0 ``b-a``); Intro.
-Elim H10; Intros; Assumption.
-Change ``0<b-a``; Apply Rlt_Rminus; Assumption.
-Intros; Elim H11; Clear H11; Intros _ H11; Cut ``a<x1``.
-Intro; Unfold h; Case (total_order_Rle x a); Intro.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r H4)).
-Case (total_order_Rle x1 a); Intro.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r H12)).
-Case (total_order_Rle x b); Intro.
-Case (total_order_Rle x1 b); Intro.
-Rewrite H6; Elim H10; Intros; Elim r0; Intro.
-Apply H14; Split.
-Unfold D_x no_cond; Split.
-Trivial.
-Red; Intro; Rewrite <- H16 in H15; Elim (Rlt_antirefl ? H15).
-Rewrite H6 in H11; Apply Rlt_le_trans with ``(Rmin x0 (b-a))``.
-Apply H11.
-Apply Rmin_l.
-Rewrite H15; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption.
-Rewrite H6; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption.
-Elim n1; Right; Assumption.
-Rewrite H6 in H11; Apply Ropp_Rlt; Apply Rlt_anti_compatibility with b; Apply Rle_lt_trans with ``(Rabsolu (x1-b))``.
-Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply Rle_Rabsolu.
-Apply Rlt_le_trans with ``(Rmin x0 (b-a))``.
-Assumption.
-Apply Rmin_r.
-Unfold continuity_pt; Unfold continue_in; Unfold limit1_in; Unfold limit_in; Simpl; Unfold R_dist; Intros; Exists ``x-b``; Split.
-Change ``0<x-b``; Apply Rlt_Rminus; Assumption.
-Intros; Elim H8; Clear H8; Intros.
-Assert H10 : ``b<x0``.
-Apply Ropp_Rlt; Apply Rlt_anti_compatibility with x; Apply Rle_lt_trans with ``(Rabsolu (x0-x))``.
-Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply Rle_Rabsolu.
-Assumption.
-Unfold h; Case (total_order_Rle x a); Intro.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r H4)).
-Case (total_order_Rle x b); Intro.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r H6)).
-Case (total_order_Rle x0 a); Intro.
-Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H1 (Rlt_le_trans ? ? ? H10 r))).
-Case (total_order_Rle x0 b); Intro.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r H10)).
-Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption.
-Intros; Elim H3; Intros; Unfold h; Case (total_order_Rle c a); Intro.
-Elim r; Intro.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H4 H6)).
-Rewrite H6; Reflexivity.
-Case (total_order_Rle c b); Intro.
-Reflexivity.
-Elim n0; Assumption.
-Exists [_:R](f0 a); Split.
-Apply derivable_continuous; Apply (derivable_const (f0 a)).
-Intros; Elim H2; Intros; Rewrite H1 in H3; Cut b==c.
-Intro; Rewrite <- H5; Rewrite H1; Reflexivity.
-Apply Rle_antisym; Assumption.
+Lemma prolongement_C0 :
+ forall (f:R -> R) (a b:R),
+ a <= b ->
+ (forall c:R, a <= c <= b -> continuity_pt f c) ->
+ exists g : R -> R
+ | continuity g /\ (forall c:R, a <= c <= b -> g c = f c).
+intros; elim H; intro.
+pose
+ (h :=
+ fun x:R =>
+ match Rle_dec x a with
+ | left _ => f0 a
+ | right _ =>
+ match Rle_dec x b with
+ | left _ => f0 x
+ | right _ => f0 b
+ end
+ end).
+assert (H2 : 0 < b - a).
+apply Rlt_Rminus; assumption.
+exists h; split.
+unfold continuity in |- *; intro; case (Rtotal_order x a); intro.
+unfold continuity_pt in |- *; unfold continue_in in |- *;
+ unfold limit1_in in |- *; unfold limit_in in |- *;
+ simpl in |- *; unfold R_dist in |- *; intros; exists (a - x);
+ split.
+change (0 < a - x) in |- *; apply Rlt_Rminus; assumption.
+intros; elim H5; clear H5; intros _ H5; unfold h in |- *.
+case (Rle_dec x a); intro.
+case (Rle_dec x0 a); intro.
+unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption.
+elim n; left; apply Rplus_lt_reg_r with (- x);
+ do 2 rewrite (Rplus_comm (- x)); apply Rle_lt_trans with (Rabs (x0 - x)).
+apply RRle_abs.
+assumption.
+elim n; left; assumption.
+elim H3; intro.
+assert (H5 : a <= a <= b).
+split; [ right; reflexivity | left; assumption ].
+assert (H6 := H0 _ H5); unfold continuity_pt in H6; unfold continue_in in H6;
+ unfold limit1_in in H6; unfold limit_in in H6; simpl in H6;
+ unfold R_dist in H6; unfold continuity_pt in |- *;
+ unfold continue_in in |- *; unfold limit1_in in |- *;
+ unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *;
+ intros; elim (H6 _ H7); intros; exists (Rmin x0 (b - a));
+ split.
+unfold Rmin in |- *; case (Rle_dec x0 (b - a)); intro.
+elim H8; intros; assumption.
+change (0 < b - a) in |- *; apply Rlt_Rminus; assumption.
+intros; elim H9; clear H9; intros _ H9; cut (x1 < b).
+intro; unfold h in |- *; case (Rle_dec x a); intro.
+case (Rle_dec x1 a); intro.
+unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption.
+case (Rle_dec x1 b); intro.
+elim H8; intros; apply H12; split.
+unfold D_x, no_cond in |- *; split.
+trivial.
+red in |- *; intro; elim n; right; symmetry in |- *; assumption.
+apply Rlt_le_trans with (Rmin x0 (b - a)).
+rewrite H4 in H9; apply H9.
+apply Rmin_l.
+elim n0; left; assumption.
+elim n; right; assumption.
+apply Rplus_lt_reg_r with (- a); do 2 rewrite (Rplus_comm (- a));
+ rewrite H4 in H9; apply Rle_lt_trans with (Rabs (x1 - a)).
+apply RRle_abs.
+apply Rlt_le_trans with (Rmin x0 (b - a)).
+assumption.
+apply Rmin_r.
+case (Rtotal_order x b); intro.
+assert (H6 : a <= x <= b).
+split; left; assumption.
+assert (H7 := H0 _ H6); unfold continuity_pt in H7; unfold continue_in in H7;
+ unfold limit1_in in H7; unfold limit_in in H7; simpl in H7;
+ unfold R_dist in H7; unfold continuity_pt in |- *;
+ unfold continue_in in |- *; unfold limit1_in in |- *;
+ unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *;
+ intros; elim (H7 _ H8); intros; elim H9; clear H9;
+ intros.
+assert (H11 : 0 < x - a).
+apply Rlt_Rminus; assumption.
+assert (H12 : 0 < b - x).
+apply Rlt_Rminus; assumption.
+exists (Rmin x0 (Rmin (x - a) (b - x))); split.
+unfold Rmin in |- *; case (Rle_dec (x - a) (b - x)); intro.
+case (Rle_dec x0 (x - a)); intro.
+assumption.
+assumption.
+case (Rle_dec x0 (b - x)); intro.
+assumption.
+assumption.
+intros; elim H13; clear H13; intros; cut (a < x1 < b).
+intro; elim H15; clear H15; intros; unfold h in |- *; case (Rle_dec x a);
+ intro.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H4)).
+case (Rle_dec x b); intro.
+case (Rle_dec x1 a); intro.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 H15)).
+case (Rle_dec x1 b); intro.
+apply H10; split.
+assumption.
+apply Rlt_le_trans with (Rmin x0 (Rmin (x - a) (b - x))).
+assumption.
+apply Rmin_l.
+elim n1; left; assumption.
+elim n0; left; assumption.
+split.
+apply Ropp_lt_cancel; apply Rplus_lt_reg_r with x;
+ apply Rle_lt_trans with (Rabs (x1 - x)).
+rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply RRle_abs.
+apply Rlt_le_trans with (Rmin x0 (Rmin (x - a) (b - x))).
+assumption.
+apply Rle_trans with (Rmin (x - a) (b - x)).
+apply Rmin_r.
+apply Rmin_l.
+apply Rplus_lt_reg_r with (- x); do 2 rewrite (Rplus_comm (- x));
+ apply Rle_lt_trans with (Rabs (x1 - x)).
+apply RRle_abs.
+apply Rlt_le_trans with (Rmin x0 (Rmin (x - a) (b - x))).
+assumption.
+apply Rle_trans with (Rmin (x - a) (b - x)); apply Rmin_r.
+elim H5; intro.
+assert (H7 : a <= b <= b).
+split; [ left; assumption | right; reflexivity ].
+assert (H8 := H0 _ H7); unfold continuity_pt in H8; unfold continue_in in H8;
+ unfold limit1_in in H8; unfold limit_in in H8; simpl in H8;
+ unfold R_dist in H8; unfold continuity_pt in |- *;
+ unfold continue_in in |- *; unfold limit1_in in |- *;
+ unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *;
+ intros; elim (H8 _ H9); intros; exists (Rmin x0 (b - a));
+ split.
+unfold Rmin in |- *; case (Rle_dec x0 (b - a)); intro.
+elim H10; intros; assumption.
+change (0 < b - a) in |- *; apply Rlt_Rminus; assumption.
+intros; elim H11; clear H11; intros _ H11; cut (a < x1).
+intro; unfold h in |- *; case (Rle_dec x a); intro.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H4)).
+case (Rle_dec x1 a); intro.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H12)).
+case (Rle_dec x b); intro.
+case (Rle_dec x1 b); intro.
+rewrite H6; elim H10; intros; elim r0; intro.
+apply H14; split.
+unfold D_x, no_cond in |- *; split.
+trivial.
+red in |- *; intro; rewrite <- H16 in H15; elim (Rlt_irrefl _ H15).
+rewrite H6 in H11; apply Rlt_le_trans with (Rmin x0 (b - a)).
+apply H11.
+apply Rmin_l.
+rewrite H15; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+ assumption.
+rewrite H6; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+ assumption.
+elim n1; right; assumption.
+rewrite H6 in H11; apply Ropp_lt_cancel; apply Rplus_lt_reg_r with b;
+ apply Rle_lt_trans with (Rabs (x1 - b)).
+rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply RRle_abs.
+apply Rlt_le_trans with (Rmin x0 (b - a)).
+assumption.
+apply Rmin_r.
+unfold continuity_pt in |- *; unfold continue_in in |- *;
+ unfold limit1_in in |- *; unfold limit_in in |- *;
+ simpl in |- *; unfold R_dist in |- *; intros; exists (x - b);
+ split.
+change (0 < x - b) in |- *; apply Rlt_Rminus; assumption.
+intros; elim H8; clear H8; intros.
+assert (H10 : b < x0).
+apply Ropp_lt_cancel; apply Rplus_lt_reg_r with x;
+ apply Rle_lt_trans with (Rabs (x0 - x)).
+rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply RRle_abs.
+assumption.
+unfold h in |- *; case (Rle_dec x a); intro.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H4)).
+case (Rle_dec x b); intro.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H6)).
+case (Rle_dec x0 a); intro.
+elim (Rlt_irrefl _ (Rlt_trans _ _ _ H1 (Rlt_le_trans _ _ _ H10 r))).
+case (Rle_dec x0 b); intro.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H10)).
+unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption.
+intros; elim H3; intros; unfold h in |- *; case (Rle_dec c a); intro.
+elim r; intro.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 H6)).
+rewrite H6; reflexivity.
+case (Rle_dec c b); intro.
+reflexivity.
+elim n0; assumption.
+exists (fun _:R => f0 a); split.
+apply derivable_continuous; apply (derivable_const (f0 a)).
+intros; elim H2; intros; rewrite H1 in H3; cut (b = c).
+intro; rewrite <- H5; rewrite H1; reflexivity.
+apply Rle_antisym; assumption.
Qed.
(**********)
-Lemma continuity_ab_maj : (f:R->R;a,b:R) ``a<=b`` -> ((c:R)``a<=c<=b``->(continuity_pt f c)) -> (EXT Mx : R | ((c:R)``a<=c<=b``->``(f c)<=(f Mx)``)/\``a<=Mx<=b``).
-Intros; Cut (EXT g:R->R | (continuity g)/\((c:R)``a<=c<=b``->(g c)==(f0 c))).
-Intro HypProl.
-Elim HypProl; Intros g Hcont_eq.
-Elim Hcont_eq; Clear Hcont_eq; Intros Hcont Heq.
-Assert H1 := (compact_P3 a b).
-Assert H2 := (continuity_compact g [c:R]``a<=c<=b`` Hcont H1).
-Assert H3 := (compact_P2 ? H2).
-Assert H4 := (compact_P1 ? H2).
-Cut (bound (image_dir g [c:R]``a <= c <= b``)).
-Cut (ExT [x:R] ((image_dir g [c:R]``a <= c <= b``) x)).
-Intros; Assert H7 := (complet ? H6 H5).
-Elim H7; Clear H7; Intros M H7; Cut (image_dir g [c:R]``a <= c <= b`` M).
-Intro; Unfold image_dir in H8; Elim H8; Clear H8; Intros Mxx H8; Elim H8; Clear H8; Intros; Exists Mxx; Split.
-Intros; Rewrite <- (Heq c H10); Rewrite <- (Heq Mxx H9); Intros; Rewrite <- H8; Unfold is_lub in H7; Elim H7; Clear H7; Intros H7 _; Unfold is_upper_bound in H7; Apply H7; Unfold image_dir; Exists c; Split; [Reflexivity | Apply H10].
-Apply H9.
-Elim (classic (image_dir g [c:R]``a <= c <= b`` M)); Intro.
-Assumption.
-Cut (EXT eps:posreal | (y:R)~(intersection_domain (disc M eps) (image_dir g [c:R]``a <= c <= b``) y)).
-Intro; Elim H9; Clear H9; Intros eps H9; Unfold is_lub in H7; Elim H7; Clear H7; Intros; Cut (is_upper_bound (image_dir g [c:R]``a <= c <= b``) ``M-eps``).
-Intro; Assert H12 := (H10 ? H11); Cut ``M-eps<M``.
-Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H12 H13)).
-Pattern 2 M; Rewrite <- Rplus_Or; Unfold Rminus; Apply Rlt_compatibility; Apply Ropp_Rlt; Rewrite Ropp_O; Rewrite Ropp_Ropp; Apply (cond_pos eps).
-Unfold is_upper_bound image_dir; Intros; Cut ``x<=M``.
-Intro; Case (total_order_Rle x ``M-eps``); Intro.
-Apply r.
-Elim (H9 x); Unfold intersection_domain disc image_dir; Split.
-Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Rewrite Rabsolu_right.
-Apply Rlt_anti_compatibility with ``x-eps``; Replace ``x-eps+(M-x)`` with ``M-eps``.
-Replace ``x-eps+eps`` with x.
-Auto with real.
-Ring.
-Ring.
-Apply Rge_minus; Apply Rle_sym1; Apply H12.
-Apply H11.
-Apply H7; Apply H11.
-Cut (EXT V:R->Prop | (neighbourhood V M)/\((y:R)~(intersection_domain V (image_dir g [c:R]``a <= c <= b``) y))).
-Intro; Elim H9; Intros V H10; Elim H10; Clear H10; Intros.
-Unfold neighbourhood in H10; Elim H10; Intros del H12; Exists del; Intros; Red; Intro; Elim (H11 y).
-Unfold intersection_domain; Unfold intersection_domain in H13; Elim H13; Clear H13; Intros; Split.
-Apply (H12 ? H13).
-Apply H14.
-Cut ~(point_adherent (image_dir g [c:R]``a <= c <= b``) M).
-Intro; Unfold point_adherent in H9.
-Assert H10 := (not_all_ex_not ? [V:R->Prop](neighbourhood V M)
- ->(EXT y:R |
- (intersection_domain V
- (image_dir g [c:R]``a <= c <= b``) y)) H9).
-Elim H10; Intros V0 H11; Exists V0; Assert H12 := (imply_to_and ? ? H11); Elim H12; Clear H12; Intros.
-Split.
-Apply H12.
-Apply (not_ex_all_not ? ? H13).
-Red; Intro; Cut (adherence (image_dir g [c:R]``a <= c <= b``) M).
-Intro; Elim (closed_set_P1 (image_dir g [c:R]``a <= c <= b``)); Intros H11 _; Assert H12 := (H11 H3).
-Elim H8.
-Unfold eq_Dom in H12; Elim H12; Clear H12; Intros.
-Apply (H13 ? H10).
-Apply H9.
-Exists (g a); Unfold image_dir; Exists a; Split.
-Reflexivity.
-Split; [Right; Reflexivity | Apply H].
-Unfold bound; Unfold bounded in H4; Elim H4; Clear H4; Intros m H4; Elim H4; Clear H4; Intros M H4; Exists M; Unfold is_upper_bound; Intros; Elim (H4 ? H5); Intros _ H6; Apply H6.
-Apply prolongement_C0; Assumption.
+Lemma continuity_ab_maj :
+ forall (f:R -> R) (a b:R),
+ a <= b ->
+ (forall c:R, a <= c <= b -> continuity_pt f c) ->
+ exists Mx : R | (forall c:R, a <= c <= b -> f c <= f Mx) /\ a <= Mx <= b.
+intros;
+ cut
+ ( exists g : R -> R
+ | continuity g /\ (forall c:R, a <= c <= b -> g c = f0 c)).
+intro HypProl.
+elim HypProl; intros g Hcont_eq.
+elim Hcont_eq; clear Hcont_eq; intros Hcont Heq.
+assert (H1 := compact_P3 a b).
+assert (H2 := continuity_compact g (fun c:R => a <= c <= b) Hcont H1).
+assert (H3 := compact_P2 _ H2).
+assert (H4 := compact_P1 _ H2).
+cut (bound (image_dir g (fun c:R => a <= c <= b))).
+cut ( exists x : R | image_dir g (fun c:R => a <= c <= b) x).
+intros; assert (H7 := completeness _ H6 H5).
+elim H7; clear H7; intros M H7; cut (image_dir g (fun c:R => a <= c <= b) M).
+intro; unfold image_dir in H8; elim H8; clear H8; intros Mxx H8; elim H8;
+ clear H8; intros; exists Mxx; split.
+intros; rewrite <- (Heq c H10); rewrite <- (Heq Mxx H9); intros;
+ rewrite <- H8; unfold is_lub in H7; elim H7; clear H7;
+ intros H7 _; unfold is_upper_bound in H7; apply H7;
+ unfold image_dir in |- *; exists c; split; [ reflexivity | apply H10 ].
+apply H9.
+elim (classic (image_dir g (fun c:R => a <= c <= b) M)); intro.
+assumption.
+cut
+ ( exists eps : posreal
+ | (forall y:R,
+ ~
+ intersection_domain (disc M eps)
+ (image_dir g (fun c:R => a <= c <= b)) y)).
+intro; elim H9; clear H9; intros eps H9; unfold is_lub in H7; elim H7;
+ clear H7; intros;
+ cut (is_upper_bound (image_dir g (fun c:R => a <= c <= b)) (M - eps)).
+intro; assert (H12 := H10 _ H11); cut (M - eps < M).
+intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H12 H13)).
+pattern M at 2 in |- *; rewrite <- Rplus_0_r; unfold Rminus in |- *;
+ apply Rplus_lt_compat_l; apply Ropp_lt_cancel; rewrite Ropp_0;
+ rewrite Ropp_involutive; apply (cond_pos eps).
+unfold is_upper_bound, image_dir in |- *; intros; cut (x <= M).
+intro; case (Rle_dec x (M - eps)); intro.
+apply r.
+elim (H9 x); unfold intersection_domain, disc, image_dir in |- *; split.
+rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; rewrite Rabs_right.
+apply Rplus_lt_reg_r with (x - eps);
+ replace (x - eps + (M - x)) with (M - eps).
+replace (x - eps + eps) with x.
+auto with real.
+ring.
+ring.
+apply Rge_minus; apply Rle_ge; apply H12.
+apply H11.
+apply H7; apply H11.
+cut
+ ( exists V : R -> Prop
+ | neighbourhood V M /\
+ (forall y:R,
+ ~ intersection_domain V (image_dir g (fun c:R => a <= c <= b)) y)).
+intro; elim H9; intros V H10; elim H10; clear H10; intros.
+unfold neighbourhood in H10; elim H10; intros del H12; exists del; intros;
+ red in |- *; intro; elim (H11 y).
+unfold intersection_domain in |- *; unfold intersection_domain in H13;
+ elim H13; clear H13; intros; split.
+apply (H12 _ H13).
+apply H14.
+cut (~ point_adherent (image_dir g (fun c:R => a <= c <= b)) M).
+intro; unfold point_adherent in H9.
+assert
+ (H10 :=
+ not_all_ex_not _
+ (fun V:R -> Prop =>
+ neighbourhood V M ->
+ exists y : R
+ | intersection_domain V (image_dir g (fun c:R => a <= c <= b)) y) H9).
+elim H10; intros V0 H11; exists V0; assert (H12 := imply_to_and _ _ H11);
+ elim H12; clear H12; intros.
+split.
+apply H12.
+apply (not_ex_all_not _ _ H13).
+red in |- *; intro; cut (adherence (image_dir g (fun c:R => a <= c <= b)) M).
+intro; elim (closed_set_P1 (image_dir g (fun c:R => a <= c <= b)));
+ intros H11 _; assert (H12 := H11 H3).
+elim H8.
+unfold eq_Dom in H12; elim H12; clear H12; intros.
+apply (H13 _ H10).
+apply H9.
+exists (g a); unfold image_dir in |- *; exists a; split.
+reflexivity.
+split; [ right; reflexivity | apply H ].
+unfold bound in |- *; unfold bounded in H4; elim H4; clear H4; intros m H4;
+ elim H4; clear H4; intros M H4; exists M; unfold is_upper_bound in |- *;
+ intros; elim (H4 _ H5); intros _ H6; apply H6.
+apply prolongement_C0; assumption.
Qed.
(**********)
-Lemma continuity_ab_min : (f:(R->R); a,b:R) ``a <= b``->((c:R)``a<=c<=b``->(continuity_pt f c))->(EXT mx:R | ((c:R)``a <= c <= b``->``(f mx) <= (f c)``)/\``a <= mx <= b``).
-Intros.
-Cut ((c:R)``a<=c<=b``->(continuity_pt (opp_fct f0) c)).
-Intro; Assert H2 := (continuity_ab_maj (opp_fct f0) a b H H1); Elim H2; Intros x0 H3; Exists x0; Intros; Split.
-Intros; Rewrite <- (Ropp_Ropp (f0 x0)); Rewrite <- (Ropp_Ropp (f0 c)); Apply Rle_Ropp1; Elim H3; Intros; Unfold opp_fct in H5; Apply H5; Apply H4.
-Elim H3; Intros; Assumption.
-Intros.
-Assert H2 := (H0 ? H1).
-Apply (continuity_pt_opp ? ? H2).
+Lemma continuity_ab_min :
+ forall (f:R -> R) (a b:R),
+ a <= b ->
+ (forall c:R, a <= c <= b -> continuity_pt f c) ->
+ exists mx : R | (forall c:R, a <= c <= b -> f mx <= f c) /\ a <= mx <= b.
+intros.
+cut (forall c:R, a <= c <= b -> continuity_pt (- f0) c).
+intro; assert (H2 := continuity_ab_maj (- f0)%F a b H H1); elim H2;
+ intros x0 H3; exists x0; intros; split.
+intros; rewrite <- (Ropp_involutive (f0 x0));
+ rewrite <- (Ropp_involutive (f0 c)); apply Ropp_le_contravar;
+ elim H3; intros; unfold opp_fct in H5; apply H5; apply H4.
+elim H3; intros; assumption.
+intros.
+assert (H2 := H0 _ H1).
+apply (continuity_pt_opp _ _ H2).
Qed.
@@ -888,291 +1272,554 @@ Qed.
(* Proof of Bolzano-Weierstrass theorem *)
(********************************************************)
-Definition ValAdh [un:nat->R;x:R] : Prop := (V:R->Prop;N:nat) (neighbourhood V x) -> (EX p:nat | (le N p)/\(V (un p))).
-
-Definition intersection_family [f:family] : R->Prop := [x:R](y:R)(ind f y)->(f y x).
-
-Lemma ValAdh_un_exists : (un:nat->R) let D=[x:R](EX n:nat | x==(INR n)) in let f=[x:R](adherence [y:R](EX p:nat | y==(un p)/\``x<=(INR p)``)/\(D x)) in ((x:R)(EXT y:R | (f x y))->(D x)).
-Intros; Elim H; Intros; Unfold f in H0; Unfold adherence in H0; Unfold point_adherent in H0; Assert H1 : (neighbourhood (disc x0 (mkposreal ? Rlt_R0_R1)) x0).
-Unfold neighbourhood disc; Exists (mkposreal ? Rlt_R0_R1); Unfold included; Trivial.
-Elim (H0 ? H1); Intros; Unfold intersection_domain in H2; Elim H2; Intros; Elim H4; Intros; Apply H6.
+Definition ValAdh (un:nat -> R) (x:R) : Prop :=
+ forall (V:R -> Prop) (N:nat),
+ neighbourhood V x -> exists p : nat | (N <= p)%nat /\ V (un p).
+
+Definition intersection_family (f:family) (x:R) : Prop :=
+ forall y:R, ind f y -> f y x.
+
+Lemma ValAdh_un_exists :
+ forall (un:nat -> R) (D:=fun x:R => exists n : nat | x = INR n)
+ (f:=
+ fun x:R =>
+ adherence
+ (fun y:R => ( exists p : nat | y = un p /\ x <= INR p) /\ D x))
+ (x:R), ( exists y : R | f x y) -> D x.
+intros; elim H; intros; unfold f in H0; unfold adherence in H0;
+ unfold point_adherent in H0;
+ assert (H1 : neighbourhood (disc x0 (mkposreal _ Rlt_0_1)) x0).
+unfold neighbourhood, disc in |- *; exists (mkposreal _ Rlt_0_1);
+ unfold included in |- *; trivial.
+elim (H0 _ H1); intros; unfold intersection_domain in H2; elim H2; intros;
+ elim H4; intros; apply H6.
Qed.
-Definition ValAdh_un [un:nat->R] : R->Prop := let D=[x:R](EX n:nat | x==(INR n)) in let f=[x:R](adherence [y:R](EX p:nat | y==(un p)/\``x<=(INR p)``)/\(D x)) in (intersection_family (mkfamily D f (ValAdh_un_exists un))).
-
-Lemma ValAdh_un_prop : (un:nat->R;x:R) (ValAdh un x) <-> (ValAdh_un un x).
-Intros; Split; Intro.
-Unfold ValAdh in H; Unfold ValAdh_un; Unfold intersection_family; Simpl; Intros; Elim H0; Intros N H1; Unfold adherence; Unfold point_adherent; Intros; Elim (H V N H2); Intros; Exists (un x0); Unfold intersection_domain; Elim H3; Clear H3; Intros; Split.
-Assumption.
-Split.
-Exists x0; Split; [Reflexivity | Rewrite H1; Apply (le_INR ? ? H3)].
-Exists N; Assumption.
-Unfold ValAdh; Intros; Unfold ValAdh_un in H; Unfold intersection_family in H; Simpl in H; Assert H1 : (adherence [y0:R](EX p:nat | ``y0 == (un p)``/\``(INR N) <= (INR p)``)/\(EX n:nat | ``(INR N) == (INR n)``) x).
-Apply H; Exists N; Reflexivity.
-Unfold adherence in H1; Unfold point_adherent in H1; Assert H2 := (H1 ? H0); Elim H2; Intros; Unfold intersection_domain in H3; Elim H3; Clear H3; Intros; Elim H4; Clear H4; Intros; Elim H4; Clear H4; Intros; Elim H4; Clear H4; Intros; Exists x1; Split.
-Apply (INR_le ? ? H6).
-Rewrite H4 in H3; Apply H3.
+Definition ValAdh_un (un:nat -> R) : R -> Prop :=
+ let D := fun x:R => exists n : nat | x = INR n in
+ let f :=
+ fun x:R =>
+ adherence
+ (fun y:R => ( exists p : nat | y = un p /\ x <= INR p) /\ D x) in
+ intersection_family (mkfamily D f (ValAdh_un_exists un)).
+
+Lemma ValAdh_un_prop :
+ forall (un:nat -> R) (x:R), ValAdh un x <-> ValAdh_un un x.
+intros; split; intro.
+unfold ValAdh in H; unfold ValAdh_un in |- *;
+ unfold intersection_family in |- *; simpl in |- *;
+ intros; elim H0; intros N H1; unfold adherence in |- *;
+ unfold point_adherent in |- *; intros; elim (H V N H2);
+ intros; exists (un x0); unfold intersection_domain in |- *;
+ elim H3; clear H3; intros; split.
+assumption.
+split.
+exists x0; split; [ reflexivity | rewrite H1; apply (le_INR _ _ H3) ].
+exists N; assumption.
+unfold ValAdh in |- *; intros; unfold ValAdh_un in H;
+ unfold intersection_family in H; simpl in H;
+ assert
+ (H1 :
+ adherence
+ (fun y0:R =>
+ ( exists p : nat | y0 = un p /\ INR N <= INR p) /\
+ ( exists n : nat | INR N = INR n)) x).
+apply H; exists N; reflexivity.
+unfold adherence in H1; unfold point_adherent in H1; assert (H2 := H1 _ H0);
+ elim H2; intros; unfold intersection_domain in H3;
+ elim H3; clear H3; intros; elim H4; clear H4; intros;
+ elim H4; clear H4; intros; elim H4; clear H4; intros;
+ exists x1; split.
+apply (INR_le _ _ H6).
+rewrite H4 in H3; apply H3.
Qed.
-Lemma adherence_P4 : (F,G:R->Prop) (included F G) -> (included (adherence F) (adherence G)).
-Unfold adherence included; Unfold point_adherent; Intros; Elim (H0 ? H1); Unfold intersection_domain; Intros; Elim H2; Clear H2; Intros; Exists x0; Split; [Assumption | Apply (H ? H3)].
+Lemma adherence_P4 :
+ forall F G:R -> Prop, included F G -> included (adherence F) (adherence G).
+unfold adherence, included in |- *; unfold point_adherent in |- *; intros;
+ elim (H0 _ H1); unfold intersection_domain in |- *;
+ intros; elim H2; clear H2; intros; exists x0; split;
+ [ assumption | apply (H _ H3) ].
Qed.
-Definition family_closed_set [f:family] : Prop := (x:R) (closed_set (f x)).
+Definition family_closed_set (f:family) : Prop :=
+ forall x:R, closed_set (f x).
-Definition intersection_vide_in [D:R->Prop;f:family] : Prop := ((x:R)((ind f x)->(included (f x) D))/\~(EXT y:R | (intersection_family f y))).
+Definition intersection_vide_in (D:R -> Prop) (f:family) : Prop :=
+ forall x:R,
+ (ind f x -> included (f x) D) /\
+ ~ ( exists y : R | intersection_family f y).
-Definition intersection_vide_finite_in [D:R->Prop;f:family] : Prop := (intersection_vide_in D f)/\(family_finite f).
+Definition intersection_vide_finite_in (D:R -> Prop)
+ (f:family) : Prop := intersection_vide_in D f /\ family_finite f.
(**********)
-Lemma compact_P6 : (X:R->Prop) (compact X) -> (EXT z:R | (X z)) -> ((g:family) (family_closed_set g) -> (intersection_vide_in X g) -> (EXT D:R->Prop | (intersection_vide_finite_in X (subfamily g D)))).
-Intros X H Hyp g H0 H1.
-Pose D' := (ind g).
-Pose f' := [x:R][y:R](complementary (g x) y)/\(D' x).
-Assert H2 : (x:R)(EXT y:R|(f' x y))->(D' x).
-Intros; Elim H2; Intros; Unfold f' in H3; Elim H3; Intros; Assumption.
-Pose f0 := (mkfamily D' f' H2).
-Unfold compact in H; Assert H3 : (covering_open_set X f0).
-Unfold covering_open_set; Split.
-Unfold covering; Intros; Unfold intersection_vide_in in H1; Elim (H1 x); Intros; Unfold intersection_family in H5; Assert H6 := (not_ex_all_not ? [y:R](y0:R)(ind g y0)->(g y0 y) H5 x); Assert H7 := (not_all_ex_not ? [y0:R](ind g y0)->(g y0 x) H6); Elim H7; Intros; Exists x0; Elim (imply_to_and ? ? H8); Intros; Unfold f0; Simpl; Unfold f'; Split; [Apply H10 | Apply H9].
-Unfold family_open_set; Intro; Elim (classic (D' x)); Intro.
-Apply open_set_P6 with (complementary (g x)).
-Unfold family_closed_set in H0; Unfold closed_set in H0; Apply H0.
-Unfold f0; Simpl; Unfold f'; Unfold eq_Dom; Split.
-Unfold included; Intros; Split; [Apply H4 | Apply H3].
-Unfold included; Intros; Elim H4; Intros; Assumption.
-Apply open_set_P6 with [_:R]False.
-Apply open_set_P4.
-Unfold eq_Dom; Unfold included; Split; Intros; [Elim H4 | Simpl in H4; Unfold f' in H4; Elim H4; Intros; Elim H3; Assumption].
-Elim (H ? H3); Intros SF H4; Exists SF; Unfold intersection_vide_finite_in; Split.
-Unfold intersection_vide_in; Simpl; Intros; Split.
-Intros; Unfold included; Intros; Unfold intersection_vide_in in H1; Elim (H1 x); Intros; Elim H6; Intros; Apply H7.
-Unfold intersection_domain in H5; Elim H5; Intros; Assumption.
-Assumption.
-Elim (classic (EXT y:R | (intersection_domain (ind g) SF y))); Intro Hyp'.
-Red; Intro; Elim H5; Intros; Unfold intersection_family in H6; Simpl in H6.
-Cut (X x0).
-Intro; Unfold covering_finite in H4; Elim H4; Clear H4; Intros H4 _; Unfold covering in H4; Elim (H4 x0 H7); Intros; Simpl in H8; Unfold intersection_domain in H6; Cut (ind g x1)/\(SF x1).
-Intro; Assert H10 := (H6 x1 H9); Elim H10; Clear H10; Intros H10 _; Elim H8; Clear H8; Intros H8 _; Unfold f' in H8; Unfold complementary in H8; Elim H8; Clear H8; Intros H8 _; Elim H8; Assumption.
-Split.
-Apply (cond_fam f0).
-Exists x0; Elim H8; Intros; Assumption.
-Elim H8; Intros; Assumption.
-Unfold intersection_vide_in in H1; Elim Hyp'; Intros; Assert H8 := (H6 ? H7); Elim H8; Intros; Cut (ind g x1).
-Intro; Elim (H1 x1); Intros; Apply H12.
-Apply H11.
-Apply H9.
-Apply (cond_fam g); Exists x0; Assumption.
-Unfold covering_finite in H4; Elim H4; Clear H4; Intros H4 _; Cut (EXT z:R | (X z)).
-Intro; Elim H5; Clear H5; Intros; Unfold covering in H4; Elim (H4 x0 H5); Intros; Simpl in H6; Elim Hyp'; Exists x1; Elim H6; Intros; Unfold intersection_domain; Split.
-Apply (cond_fam f0); Exists x0; Apply H7.
-Apply H8.
-Apply Hyp.
-Unfold covering_finite in H4; Elim H4; Clear H4; Intros; Unfold family_finite in H5; Unfold domain_finite in H5; Unfold family_finite; Unfold domain_finite; Elim H5; Clear H5; Intros l H5; Exists l; Intro; Elim (H5 x); Intros; Split; Intro; [Apply H6; Simpl; Simpl in H8; Apply H8 | Apply (H7 H8)].
+Lemma compact_P6 :
+ forall X:R -> Prop,
+ compact X ->
+ ( exists z : R | X z) ->
+ forall g:family,
+ family_closed_set g ->
+ intersection_vide_in X g ->
+ exists D : R -> Prop | intersection_vide_finite_in X (subfamily g D).
+intros X H Hyp g H0 H1.
+pose (D' := ind g).
+pose (f' := fun x y:R => complementary (g x) y /\ D' x).
+assert (H2 : forall x:R, ( exists y : R | f' x y) -> D' x).
+intros; elim H2; intros; unfold f' in H3; elim H3; intros; assumption.
+pose (f0 := mkfamily D' f' H2).
+unfold compact in H; assert (H3 : covering_open_set X f0).
+unfold covering_open_set in |- *; split.
+unfold covering in |- *; intros; unfold intersection_vide_in in H1;
+ elim (H1 x); intros; unfold intersection_family in H5;
+ assert
+ (H6 := not_ex_all_not _ (fun y:R => forall y0:R, ind g y0 -> g y0 y) H5 x);
+ assert (H7 := not_all_ex_not _ (fun y0:R => ind g y0 -> g y0 x) H6);
+ elim H7; intros; exists x0; elim (imply_to_and _ _ H8);
+ intros; unfold f0 in |- *; simpl in |- *; unfold f' in |- *;
+ split; [ apply H10 | apply H9 ].
+unfold family_open_set in |- *; intro; elim (classic (D' x)); intro.
+apply open_set_P6 with (complementary (g x)).
+unfold family_closed_set in H0; unfold closed_set in H0; apply H0.
+unfold f0 in |- *; simpl in |- *; unfold f' in |- *; unfold eq_Dom in |- *;
+ split.
+unfold included in |- *; intros; split; [ apply H4 | apply H3 ].
+unfold included in |- *; intros; elim H4; intros; assumption.
+apply open_set_P6 with (fun _:R => False).
+apply open_set_P4.
+unfold eq_Dom in |- *; unfold included in |- *; split; intros;
+ [ elim H4
+ | simpl in H4; unfold f' in H4; elim H4; intros; elim H3; assumption ].
+elim (H _ H3); intros SF H4; exists SF;
+ unfold intersection_vide_finite_in in |- *; split.
+unfold intersection_vide_in in |- *; simpl in |- *; intros; split.
+intros; unfold included in |- *; intros; unfold intersection_vide_in in H1;
+ elim (H1 x); intros; elim H6; intros; apply H7.
+unfold intersection_domain in H5; elim H5; intros; assumption.
+assumption.
+elim (classic ( exists y : R | intersection_domain (ind g) SF y)); intro Hyp'.
+red in |- *; intro; elim H5; intros; unfold intersection_family in H6;
+ simpl in H6.
+cut (X x0).
+intro; unfold covering_finite in H4; elim H4; clear H4; intros H4 _;
+ unfold covering in H4; elim (H4 x0 H7); intros; simpl in H8;
+ unfold intersection_domain in H6; cut (ind g x1 /\ SF x1).
+intro; assert (H10 := H6 x1 H9); elim H10; clear H10; intros H10 _; elim H8;
+ clear H8; intros H8 _; unfold f' in H8; unfold complementary in H8;
+ elim H8; clear H8; intros H8 _; elim H8; assumption.
+split.
+apply (cond_fam f0).
+exists x0; elim H8; intros; assumption.
+elim H8; intros; assumption.
+unfold intersection_vide_in in H1; elim Hyp'; intros; assert (H8 := H6 _ H7);
+ elim H8; intros; cut (ind g x1).
+intro; elim (H1 x1); intros; apply H12.
+apply H11.
+apply H9.
+apply (cond_fam g); exists x0; assumption.
+unfold covering_finite in H4; elim H4; clear H4; intros H4 _;
+ cut ( exists z : R | X z).
+intro; elim H5; clear H5; intros; unfold covering in H4; elim (H4 x0 H5);
+ intros; simpl in H6; elim Hyp'; exists x1; elim H6;
+ intros; unfold intersection_domain in |- *; split.
+apply (cond_fam f0); exists x0; apply H7.
+apply H8.
+apply Hyp.
+unfold covering_finite in H4; elim H4; clear H4; intros;
+ unfold family_finite in H5; unfold domain_finite in H5;
+ unfold family_finite in |- *; unfold domain_finite in |- *;
+ elim H5; clear H5; intros l H5; exists l; intro; elim (H5 x);
+ intros; split; intro;
+ [ apply H6; simpl in |- *; simpl in H8; apply H8 | apply (H7 H8) ].
Qed.
-Theorem Bolzano_Weierstrass : (un:nat->R;X:R->Prop) (compact X) -> ((n:nat)(X (un n))) -> (EXT l:R | (ValAdh un l)).
-Intros; Cut (EXT l:R | (ValAdh_un un l)).
-Intro; Elim H1; Intros; Exists x; Elim (ValAdh_un_prop un x); Intros; Apply (H4 H2).
-Assert H1 : (EXT z:R | (X z)).
-Exists (un O); Apply H0.
-Pose D:=[x:R](EX n:nat | x==(INR n)).
-Pose g:=[x:R](adherence [y:R](EX p:nat | y==(un p)/\``x<=(INR p)``)/\(D x)).
-Assert H2 : (x:R)(EXT y:R | (g x y))->(D x).
-Intros; Elim H2; Intros; Unfold g in H3; Unfold adherence in H3; Unfold point_adherent in H3.
-Assert H4 : (neighbourhood (disc x0 (mkposreal ? Rlt_R0_R1)) x0).
-Unfold neighbourhood; Exists (mkposreal ? Rlt_R0_R1); Unfold included; Trivial.
-Elim (H3 ? H4); Intros; Unfold intersection_domain in H5; Decompose [and] H5; Assumption.
-Pose f0 := (mkfamily D g H2).
-Assert H3 := (compact_P6 X H H1 f0).
-Elim (classic (EXT l:R | (ValAdh_un un l))); Intro.
-Assumption.
-Cut (family_closed_set f0).
-Intro; Cut (intersection_vide_in X f0).
-Intro; Assert H7 := (H3 H5 H6).
-Elim H7; Intros SF H8; Unfold intersection_vide_finite_in in H8; Elim H8; Clear H8; Intros; Unfold intersection_vide_in in H8; Elim (H8 R0); Intros _ H10; Elim H10; Unfold family_finite in H9; Unfold domain_finite in H9; Elim H9; Clear H9; Intros l H9; Pose r := (MaxRlist l); Cut (D r).
-Intro; Unfold D in H11; Elim H11; Intros; Exists (un x); Unfold intersection_family; Simpl; Unfold intersection_domain; Intros; Split.
-Unfold g; Apply adherence_P1; Split.
-Exists x; Split; [Reflexivity | Rewrite <- H12; Unfold r; Apply MaxRlist_P1; Elim (H9 y); Intros; Apply H14; Simpl; Apply H13].
-Elim H13; Intros; Assumption.
-Elim H13; Intros; Assumption.
-Elim (H9 r); Intros.
-Simpl in H12; Unfold intersection_domain in H12; Cut (In r l).
-Intro; Elim (H12 H13); Intros; Assumption.
-Unfold r; Apply MaxRlist_P2; Cut (EXT z:R | (intersection_domain (ind f0) SF z)).
-Intro; Elim H13; Intros; Elim (H9 x); Intros; Simpl in H15; Assert H17 := (H15 H14); Exists x; Apply H17.
-Elim (classic (EXT z:R | (intersection_domain (ind f0) SF z))); Intro.
-Assumption.
-Elim (H8 R0); Intros _ H14; Elim H1; Intros; Assert H16 := (not_ex_all_not ? [y:R](intersection_family (subfamily f0 SF) y) H14); Assert H17 := (not_ex_all_not ? [z:R](intersection_domain (ind f0) SF z) H13); Assert H18 := (H16 x); Unfold intersection_family in H18; Simpl in H18; Assert H19 := (not_all_ex_not ? [y:R](intersection_domain D SF y)->(g y x)/\(SF y) H18); Elim H19; Intros; Assert H21 := (imply_to_and ? ? H20); Elim (H17 x0); Elim H21; Intros; Assumption.
-Unfold intersection_vide_in; Intros; Split.
-Intro; Simpl in H6; Unfold f0; Simpl; Unfold g; Apply included_trans with (adherence X).
-Apply adherence_P4.
-Unfold included; Intros; Elim H7; Intros; Elim H8; Intros; Elim H10; Intros; Rewrite H11; Apply H0.
-Apply adherence_P2; Apply compact_P2; Assumption.
-Apply H4.
-Unfold family_closed_set; Unfold f0; Simpl; Unfold g; Intro; Apply adherence_P3.
+Theorem Bolzano_Weierstrass :
+ forall (un:nat -> R) (X:R -> Prop),
+ compact X -> (forall n:nat, X (un n)) -> exists l : R | ValAdh un l.
+intros; cut ( exists l : R | ValAdh_un un l).
+intro; elim H1; intros; exists x; elim (ValAdh_un_prop un x); intros;
+ apply (H4 H2).
+assert (H1 : exists z : R | X z).
+exists (un 0%nat); apply H0.
+pose (D := fun x:R => exists n : nat | x = INR n).
+pose
+ (g :=
+ fun x:R =>
+ adherence (fun y:R => ( exists p : nat | y = un p /\ x <= INR p) /\ D x)).
+assert (H2 : forall x:R, ( exists y : R | g x y) -> D x).
+intros; elim H2; intros; unfold g in H3; unfold adherence in H3;
+ unfold point_adherent in H3.
+assert (H4 : neighbourhood (disc x0 (mkposreal _ Rlt_0_1)) x0).
+unfold neighbourhood in |- *; exists (mkposreal _ Rlt_0_1);
+ unfold included in |- *; trivial.
+elim (H3 _ H4); intros; unfold intersection_domain in H5; decompose [and] H5;
+ assumption.
+pose (f0 := mkfamily D g H2).
+assert (H3 := compact_P6 X H H1 f0).
+elim (classic ( exists l : R | ValAdh_un un l)); intro.
+assumption.
+cut (family_closed_set f0).
+intro; cut (intersection_vide_in X f0).
+intro; assert (H7 := H3 H5 H6).
+elim H7; intros SF H8; unfold intersection_vide_finite_in in H8; elim H8;
+ clear H8; intros; unfold intersection_vide_in in H8;
+ elim (H8 0); intros _ H10; elim H10; unfold family_finite in H9;
+ unfold domain_finite in H9; elim H9; clear H9; intros l H9;
+ pose (r := MaxRlist l); cut (D r).
+intro; unfold D in H11; elim H11; intros; exists (un x);
+ unfold intersection_family in |- *; simpl in |- *;
+ unfold intersection_domain in |- *; intros; split.
+unfold g in |- *; apply adherence_P1; split.
+exists x; split;
+ [ reflexivity
+ | rewrite <- H12; unfold r in |- *; apply MaxRlist_P1; elim (H9 y); intros;
+ apply H14; simpl in |- *; apply H13 ].
+elim H13; intros; assumption.
+elim H13; intros; assumption.
+elim (H9 r); intros.
+simpl in H12; unfold intersection_domain in H12; cut (In r l).
+intro; elim (H12 H13); intros; assumption.
+unfold r in |- *; apply MaxRlist_P2;
+ cut ( exists z : R | intersection_domain (ind f0) SF z).
+intro; elim H13; intros; elim (H9 x); intros; simpl in H15;
+ assert (H17 := H15 H14); exists x; apply H17.
+elim (classic ( exists z : R | intersection_domain (ind f0) SF z)); intro.
+assumption.
+elim (H8 0); intros _ H14; elim H1; intros;
+ assert
+ (H16 :=
+ not_ex_all_not _ (fun y:R => intersection_family (subfamily f0 SF) y) H14);
+ assert
+ (H17 :=
+ not_ex_all_not _ (fun z:R => intersection_domain (ind f0) SF z) H13);
+ assert (H18 := H16 x); unfold intersection_family in H18;
+ simpl in H18;
+ assert
+ (H19 :=
+ not_all_ex_not _ (fun y:R => intersection_domain D SF y -> g y x /\ SF y)
+ H18); elim H19; intros; assert (H21 := imply_to_and _ _ H20);
+ elim (H17 x0); elim H21; intros; assumption.
+unfold intersection_vide_in in |- *; intros; split.
+intro; simpl in H6; unfold f0 in |- *; simpl in |- *; unfold g in |- *;
+ apply included_trans with (adherence X).
+apply adherence_P4.
+unfold included in |- *; intros; elim H7; intros; elim H8; intros; elim H10;
+ intros; rewrite H11; apply H0.
+apply adherence_P2; apply compact_P2; assumption.
+apply H4.
+unfold family_closed_set in |- *; unfold f0 in |- *; simpl in |- *;
+ unfold g in |- *; intro; apply adherence_P3.
Qed.
(********************************************************)
(* Proof of Heine's theorem *)
(********************************************************)
-Definition uniform_continuity [f:R->R;X:R->Prop] : Prop := (eps:posreal)(EXT delta:posreal | (x,y:R) (X x)->(X y)->``(Rabsolu (x-y))<delta`` ->``(Rabsolu ((f x)-(f y)))<eps``).
+Definition uniform_continuity (f:R -> R) (X:R -> Prop) : Prop :=
+ forall eps:posreal,
+ exists delta : posreal
+ | (forall x y:R,
+ X x -> X y -> Rabs (x - y) < delta -> Rabs (f x - f y) < eps).
-Lemma is_lub_u : (E:R->Prop;x,y:R) (is_lub E x) -> (is_lub E y) -> x==y.
-Unfold is_lub; Intros; Elim H; Elim H0; Intros; Apply Rle_antisym; [Apply (H4 ? H1) | Apply (H2 ? H3)].
+Lemma is_lub_u :
+ forall (E:R -> Prop) (x y:R), is_lub E x -> is_lub E y -> x = y.
+unfold is_lub in |- *; intros; elim H; elim H0; intros; apply Rle_antisym;
+ [ apply (H4 _ H1) | apply (H2 _ H3) ].
Qed.
-Lemma domain_P1 : (X:R->Prop) ~(EXT y:R | (X y))\/(EXT y:R | (X y)/\((x:R)(X x)->x==y))\/(EXT x:R | (EXT y:R | (X x)/\(X y)/\``x<>y``)).
-Intro; Elim (classic (EXT y:R | (X y))); Intro.
-Right; Elim H; Intros; Elim (classic (EXT y:R | (X y)/\``y<>x``)); Intro.
-Right; Elim H1; Intros; Elim H2; Intros; Exists x; Exists x0; Intros.
-Split; [Assumption | Split; [Assumption | Apply not_sym; Assumption]].
-Left; Exists x; Split.
-Assumption.
-Intros; Case (Req_EM x0 x); Intro.
-Assumption.
-Elim H1; Exists x0; Split; Assumption.
-Left; Assumption.
+Lemma domain_P1 :
+ forall X:R -> Prop,
+ ~ ( exists y : R | X y) \/
+ ( exists y : R | X y /\ (forall x:R, X x -> x = y)) \/
+ ( exists x : R | ( exists y : R | X x /\ X y /\ x <> y)).
+intro; elim (classic ( exists y : R | X y)); intro.
+right; elim H; intros; elim (classic ( exists y : R | X y /\ y <> x)); intro.
+right; elim H1; intros; elim H2; intros; exists x; exists x0; intros.
+split;
+ [ assumption
+ | split; [ assumption | apply (sym_not_eq (A:=R)); assumption ] ].
+left; exists x; split.
+assumption.
+intros; case (Req_dec x0 x); intro.
+assumption.
+elim H1; exists x0; split; assumption.
+left; assumption.
Qed.
-Theorem Heine : (f:R->R;X:R->Prop) (compact X) -> ((x:R)(X x)->(continuity_pt f x)) -> (uniform_continuity f X).
-Intros f0 X H0 H; Elim (domain_P1 X); Intro Hyp.
+Theorem Heine :
+ forall (f:R -> R) (X:R -> Prop),
+ compact X ->
+ (forall x:R, X x -> continuity_pt f x) -> uniform_continuity f X.
+intros f0 X H0 H; elim (domain_P1 X); intro Hyp.
(* X est vide *)
-Unfold uniform_continuity; Intros; Exists (mkposreal ? Rlt_R0_R1); Intros; Elim Hyp; Exists x; Assumption.
-Elim Hyp; Clear Hyp; Intro Hyp.
+unfold uniform_continuity in |- *; intros; exists (mkposreal _ Rlt_0_1);
+ intros; elim Hyp; exists x; assumption.
+elim Hyp; clear Hyp; intro Hyp.
(* X possède un seul élément *)
-Unfold uniform_continuity; Intros; Exists (mkposreal ? Rlt_R0_R1); Intros; Elim Hyp; Clear Hyp; Intros; Elim H4; Clear H4; Intros; Assert H6 := (H5 ? H1); Assert H7 := (H5 ? H2); Rewrite H6; Rewrite H7; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply (cond_pos eps).
+unfold uniform_continuity in |- *; intros; exists (mkposreal _ Rlt_0_1);
+ intros; elim Hyp; clear Hyp; intros; elim H4; clear H4;
+ intros; assert (H6 := H5 _ H1); assert (H7 := H5 _ H2);
+ rewrite H6; rewrite H7; unfold Rminus in |- *; rewrite Rplus_opp_r;
+ rewrite Rabs_R0; apply (cond_pos eps).
(* X possède au moins deux éléments distincts *)
-Assert X_enc : (EXT m:R | (EXT M:R | ((x:R)(X x)->``m<=x<=M``)/\``m<M``)).
-Assert H1 := (compact_P1 X H0); Unfold bounded in H1; Elim H1; Intros; Elim H2; Intros; Exists x; Exists x0; Split.
-Apply H3.
-Elim Hyp; Intros; Elim H4; Intros; Decompose [and] H5; Assert H10 := (H3 ? H6); Assert H11 := (H3 ? H8); Elim H10; Intros; Elim H11; Intros; Case (total_order_T x x0); Intro.
-Elim s; Intro.
-Assumption.
-Rewrite b in H13; Rewrite b in H7; Elim H9; Apply Rle_antisym; Apply Rle_trans with x0; Assumption.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? (Rle_trans ? ? ? H13 H14) r)).
-Elim X_enc; Clear X_enc; Intros m X_enc; Elim X_enc; Clear X_enc; Intros M X_enc; Elim X_enc; Clear X_enc Hyp; Intros X_enc Hyp; Unfold uniform_continuity; Intro; Assert H1 : (t:posreal)``0<t/2``.
-Intro; Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos t) | Apply Rlt_Rinv; Sup0].
-Pose g := [x:R][y:R](X x)/\(EXT del:posreal | ((z:R) ``(Rabsolu (z-x))<del``->``(Rabsolu ((f0 z)-(f0 x)))<eps/2``)/\(is_lub [zeta:R]``0<zeta<=M-m``/\((z:R) ``(Rabsolu (z-x))<zeta``->``(Rabsolu ((f0 z)-(f0 x)))<eps/2``) del)/\(disc x (mkposreal ``del/2`` (H1 del)) y)).
-Assert H2 : (x:R)(EXT y:R | (g x y))->(X x).
-Intros; Elim H2; Intros; Unfold g in H3; Elim H3; Clear H3; Intros H3 _; Apply H3.
-Pose f' := (mkfamily X g H2); Unfold compact in H0; Assert H3 : (covering_open_set X f').
-Unfold covering_open_set; Split.
-Unfold covering; Intros; Exists x; Simpl; Unfold g; Split.
-Assumption.
-Assert H4 := (H ? H3); Unfold continuity_pt in H4; Unfold continue_in in H4; Unfold limit1_in in H4; Unfold limit_in in H4; Simpl in H4; Unfold R_dist in H4; Elim (H4 ``eps/2`` (H1 eps)); Intros; Pose E:=[zeta:R]``0<zeta <= M-m``/\((z:R)``(Rabsolu (z-x)) < zeta``->``(Rabsolu ((f0 z)-(f0 x))) < eps/2``); Assert H6 : (bound E).
-Unfold bound; Exists ``M-m``; Unfold is_upper_bound; Unfold E; Intros; Elim H6; Clear H6; Intros H6 _; Elim H6; Clear H6; Intros _ H6; Apply H6.
-Assert H7 : (EXT x:R | (E x)).
-Elim H5; Clear H5; Intros; Exists (Rmin x0 ``M-m``); Unfold E; Intros; Split.
-Split.
-Unfold Rmin; Case (total_order_Rle x0 ``M-m``); Intro.
-Apply H5.
-Apply Rlt_Rminus; Apply Hyp.
-Apply Rmin_r.
-Intros; Case (Req_EM x z); Intro.
-Rewrite H9; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply (H1 eps).
-Apply H7; Split.
-Unfold D_x no_cond; Split; [Trivial | Assumption].
-Apply Rlt_le_trans with (Rmin x0 ``M-m``); [Apply H8 | Apply Rmin_l].
-Assert H8 := (complet ? H6 H7); Elim H8; Clear H8; Intros; Cut ``0<x1<=(M-m)``.
-Intro; Elim H8; Clear H8; Intros; Exists (mkposreal ? H8); Split.
-Intros; Cut (EXT alp:R | ``(Rabsolu (z-x))<alp<=x1``/\(E alp)).
-Intros; Elim H11; Intros; Elim H12; Clear H12; Intros; Unfold E in H13; Elim H13; Intros; Apply H15.
-Elim H12; Intros; Assumption.
-Elim (classic (EXT alp:R | ``(Rabsolu (z-x)) < alp <= x1``/\(E alp))); Intro.
-Assumption.
-Assert H12 := (not_ex_all_not ? [alp:R]``(Rabsolu (z-x)) < alp <= x1``/\(E alp) H11); Unfold is_lub in p; Elim p; Intros; Cut (is_upper_bound E ``(Rabsolu (z-x))``).
-Intro; Assert H16 := (H14 ? H15); Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? H10 H16)).
-Unfold is_upper_bound; Intros; Unfold is_upper_bound in H13; Assert H16 := (H13 ? H15); Case (total_order_Rle x2 ``(Rabsolu (z-x))``); Intro.
-Assumption.
-Elim (H12 x2); Split; [Split; [Auto with real | Assumption] | Assumption].
-Split.
-Apply p.
-Unfold disc; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Simpl; Unfold Rdiv; Apply Rmult_lt_pos; [Apply H8 | Apply Rlt_Rinv; Sup0].
-Elim H7; Intros; Unfold E in H8; Elim H8; Intros H9 _; Elim H9; Intros H10 _; Unfold is_lub in p; Elim p; Intros; Unfold is_upper_bound in H12; Unfold is_upper_bound in H11; Split.
-Apply Rlt_le_trans with x2; [Assumption | Apply (H11 ? H8)].
-Apply H12; Intros; Unfold E in H13; Elim H13; Intros; Elim H14; Intros; Assumption.
-Unfold family_open_set; Intro; Simpl; Elim (classic (X x)); Intro.
-Unfold g; Unfold open_set; Intros; Elim H4; Clear H4; Intros _ H4; Elim H4; Clear H4; Intros; Elim H4; Clear H4; Intros; Unfold neighbourhood; Case (Req_EM x x0); Intro.
-Exists (mkposreal ? (H1 x1)); Rewrite <- H6; Unfold included; Intros; Split.
-Assumption.
-Exists x1; Split.
-Apply H4.
-Split.
-Elim H5; Intros; Apply H8.
-Apply H7.
-Pose d := ``x1/2-(Rabsolu (x0-x))``; Assert H7 : ``0<d``.
-Unfold d; Apply Rlt_Rminus; Elim H5; Clear H5; Intros; Unfold disc in H7; Apply H7.
-Exists (mkposreal ? H7); Unfold included; Intros; Split.
-Assumption.
-Exists x1; Split.
-Apply H4.
-Elim H5; Intros; Split.
-Assumption.
-Unfold disc in H8; Simpl in H8; Unfold disc; Simpl; Unfold disc in H10; Simpl in H10; Apply Rle_lt_trans with ``(Rabsolu (x2-x0))+(Rabsolu (x0-x))``.
-Replace ``x2-x`` with ``(x2-x0)+(x0-x)``; [Apply Rabsolu_triang | Ring].
-Replace ``x1/2`` with ``d+(Rabsolu (x0-x))``; [Idtac | Unfold d; Ring].
-Do 2 Rewrite <- (Rplus_sym ``(Rabsolu (x0-x))``); Apply Rlt_compatibility; Apply H8.
-Apply open_set_P6 with [_:R]False.
-Apply open_set_P4.
-Unfold eq_Dom; Unfold included; Intros; Split.
-Intros; Elim H4.
-Intros; Unfold g in H4; Elim H4; Clear H4; Intros H4 _; Elim H3; Apply H4.
-Elim (H0 ? H3); Intros DF H4; Unfold covering_finite in H4; Elim H4; Clear H4; Intros; Unfold family_finite in H5; Unfold domain_finite in H5; Unfold covering in H4; Simpl in H4; Simpl in H5; Elim H5; Clear H5; Intros l H5; Unfold intersection_domain in H5; Cut (x:R)(In x l)->(EXT del:R | ``0<del``/\((z:R)``(Rabsolu (z-x)) < del``->``(Rabsolu ((f0 z)-(f0 x))) < eps/2``)/\(included (g x) [z:R]``(Rabsolu (z-x))<del/2``)).
-Intros; Assert H7 := (Rlist_P1 l [x:R][del:R]``0<del``/\((z:R)``(Rabsolu (z-x)) < del``->``(Rabsolu ((f0 z)-(f0 x))) < eps/2``)/\(included (g x) [z:R]``(Rabsolu (z-x))<del/2``) H6); Elim H7; Clear H7; Intros l' H7; Elim H7; Clear H7; Intros; Pose D := (MinRlist l'); Cut ``0<D/2``.
-Intro; Exists (mkposreal ? H9); Intros; Assert H13 := (H4 ? H10); Elim H13; Clear H13; Intros xi H13; Assert H14 : (In xi l).
-Unfold g in H13; Decompose [and] H13; Elim (H5 xi); Intros; Apply H14; Split; Assumption.
-Elim (pos_Rl_P2 l xi); Intros H15 _; Elim (H15 H14); Intros i H16; Elim H16; Intros; Apply Rle_lt_trans with ``(Rabsolu ((f0 x)-(f0 xi)))+(Rabsolu ((f0 xi)-(f0 y)))``.
-Replace ``(f0 x)-(f0 y)`` with ``((f0 x)-(f0 xi))+((f0 xi)-(f0 y))``; [Apply Rabsolu_triang | Ring].
-Rewrite (double_var eps); Apply Rplus_lt.
-Assert H19 := (H8 i H17); Elim H19; Clear H19; Intros; Rewrite <- H18 in H20; Elim H20; Clear H20; Intros; Apply H20; Unfold included in H21; Apply Rlt_trans with ``(pos_Rl l' i)/2``.
-Apply H21.
-Elim H13; Clear H13; Intros; Assumption.
-Unfold Rdiv; Apply Rlt_monotony_contra with ``2``.
-Sup0.
-Rewrite Rmult_sym; Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Pattern 1 (pos_Rl l' i); Rewrite <- Rplus_Or; Rewrite double; Apply Rlt_compatibility; Apply H19.
-DiscrR.
-Assert H19 := (H8 i H17); Elim H19; Clear H19; Intros; Rewrite <- H18 in H20; Elim H20; Clear H20; Intros; Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H20; Unfold included in H21; Elim H13; Intros; Assert H24 := (H21 x H22); Apply Rle_lt_trans with ``(Rabsolu (y-x))+(Rabsolu (x-xi))``.
-Replace ``y-xi`` with ``(y-x)+(x-xi)``; [Apply Rabsolu_triang | Ring].
-Rewrite (double_var (pos_Rl l' i)); Apply Rplus_lt.
-Apply Rlt_le_trans with ``D/2``.
-Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H12.
-Unfold Rdiv; Do 2 Rewrite <- (Rmult_sym ``/2``); Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Sup0.
-Unfold D; Apply MinRlist_P1; Elim (pos_Rl_P2 l' (pos_Rl l' i)); Intros; Apply H26; Exists i; Split; [Rewrite <- H7; Assumption | Reflexivity].
-Assumption.
-Unfold Rdiv; Apply Rmult_lt_pos; [Unfold D; Apply MinRlist_P2; Intros; Elim (pos_Rl_P2 l' y); Intros; Elim (H10 H9); Intros; Elim H12; Intros; Rewrite H14; Rewrite <- H7 in H13; Elim (H8 x H13); Intros; Apply H15 | Apply Rlt_Rinv; Sup0].
-Intros; Elim (H5 x); Intros; Elim (H8 H6); Intros; Pose E:=[zeta:R]``0<zeta <= M-m``/\((z:R)``(Rabsolu (z-x)) < zeta``->``(Rabsolu ((f0 z)-(f0 x))) < eps/2``); Assert H11 : (bound E).
-Unfold bound; Exists ``M-m``; Unfold is_upper_bound; Unfold E; Intros; Elim H11; Clear H11; Intros H11 _; Elim H11; Clear H11; Intros _ H11; Apply H11.
-Assert H12 : (EXT x:R | (E x)).
-Assert H13 := (H ? H9); Unfold continuity_pt in H13; Unfold continue_in in H13; Unfold limit1_in in H13; Unfold limit_in in H13; Simpl in H13; Unfold R_dist in H13; Elim (H13 ? (H1 eps)); Intros; Elim H12; Clear H12; Intros; Exists (Rmin x0 ``M-m``); Unfold E; Intros; Split.
-Split; [Unfold Rmin; Case (total_order_Rle x0 ``M-m``); Intro; [Apply H12 | Apply Rlt_Rminus; Apply Hyp] | Apply Rmin_r].
-Intros; Case (Req_EM x z); Intro.
-Rewrite H16; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply (H1 eps).
-Apply H14; Split; [Unfold D_x no_cond; Split; [Trivial | Assumption] | Apply Rlt_le_trans with (Rmin x0 ``M-m``); [Apply H15 | Apply Rmin_l]].
-Assert H13 := (complet ? H11 H12); Elim H13; Clear H13; Intros; Cut ``0<x0<=M-m``.
-Intro; Elim H13; Clear H13; Intros; Exists x0; Split.
-Assumption.
-Split.
-Intros; Cut (EXT alp:R | ``(Rabsolu (z-x))<alp<=x0``/\(E alp)).
-Intros; Elim H16; Intros; Elim H17; Clear H17; Intros; Unfold E in H18; Elim H18; Intros; Apply H20; Elim H17; Intros; Assumption.
-Elim (classic (EXT alp:R | ``(Rabsolu (z-x)) < alp <= x0``/\(E alp))); Intro.
-Assumption.
-Assert H17 := (not_ex_all_not ? [alp:R]``(Rabsolu (z-x)) < alp <= x0``/\(E alp) H16); Unfold is_lub in p; Elim p; Intros; Cut (is_upper_bound E ``(Rabsolu (z-x))``).
-Intro; Assert H21 := (H19 ? H20); Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? H15 H21)).
-Unfold is_upper_bound; Intros; Unfold is_upper_bound in H18; Assert H21 := (H18 ? H20); Case (total_order_Rle x1 ``(Rabsolu (z-x))``); Intro.
-Assumption.
-Elim (H17 x1); Split.
-Split; [Auto with real | Assumption].
-Assumption.
-Unfold included g; Intros; Elim H15; Intros; Elim H17; Intros; Decompose [and] H18; Cut x0==x2.
-Intro; Rewrite H20; Apply H22.
-Unfold E in p; EApply is_lub_u.
-Apply p.
-Apply H21.
-Elim H12; Intros; Unfold E in H13; Elim H13; Intros H14 _; Elim H14; Intros H15 _; Unfold is_lub in p; Elim p; Intros; Unfold is_upper_bound in H16; Unfold is_upper_bound in H17; Split.
-Apply Rlt_le_trans with x1; [Assumption | Apply (H16 ? H13)].
-Apply H17; Intros; Unfold E in H18; Elim H18; Intros; Elim H19; Intros; Assumption.
-Qed.
+assert
+ (X_enc :
+ exists m : R | ( exists M : R | (forall x:R, X x -> m <= x <= M) /\ m < M)).
+assert (H1 := compact_P1 X H0); unfold bounded in H1; elim H1; intros;
+ elim H2; intros; exists x; exists x0; split.
+apply H3.
+elim Hyp; intros; elim H4; intros; decompose [and] H5;
+ assert (H10 := H3 _ H6); assert (H11 := H3 _ H8);
+ elim H10; intros; elim H11; intros; case (total_order_T x x0);
+ intro.
+elim s; intro.
+assumption.
+rewrite b in H13; rewrite b in H7; elim H9; apply Rle_antisym;
+ apply Rle_trans with x0; assumption.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ (Rle_trans _ _ _ H13 H14) r)).
+elim X_enc; clear X_enc; intros m X_enc; elim X_enc; clear X_enc;
+ intros M X_enc; elim X_enc; clear X_enc Hyp; intros X_enc Hyp;
+ unfold uniform_continuity in |- *; intro;
+ assert (H1 : forall t:posreal, 0 < t / 2).
+intro; unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ apply (cond_pos t) | apply Rinv_0_lt_compat; prove_sup0 ].
+pose
+ (g :=
+ fun x y:R =>
+ X x /\
+ ( exists del : posreal
+ | (forall z:R, Rabs (z - x) < del -> Rabs (f0 z - f0 x) < eps / 2) /\
+ is_lub
+ (fun zeta:R =>
+ 0 < zeta <= M - m /\
+ (forall z:R, Rabs (z - x) < zeta -> Rabs (f0 z - f0 x) < eps / 2))
+ del /\ disc x (mkposreal (del / 2) (H1 del)) y)).
+assert (H2 : forall x:R, ( exists y : R | g x y) -> X x).
+intros; elim H2; intros; unfold g in H3; elim H3; clear H3; intros H3 _;
+ apply H3.
+pose (f' := mkfamily X g H2); unfold compact in H0;
+ assert (H3 : covering_open_set X f').
+unfold covering_open_set in |- *; split.
+unfold covering in |- *; intros; exists x; simpl in |- *; unfold g in |- *;
+ split.
+assumption.
+assert (H4 := H _ H3); unfold continuity_pt in H4; unfold continue_in in H4;
+ unfold limit1_in in H4; unfold limit_in in H4; simpl in H4;
+ unfold R_dist in H4; elim (H4 (eps / 2) (H1 eps));
+ intros;
+ pose
+ (E :=
+ fun zeta:R =>
+ 0 < zeta <= M - m /\
+ (forall z:R, Rabs (z - x) < zeta -> Rabs (f0 z - f0 x) < eps / 2));
+ assert (H6 : bound E).
+unfold bound in |- *; exists (M - m); unfold is_upper_bound in |- *;
+ unfold E in |- *; intros; elim H6; clear H6; intros H6 _;
+ elim H6; clear H6; intros _ H6; apply H6.
+assert (H7 : exists x : R | E x).
+elim H5; clear H5; intros; exists (Rmin x0 (M - m)); unfold E in |- *; intros;
+ split.
+split.
+unfold Rmin in |- *; case (Rle_dec x0 (M - m)); intro.
+apply H5.
+apply Rlt_Rminus; apply Hyp.
+apply Rmin_r.
+intros; case (Req_dec x z); intro.
+rewrite H9; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+ apply (H1 eps).
+apply H7; split.
+unfold D_x, no_cond in |- *; split; [ trivial | assumption ].
+apply Rlt_le_trans with (Rmin x0 (M - m)); [ apply H8 | apply Rmin_l ].
+assert (H8 := completeness _ H6 H7); elim H8; clear H8; intros;
+ cut (0 < x1 <= M - m).
+intro; elim H8; clear H8; intros; exists (mkposreal _ H8); split.
+intros; cut ( exists alp : R | Rabs (z - x) < alp <= x1 /\ E alp).
+intros; elim H11; intros; elim H12; clear H12; intros; unfold E in H13;
+ elim H13; intros; apply H15.
+elim H12; intros; assumption.
+elim (classic ( exists alp : R | Rabs (z - x) < alp <= x1 /\ E alp)); intro.
+assumption.
+assert
+ (H12 :=
+ not_ex_all_not _ (fun alp:R => Rabs (z - x) < alp <= x1 /\ E alp) H11);
+ unfold is_lub in p; elim p; intros; cut (is_upper_bound E (Rabs (z - x))).
+intro; assert (H16 := H14 _ H15);
+ elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H10 H16)).
+unfold is_upper_bound in |- *; intros; unfold is_upper_bound in H13;
+ assert (H16 := H13 _ H15); case (Rle_dec x2 (Rabs (z - x)));
+ intro.
+assumption.
+elim (H12 x2); split; [ split; [ auto with real | assumption ] | assumption ].
+split.
+apply p.
+unfold disc in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r;
+ rewrite Rabs_R0; simpl in |- *; unfold Rdiv in |- *;
+ apply Rmult_lt_0_compat; [ apply H8 | apply Rinv_0_lt_compat; prove_sup0 ].
+elim H7; intros; unfold E in H8; elim H8; intros H9 _; elim H9; intros H10 _;
+ unfold is_lub in p; elim p; intros; unfold is_upper_bound in H12;
+ unfold is_upper_bound in H11; split.
+apply Rlt_le_trans with x2; [ assumption | apply (H11 _ H8) ].
+apply H12; intros; unfold E in H13; elim H13; intros; elim H14; intros;
+ assumption.
+unfold family_open_set in |- *; intro; simpl in |- *; elim (classic (X x));
+ intro.
+unfold g in |- *; unfold open_set in |- *; intros; elim H4; clear H4;
+ intros _ H4; elim H4; clear H4; intros; elim H4; clear H4;
+ intros; unfold neighbourhood in |- *; case (Req_dec x x0);
+ intro.
+exists (mkposreal _ (H1 x1)); rewrite <- H6; unfold included in |- *; intros;
+ split.
+assumption.
+exists x1; split.
+apply H4.
+split.
+elim H5; intros; apply H8.
+apply H7.
+pose (d := x1 / 2 - Rabs (x0 - x)); assert (H7 : 0 < d).
+unfold d in |- *; apply Rlt_Rminus; elim H5; clear H5; intros;
+ unfold disc in H7; apply H7.
+exists (mkposreal _ H7); unfold included in |- *; intros; split.
+assumption.
+exists x1; split.
+apply H4.
+elim H5; intros; split.
+assumption.
+unfold disc in H8; simpl in H8; unfold disc in |- *; simpl in |- *;
+ unfold disc in H10; simpl in H10;
+ apply Rle_lt_trans with (Rabs (x2 - x0) + Rabs (x0 - x)).
+replace (x2 - x) with (x2 - x0 + (x0 - x)); [ apply Rabs_triang | ring ].
+replace (x1 / 2) with (d + Rabs (x0 - x)); [ idtac | unfold d in |- *; ring ].
+do 2 rewrite <- (Rplus_comm (Rabs (x0 - x))); apply Rplus_lt_compat_l;
+ apply H8.
+apply open_set_P6 with (fun _:R => False).
+apply open_set_P4.
+unfold eq_Dom in |- *; unfold included in |- *; intros; split.
+intros; elim H4.
+intros; unfold g in H4; elim H4; clear H4; intros H4 _; elim H3; apply H4.
+elim (H0 _ H3); intros DF H4; unfold covering_finite in H4; elim H4; clear H4;
+ intros; unfold family_finite in H5; unfold domain_finite in H5;
+ unfold covering in H4; simpl in H4; simpl in H5; elim H5;
+ clear H5; intros l H5; unfold intersection_domain in H5;
+ cut
+ (forall x:R,
+ In x l ->
+ exists del : R
+ | 0 < del /\
+ (forall z:R, Rabs (z - x) < del -> Rabs (f0 z - f0 x) < eps / 2) /\
+ included (g x) (fun z:R => Rabs (z - x) < del / 2)).
+intros;
+ assert
+ (H7 :=
+ Rlist_P1 l
+ (fun x del:R =>
+ 0 < del /\
+ (forall z:R, Rabs (z - x) < del -> Rabs (f0 z - f0 x) < eps / 2) /\
+ included (g x) (fun z:R => Rabs (z - x) < del / 2)) H6);
+ elim H7; clear H7; intros l' H7; elim H7; clear H7;
+ intros; pose (D := MinRlist l'); cut (0 < D / 2).
+intro; exists (mkposreal _ H9); intros; assert (H13 := H4 _ H10); elim H13;
+ clear H13; intros xi H13; assert (H14 : In xi l).
+unfold g in H13; decompose [and] H13; elim (H5 xi); intros; apply H14; split;
+ assumption.
+elim (pos_Rl_P2 l xi); intros H15 _; elim (H15 H14); intros i H16; elim H16;
+ intros; apply Rle_lt_trans with (Rabs (f0 x - f0 xi) + Rabs (f0 xi - f0 y)).
+replace (f0 x - f0 y) with (f0 x - f0 xi + (f0 xi - f0 y));
+ [ apply Rabs_triang | ring ].
+rewrite (double_var eps); apply Rplus_lt_compat.
+assert (H19 := H8 i H17); elim H19; clear H19; intros; rewrite <- H18 in H20;
+ elim H20; clear H20; intros; apply H20; unfold included in H21;
+ apply Rlt_trans with (pos_Rl l' i / 2).
+apply H21.
+elim H13; clear H13; intros; assumption.
+unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2.
+prove_sup0.
+rewrite Rmult_comm; rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r; pattern (pos_Rl l' i) at 1 in |- *; rewrite <- Rplus_0_r;
+ rewrite double; apply Rplus_lt_compat_l; apply H19.
+discrR.
+assert (H19 := H8 i H17); elim H19; clear H19; intros; rewrite <- H18 in H20;
+ elim H20; clear H20; intros; rewrite <- Rabs_Ropp;
+ rewrite Ropp_minus_distr; apply H20; unfold included in H21;
+ elim H13; intros; assert (H24 := H21 x H22);
+ apply Rle_lt_trans with (Rabs (y - x) + Rabs (x - xi)).
+replace (y - xi) with (y - x + (x - xi)); [ apply Rabs_triang | ring ].
+rewrite (double_var (pos_Rl l' i)); apply Rplus_lt_compat.
+apply Rlt_le_trans with (D / 2).
+rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H12.
+unfold Rdiv in |- *; do 2 rewrite <- (Rmult_comm (/ 2));
+ apply Rmult_le_compat_l.
+left; apply Rinv_0_lt_compat; prove_sup0.
+unfold D in |- *; apply MinRlist_P1; elim (pos_Rl_P2 l' (pos_Rl l' i));
+ intros; apply H26; exists i; split;
+ [ rewrite <- H7; assumption | reflexivity ].
+assumption.
+unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ unfold D in |- *; apply MinRlist_P2; intros; elim (pos_Rl_P2 l' y); intros;
+ elim (H10 H9); intros; elim H12; intros; rewrite H14;
+ rewrite <- H7 in H13; elim (H8 x H13); intros;
+ apply H15
+ | apply Rinv_0_lt_compat; prove_sup0 ].
+intros; elim (H5 x); intros; elim (H8 H6); intros;
+ pose
+ (E :=
+ fun zeta:R =>
+ 0 < zeta <= M - m /\
+ (forall z:R, Rabs (z - x) < zeta -> Rabs (f0 z - f0 x) < eps / 2));
+ assert (H11 : bound E).
+unfold bound in |- *; exists (M - m); unfold is_upper_bound in |- *;
+ unfold E in |- *; intros; elim H11; clear H11; intros H11 _;
+ elim H11; clear H11; intros _ H11; apply H11.
+assert (H12 : exists x : R | E x).
+assert (H13 := H _ H9); unfold continuity_pt in H13;
+ unfold continue_in in H13; unfold limit1_in in H13;
+ unfold limit_in in H13; simpl in H13; unfold R_dist in H13;
+ elim (H13 _ (H1 eps)); intros; elim H12; clear H12;
+ intros; exists (Rmin x0 (M - m)); unfold E in |- *;
+ intros; split.
+split;
+ [ unfold Rmin in |- *; case (Rle_dec x0 (M - m)); intro;
+ [ apply H12 | apply Rlt_Rminus; apply Hyp ]
+ | apply Rmin_r ].
+intros; case (Req_dec x z); intro.
+rewrite H16; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+ apply (H1 eps).
+apply H14; split;
+ [ unfold D_x, no_cond in |- *; split; [ trivial | assumption ]
+ | apply Rlt_le_trans with (Rmin x0 (M - m)); [ apply H15 | apply Rmin_l ] ].
+assert (H13 := completeness _ H11 H12); elim H13; clear H13; intros;
+ cut (0 < x0 <= M - m).
+intro; elim H13; clear H13; intros; exists x0; split.
+assumption.
+split.
+intros; cut ( exists alp : R | Rabs (z - x) < alp <= x0 /\ E alp).
+intros; elim H16; intros; elim H17; clear H17; intros; unfold E in H18;
+ elim H18; intros; apply H20; elim H17; intros; assumption.
+elim (classic ( exists alp : R | Rabs (z - x) < alp <= x0 /\ E alp)); intro.
+assumption.
+assert
+ (H17 :=
+ not_ex_all_not _ (fun alp:R => Rabs (z - x) < alp <= x0 /\ E alp) H16);
+ unfold is_lub in p; elim p; intros; cut (is_upper_bound E (Rabs (z - x))).
+intro; assert (H21 := H19 _ H20);
+ elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H15 H21)).
+unfold is_upper_bound in |- *; intros; unfold is_upper_bound in H18;
+ assert (H21 := H18 _ H20); case (Rle_dec x1 (Rabs (z - x)));
+ intro.
+assumption.
+elim (H17 x1); split.
+split; [ auto with real | assumption ].
+assumption.
+unfold included, g in |- *; intros; elim H15; intros; elim H17; intros;
+ decompose [and] H18; cut (x0 = x2).
+intro; rewrite H20; apply H22.
+unfold E in p; eapply is_lub_u.
+apply p.
+apply H21.
+elim H12; intros; unfold E in H13; elim H13; intros H14 _; elim H14;
+ intros H15 _; unfold is_lub in p; elim p; intros;
+ unfold is_upper_bound in H16; unfold is_upper_bound in H17;
+ split.
+apply Rlt_le_trans with x1; [ assumption | apply (H16 _ H13) ].
+apply H17; intros; unfold E in H18; elim H18; intros; elim H19; intros;
+ assumption.
+Qed. \ No newline at end of file
diff --git a/theories/Reals/Rtrigo.v b/theories/Reals/Rtrigo.v
index ae23fd8a6..60f07f610 100644
--- a/theories/Reals/Rtrigo.v
+++ b/theories/Reals/Rtrigo.v
@@ -8,1104 +8,1700 @@
(*i $Id$ i*)
-Require Rbase.
-Require Rfunctions.
-Require SeqSeries.
+Require Import Rbase.
+Require Import Rfunctions.
+Require Import SeqSeries.
Require Export Rtrigo_fun.
Require Export Rtrigo_def.
Require Export Rtrigo_alt.
Require Export Cos_rel.
Require Export Cos_plus.
-Require ZArith_base.
-Require Zcomplements.
-Require Classical_Prop.
-V7only [Import nat_scope. Import Z_scope. Import R_scope.].
+Require Import ZArith_base.
+Require Import Zcomplements.
+Require Import Classical_Prop.
Open Local Scope nat_scope.
Open Local Scope R_scope.
(** sin_PI2 is the only remaining axiom **)
-Axiom sin_PI2 : ``(sin (PI/2))==1``.
+Axiom sin_PI2 : sin (PI / 2) = 1.
(**********)
-Lemma PI_neq0 : ~``PI==0``.
-Red; Intro; Assert H0 := PI_RGT_0; Rewrite H in H0; Elim (Rlt_antirefl ? H0).
+Lemma PI_neq0 : PI <> 0.
+red in |- *; intro; assert (H0 := PI_RGT_0); rewrite H in H0;
+ elim (Rlt_irrefl _ H0).
Qed.
(**********)
-Lemma cos_minus : (x,y:R) ``(cos (x-y))==(cos x)*(cos y)+(sin x)*(sin y)``.
-Intros; Unfold Rminus; Rewrite cos_plus.
-Rewrite <- cos_sym; Rewrite sin_antisym; Ring.
+Lemma cos_minus : forall x y:R, cos (x - y) = cos x * cos y + sin x * sin y.
+intros; unfold Rminus in |- *; rewrite cos_plus.
+rewrite <- cos_sym; rewrite sin_antisym; ring.
Qed.
(**********)
-Lemma sin2_cos2 : (x:R) ``(Rsqr (sin x)) + (Rsqr (cos x))==1``.
-Intro; Unfold Rsqr; Rewrite Rplus_sym; Rewrite <- (cos_minus x x); Unfold Rminus; Rewrite Rplus_Ropp_r; Apply cos_0.
+Lemma sin2_cos2 : forall x:R, Rsqr (sin x) + Rsqr (cos x) = 1.
+intro; unfold Rsqr in |- *; rewrite Rplus_comm; rewrite <- (cos_minus x x);
+ unfold Rminus in |- *; rewrite Rplus_opp_r; apply cos_0.
Qed.
-Lemma cos2 : (x:R) ``(Rsqr (cos x))==1-(Rsqr (sin x))``.
-Intro x; Generalize (sin2_cos2 x); Intro H1; Rewrite <- H1; Unfold Rminus; Rewrite <- (Rplus_sym (Rsqr (cos x))); Rewrite Rplus_assoc; Rewrite Rplus_Ropp_r; Symmetry; Apply Rplus_Or.
+Lemma cos2 : forall x:R, Rsqr (cos x) = 1 - Rsqr (sin x).
+intro x; generalize (sin2_cos2 x); intro H1; rewrite <- H1;
+ unfold Rminus in |- *; rewrite <- (Rplus_comm (Rsqr (cos x)));
+ rewrite Rplus_assoc; rewrite Rplus_opp_r; symmetry in |- *;
+ apply Rplus_0_r.
Qed.
(**********)
-Lemma cos_PI2 : ``(cos (PI/2))==0``.
-Apply Rsqr_eq_0; Rewrite cos2; Rewrite sin_PI2; Rewrite Rsqr_1; Unfold Rminus; Apply Rplus_Ropp_r.
+Lemma cos_PI2 : cos (PI / 2) = 0.
+apply Rsqr_eq_0; rewrite cos2; rewrite sin_PI2; rewrite Rsqr_1;
+ unfold Rminus in |- *; apply Rplus_opp_r.
Qed.
(**********)
-Lemma cos_PI : ``(cos PI)==-1``.
-Replace ``PI`` with ``PI/2+PI/2``.
-Rewrite cos_plus.
-Rewrite sin_PI2; Rewrite cos_PI2.
-Ring.
-Symmetry; Apply double_var.
+Lemma cos_PI : cos PI = -1.
+replace PI with (PI / 2 + PI / 2).
+rewrite cos_plus.
+rewrite sin_PI2; rewrite cos_PI2.
+ring.
+symmetry in |- *; apply double_var.
Qed.
-Lemma sin_PI : ``(sin PI)==0``.
-Assert H := (sin2_cos2 PI).
-Rewrite cos_PI in H.
-Rewrite <- Rsqr_neg in H.
-Rewrite Rsqr_1 in H.
-Cut (Rsqr (sin PI))==R0.
-Intro; Apply (Rsqr_eq_0 ? H0).
-Apply r_Rplus_plus with R1.
-Rewrite Rplus_Or; Rewrite Rplus_sym; Exact H.
+Lemma sin_PI : sin PI = 0.
+assert (H := sin2_cos2 PI).
+rewrite cos_PI in H.
+rewrite <- Rsqr_neg in H.
+rewrite Rsqr_1 in H.
+cut (Rsqr (sin PI) = 0).
+intro; apply (Rsqr_eq_0 _ H0).
+apply Rplus_eq_reg_l with 1.
+rewrite Rplus_0_r; rewrite Rplus_comm; exact H.
Qed.
(**********)
-Lemma neg_cos : (x:R) ``(cos (x+PI))==-(cos x)``.
-Intro x; Rewrite -> cos_plus; Rewrite -> sin_PI; Rewrite -> cos_PI; Ring.
+Lemma neg_cos : forall x:R, cos (x + PI) = - cos x.
+intro x; rewrite cos_plus; rewrite sin_PI; rewrite cos_PI; ring.
Qed.
(**********)
-Lemma sin_cos : (x:R) ``(sin x)==-(cos (PI/2+x))``.
-Intro x; Rewrite -> cos_plus; Rewrite -> sin_PI2; Rewrite -> cos_PI2; Ring.
+Lemma sin_cos : forall x:R, sin x = - cos (PI / 2 + x).
+intro x; rewrite cos_plus; rewrite sin_PI2; rewrite cos_PI2; ring.
Qed.
(**********)
-Lemma sin_plus : (x,y:R) ``(sin (x+y))==(sin x)*(cos y)+(cos x)*(sin y)``.
-Intros.
-Rewrite (sin_cos ``x+y``).
-Replace ``PI/2+(x+y)`` with ``(PI/2+x)+y``; [Rewrite cos_plus | Ring].
-Rewrite (sin_cos ``PI/2+x``).
-Replace ``PI/2+(PI/2+x)`` with ``x+PI``.
-Rewrite neg_cos.
-Replace (cos ``PI/2+x``) with ``-(sin x)``.
-Ring.
-Rewrite sin_cos; Rewrite Ropp_Ropp; Reflexivity.
-Pattern 1 PI; Rewrite (double_var PI); Ring.
+Lemma sin_plus : forall x y:R, sin (x + y) = sin x * cos y + cos x * sin y.
+intros.
+rewrite (sin_cos (x + y)).
+replace (PI / 2 + (x + y)) with (PI / 2 + x + y); [ rewrite cos_plus | ring ].
+rewrite (sin_cos (PI / 2 + x)).
+replace (PI / 2 + (PI / 2 + x)) with (x + PI).
+rewrite neg_cos.
+replace (cos (PI / 2 + x)) with (- sin x).
+ring.
+rewrite sin_cos; rewrite Ropp_involutive; reflexivity.
+pattern PI at 1 in |- *; rewrite (double_var PI); ring.
Qed.
-Lemma sin_minus : (x,y:R) ``(sin (x-y))==(sin x)*(cos y)-(cos x)*(sin y)``.
-Intros; Unfold Rminus; Rewrite sin_plus.
-Rewrite <- cos_sym; Rewrite sin_antisym; Ring.
+Lemma sin_minus : forall x y:R, sin (x - y) = sin x * cos y - cos x * sin y.
+intros; unfold Rminus in |- *; rewrite sin_plus.
+rewrite <- cos_sym; rewrite sin_antisym; ring.
Qed.
(**********)
-Definition tan [x:R] : R := ``(sin x)/(cos x)``.
-
-Lemma tan_plus : (x,y:R) ~``(cos x)==0`` -> ~``(cos y)==0`` -> ~``(cos (x+y))==0`` -> ~``1-(tan x)*(tan y)==0`` -> ``(tan (x+y))==((tan x)+(tan y))/(1-(tan x)*(tan y))``.
-Intros; Unfold tan; Rewrite sin_plus; Rewrite cos_plus; Unfold Rdiv; Replace ``((cos x)*(cos y)-(sin x)*(sin y))`` with ``((cos x)*(cos y))*(1-(sin x)*/(cos x)*((sin y)*/(cos y)))``.
-Rewrite Rinv_Rmult.
-Repeat Rewrite <- Rmult_assoc; Replace ``((sin x)*(cos y)+(cos x)*(sin y))*/((cos x)*(cos y))`` with ``((sin x)*/(cos x)+(sin y)*/(cos y))``.
-Reflexivity.
-Rewrite Rmult_Rplus_distrl; Rewrite Rinv_Rmult.
-Repeat Rewrite Rmult_assoc; Repeat Rewrite (Rmult_sym ``(sin x)``); Repeat Rewrite <- Rmult_assoc.
-Repeat Rewrite Rinv_r_simpl_m; [Reflexivity | Assumption | Assumption].
-Assumption.
-Assumption.
-Apply prod_neq_R0; Assumption.
-Assumption.
-Unfold Rminus; Rewrite Rmult_Rplus_distr; Rewrite Rmult_1r; Apply Rplus_plus_r; Repeat Rewrite Rmult_assoc; Rewrite (Rmult_sym ``(sin x)``); Rewrite (Rmult_sym ``(cos y)``); Rewrite <- Ropp_mul3; Repeat Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1l; Rewrite (Rmult_sym (sin x)); Rewrite <- Ropp_mul3; Repeat Rewrite Rmult_assoc; Apply Rmult_mult_r; Rewrite (Rmult_sym ``/(cos y)``); Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym.
-Apply Rmult_1r.
-Assumption.
-Assumption.
+Definition tan (x:R) : R := sin x / cos x.
+
+Lemma tan_plus :
+ forall x y:R,
+ cos x <> 0 ->
+ cos y <> 0 ->
+ cos (x + y) <> 0 ->
+ 1 - tan x * tan y <> 0 ->
+ tan (x + y) = (tan x + tan y) / (1 - tan x * tan y).
+intros; unfold tan in |- *; rewrite sin_plus; rewrite cos_plus;
+ unfold Rdiv in |- *;
+ replace (cos x * cos y - sin x * sin y) with
+ (cos x * cos y * (1 - sin x * / cos x * (sin y * / cos y))).
+rewrite Rinv_mult_distr.
+repeat rewrite <- Rmult_assoc;
+ replace ((sin x * cos y + cos x * sin y) * / (cos x * cos y)) with
+ (sin x * / cos x + sin y * / cos y).
+reflexivity.
+rewrite Rmult_plus_distr_r; rewrite Rinv_mult_distr.
+repeat rewrite Rmult_assoc; repeat rewrite (Rmult_comm (sin x));
+ repeat rewrite <- Rmult_assoc.
+repeat rewrite Rinv_r_simpl_m; [ reflexivity | assumption | assumption ].
+assumption.
+assumption.
+apply prod_neq_R0; assumption.
+assumption.
+unfold Rminus in |- *; rewrite Rmult_plus_distr_l; rewrite Rmult_1_r;
+ apply Rplus_eq_compat_l; repeat rewrite Rmult_assoc;
+ rewrite (Rmult_comm (sin x)); rewrite (Rmult_comm (cos y));
+ rewrite <- Ropp_mult_distr_r_reverse; repeat rewrite <- Rmult_assoc;
+ rewrite <- Rinv_r_sym.
+rewrite Rmult_1_l; rewrite (Rmult_comm (sin x));
+ rewrite <- Ropp_mult_distr_r_reverse; repeat rewrite Rmult_assoc;
+ apply Rmult_eq_compat_l; rewrite (Rmult_comm (/ cos y));
+ rewrite Rmult_assoc; rewrite <- Rinv_r_sym.
+apply Rmult_1_r.
+assumption.
+assumption.
Qed.
(*******************************************************)
(* Some properties of cos, sin and tan *)
(*******************************************************)
-Lemma sin2 : (x:R) ``(Rsqr (sin x))==1-(Rsqr (cos x))``.
-Intro x; Generalize (cos2 x); Intro H1; Rewrite -> H1.
-Unfold Rminus; Rewrite Ropp_distr1; Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Ol; Symmetry; Apply Ropp_Ropp.
+Lemma sin2 : forall x:R, Rsqr (sin x) = 1 - Rsqr (cos x).
+intro x; generalize (cos2 x); intro H1; rewrite H1.
+unfold Rminus in |- *; rewrite Ropp_plus_distr; rewrite <- Rplus_assoc;
+ rewrite Rplus_opp_r; rewrite Rplus_0_l; symmetry in |- *;
+ apply Ropp_involutive.
Qed.
-Lemma sin_2a : (x:R) ``(sin (2*x))==2*(sin x)*(cos x)``.
-Intro x; Rewrite double; Rewrite sin_plus.
-Rewrite <- (Rmult_sym (sin x)); Symmetry; Rewrite Rmult_assoc; Apply double.
+Lemma sin_2a : forall x:R, sin (2 * x) = 2 * sin x * cos x.
+intro x; rewrite double; rewrite sin_plus.
+rewrite <- (Rmult_comm (sin x)); symmetry in |- *; rewrite Rmult_assoc;
+ apply double.
Qed.
-Lemma cos_2a : (x:R) ``(cos (2*x))==(cos x)*(cos x)-(sin x)*(sin x)``.
-Intro x; Rewrite double; Apply cos_plus.
+Lemma cos_2a : forall x:R, cos (2 * x) = cos x * cos x - sin x * sin x.
+intro x; rewrite double; apply cos_plus.
Qed.
-Lemma cos_2a_cos : (x:R) ``(cos (2*x))==2*(cos x)*(cos x)-1``.
-Intro x; Rewrite double; Unfold Rminus; Rewrite Rmult_assoc; Rewrite cos_plus; Generalize (sin2_cos2 x); Rewrite double; Intro H1; Rewrite <- H1; SqRing.
+Lemma cos_2a_cos : forall x:R, cos (2 * x) = 2 * cos x * cos x - 1.
+intro x; rewrite double; unfold Rminus in |- *; rewrite Rmult_assoc;
+ rewrite cos_plus; generalize (sin2_cos2 x); rewrite double;
+ intro H1; rewrite <- H1; ring_Rsqr.
Qed.
-Lemma cos_2a_sin : (x:R) ``(cos (2*x))==1-2*(sin x)*(sin x)``.
-Intro x; Rewrite Rmult_assoc; Unfold Rminus; Repeat Rewrite double.
-Generalize (sin2_cos2 x); Intro H1; Rewrite <- H1; Rewrite cos_plus; SqRing.
+Lemma cos_2a_sin : forall x:R, cos (2 * x) = 1 - 2 * sin x * sin x.
+intro x; rewrite Rmult_assoc; unfold Rminus in |- *; repeat rewrite double.
+generalize (sin2_cos2 x); intro H1; rewrite <- H1; rewrite cos_plus;
+ ring_Rsqr.
Qed.
-Lemma tan_2a : (x:R) ~``(cos x)==0`` -> ~``(cos (2*x))==0`` -> ~``1-(tan x)*(tan x)==0`` ->``(tan (2*x))==(2*(tan x))/(1-(tan x)*(tan x))``.
-Repeat Rewrite double; Intros; Repeat Rewrite double; Rewrite double in H0; Apply tan_plus; Assumption.
+Lemma tan_2a :
+ forall x:R,
+ cos x <> 0 ->
+ cos (2 * x) <> 0 ->
+ 1 - tan x * tan x <> 0 -> tan (2 * x) = 2 * tan x / (1 - tan x * tan x).
+repeat rewrite double; intros; repeat rewrite double; rewrite double in H0;
+ apply tan_plus; assumption.
Qed.
-Lemma sin_neg : (x:R) ``(sin (-x))==-(sin x)``.
-Apply sin_antisym.
+Lemma sin_neg : forall x:R, sin (- x) = - sin x.
+apply sin_antisym.
Qed.
-Lemma cos_neg : (x:R) ``(cos (-x))==(cos x)``.
-Intro; Symmetry; Apply cos_sym.
+Lemma cos_neg : forall x:R, cos (- x) = cos x.
+intro; symmetry in |- *; apply cos_sym.
Qed.
-Lemma tan_0 : ``(tan 0)==0``.
-Unfold tan; Rewrite -> sin_0; Rewrite -> cos_0.
-Unfold Rdiv; Apply Rmult_Ol.
+Lemma tan_0 : tan 0 = 0.
+unfold tan in |- *; rewrite sin_0; rewrite cos_0.
+unfold Rdiv in |- *; apply Rmult_0_l.
Qed.
-Lemma tan_neg : (x:R) ``(tan (-x))==-(tan x)``.
-Intros x; Unfold tan; Rewrite sin_neg; Rewrite cos_neg; Unfold Rdiv.
-Apply Ropp_mul1.
+Lemma tan_neg : forall x:R, tan (- x) = - tan x.
+intros x; unfold tan in |- *; rewrite sin_neg; rewrite cos_neg;
+ unfold Rdiv in |- *.
+apply Ropp_mult_distr_l_reverse.
Qed.
-Lemma tan_minus : (x,y:R) ~``(cos x)==0`` -> ~``(cos y)==0`` -> ~``(cos (x-y))==0`` -> ~``1+(tan x)*(tan y)==0`` -> ``(tan (x-y))==((tan x)-(tan y))/(1+(tan x)*(tan y))``.
-Intros; Unfold Rminus; Rewrite tan_plus.
-Rewrite tan_neg; Unfold Rminus; Rewrite <- Ropp_mul1; Rewrite Ropp_mul2; Reflexivity.
-Assumption.
-Rewrite cos_neg; Assumption.
-Assumption.
-Rewrite tan_neg; Unfold Rminus; Rewrite <- Ropp_mul1; Rewrite Ropp_mul2; Assumption.
+Lemma tan_minus :
+ forall x y:R,
+ cos x <> 0 ->
+ cos y <> 0 ->
+ cos (x - y) <> 0 ->
+ 1 + tan x * tan y <> 0 ->
+ tan (x - y) = (tan x - tan y) / (1 + tan x * tan y).
+intros; unfold Rminus in |- *; rewrite tan_plus.
+rewrite tan_neg; unfold Rminus in |- *; rewrite <- Ropp_mult_distr_l_reverse;
+ rewrite Rmult_opp_opp; reflexivity.
+assumption.
+rewrite cos_neg; assumption.
+assumption.
+rewrite tan_neg; unfold Rminus in |- *; rewrite <- Ropp_mult_distr_l_reverse;
+ rewrite Rmult_opp_opp; assumption.
Qed.
-Lemma cos_3PI2 : ``(cos (3*(PI/2)))==0``.
-Replace ``3*(PI/2)`` with ``PI+(PI/2)``.
-Rewrite -> cos_plus; Rewrite -> sin_PI; Rewrite -> cos_PI2; Ring.
-Pattern 1 PI; Rewrite (double_var PI).
-Ring.
+Lemma cos_3PI2 : cos (3 * (PI / 2)) = 0.
+replace (3 * (PI / 2)) with (PI + PI / 2).
+rewrite cos_plus; rewrite sin_PI; rewrite cos_PI2; ring.
+pattern PI at 1 in |- *; rewrite (double_var PI).
+ring.
Qed.
-Lemma sin_2PI : ``(sin (2*PI))==0``.
-Rewrite -> sin_2a; Rewrite -> sin_PI; Ring.
+Lemma sin_2PI : sin (2 * PI) = 0.
+rewrite sin_2a; rewrite sin_PI; ring.
Qed.
-Lemma cos_2PI : ``(cos (2*PI))==1``.
-Rewrite -> cos_2a; Rewrite -> sin_PI; Rewrite -> cos_PI; Ring.
+Lemma cos_2PI : cos (2 * PI) = 1.
+rewrite cos_2a; rewrite sin_PI; rewrite cos_PI; ring.
Qed.
-Lemma neg_sin : (x:R) ``(sin (x+PI))==-(sin x)``.
-Intro x; Rewrite -> sin_plus; Rewrite -> sin_PI; Rewrite -> cos_PI; Ring.
+Lemma neg_sin : forall x:R, sin (x + PI) = - sin x.
+intro x; rewrite sin_plus; rewrite sin_PI; rewrite cos_PI; ring.
Qed.
-Lemma sin_PI_x : (x:R) ``(sin (PI-x))==(sin x)``.
-Intro x; Rewrite -> sin_minus; Rewrite -> sin_PI; Rewrite -> cos_PI; Rewrite Rmult_Ol; Unfold Rminus; Rewrite Rplus_Ol; Rewrite Ropp_mul1; Rewrite Ropp_Ropp; Apply Rmult_1l.
+Lemma sin_PI_x : forall x:R, sin (PI - x) = sin x.
+intro x; rewrite sin_minus; rewrite sin_PI; rewrite cos_PI; rewrite Rmult_0_l;
+ unfold Rminus in |- *; rewrite Rplus_0_l; rewrite Ropp_mult_distr_l_reverse;
+ rewrite Ropp_involutive; apply Rmult_1_l.
Qed.
-Lemma sin_period : (x:R)(k:nat) ``(sin (x+2*(INR k)*PI))==(sin x)``.
-Intros x k; Induction k.
-Cut ``x+2*(INR O)*PI==x``; [Intro; Rewrite H; Reflexivity | Ring].
-Replace ``x+2*(INR (S k))*PI`` with ``(x+2*(INR k)*PI)+(2*PI)``; [Rewrite -> sin_plus; Rewrite -> sin_2PI; Rewrite -> cos_2PI; Ring; Apply Hreck | Rewrite -> S_INR; Ring].
+Lemma sin_period : forall (x:R) (k:nat), sin (x + 2 * INR k * PI) = sin x.
+intros x k; induction k as [| k Hreck].
+cut (x + 2 * INR 0 * PI = x); [ intro; rewrite H; reflexivity | ring ].
+replace (x + 2 * INR (S k) * PI) with (x + 2 * INR k * PI + 2 * PI);
+ [ rewrite sin_plus; rewrite sin_2PI; rewrite cos_2PI; ring; apply Hreck
+ | rewrite S_INR; ring ].
Qed.
-Lemma cos_period : (x:R)(k:nat) ``(cos (x+2*(INR k)*PI))==(cos x)``.
-Intros x k; Induction k.
-Cut ``x+2*(INR O)*PI==x``; [Intro; Rewrite H; Reflexivity | Ring].
-Replace ``x+2*(INR (S k))*PI`` with ``(x+2*(INR k)*PI)+(2*PI)``; [Rewrite -> cos_plus; Rewrite -> sin_2PI; Rewrite -> cos_2PI; Ring; Apply Hreck | Rewrite -> S_INR; Ring].
+Lemma cos_period : forall (x:R) (k:nat), cos (x + 2 * INR k * PI) = cos x.
+intros x k; induction k as [| k Hreck].
+cut (x + 2 * INR 0 * PI = x); [ intro; rewrite H; reflexivity | ring ].
+replace (x + 2 * INR (S k) * PI) with (x + 2 * INR k * PI + 2 * PI);
+ [ rewrite cos_plus; rewrite sin_2PI; rewrite cos_2PI; ring; apply Hreck
+ | rewrite S_INR; ring ].
Qed.
-Lemma sin_shift : (x:R) ``(sin (PI/2-x))==(cos x)``.
-Intro x; Rewrite -> sin_minus; Rewrite -> sin_PI2; Rewrite -> cos_PI2; Ring.
+Lemma sin_shift : forall x:R, sin (PI / 2 - x) = cos x.
+intro x; rewrite sin_minus; rewrite sin_PI2; rewrite cos_PI2; ring.
Qed.
-Lemma cos_shift : (x:R) ``(cos (PI/2-x))==(sin x)``.
-Intro x; Rewrite -> cos_minus; Rewrite -> sin_PI2; Rewrite -> cos_PI2; Ring.
+Lemma cos_shift : forall x:R, cos (PI / 2 - x) = sin x.
+intro x; rewrite cos_minus; rewrite sin_PI2; rewrite cos_PI2; ring.
Qed.
-Lemma cos_sin : (x:R) ``(cos x)==(sin (PI/2+x))``.
-Intro x; Rewrite -> sin_plus; Rewrite -> sin_PI2; Rewrite -> cos_PI2; Ring.
+Lemma cos_sin : forall x:R, cos x = sin (PI / 2 + x).
+intro x; rewrite sin_plus; rewrite sin_PI2; rewrite cos_PI2; ring.
Qed.
-Lemma PI2_RGT_0 : ``0<PI/2``.
-Unfold Rdiv; Apply Rmult_lt_pos; [Apply PI_RGT_0 | Apply Rlt_Rinv; Sup].
+Lemma PI2_RGT_0 : 0 < PI / 2.
+unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ apply PI_RGT_0 | apply Rinv_0_lt_compat; prove_sup ].
Qed.
-Lemma SIN_bound : (x:R) ``-1<=(sin x)<=1``.
-Intro; Case (total_order_Rle ``-1`` (sin x)); Intro.
-Case (total_order_Rle (sin x) ``1``); Intro.
-Split; Assumption.
-Cut ``1<(sin x)``.
-Intro; Generalize (Rsqr_incrst_1 ``1`` (sin x) H (Rlt_le ``0`` ``1`` Rlt_R0_R1) (Rlt_le ``0`` (sin x) (Rlt_trans ``0`` ``1`` (sin x) Rlt_R0_R1 H))); Rewrite Rsqr_1; Intro; Rewrite sin2 in H0; Unfold Rminus in H0; Generalize (Rlt_compatibility ``-1`` ``1`` ``1+ -(Rsqr (cos x))`` H0); Repeat Rewrite <- Rplus_assoc; Repeat Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Intro; Rewrite <- Ropp_O in H1; Generalize (Rlt_Ropp ``-0`` ``-(Rsqr (cos x))`` H1); Repeat Rewrite Ropp_Ropp; Intro; Generalize (pos_Rsqr (cos x)); Intro; Elim (Rlt_antirefl ``0`` (Rle_lt_trans ``0`` (Rsqr (cos x)) ``0`` H3 H2)).
-Auto with real.
-Cut ``(sin x)< -1``.
-Intro; Generalize (Rlt_Ropp (sin x) ``-1`` H); Rewrite Ropp_Ropp; Clear H; Intro; Generalize (Rsqr_incrst_1 ``1`` ``-(sin x)`` H (Rlt_le ``0`` ``1`` Rlt_R0_R1) (Rlt_le ``0`` ``-(sin x)`` (Rlt_trans ``0`` ``1`` ``-(sin x)`` Rlt_R0_R1 H))); Rewrite Rsqr_1; Intro; Rewrite <- Rsqr_neg in H0; Rewrite sin2 in H0; Unfold Rminus in H0; Generalize (Rlt_compatibility ``-1`` ``1`` ``1+ -(Rsqr (cos x))`` H0); Repeat Rewrite <- Rplus_assoc; Repeat Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Intro; Rewrite <- Ropp_O in H1; Generalize (Rlt_Ropp ``-0`` ``-(Rsqr (cos x))`` H1); Repeat Rewrite Ropp_Ropp; Intro; Generalize (pos_Rsqr (cos x)); Intro; Elim (Rlt_antirefl ``0`` (Rle_lt_trans ``0`` (Rsqr (cos x)) ``0`` H3 H2)).
-Auto with real.
-Qed.
-
-Lemma COS_bound : (x:R) ``-1<=(cos x)<=1``.
-Intro; Rewrite <- sin_shift; Apply SIN_bound.
-Qed.
-
-Lemma cos_sin_0 : (x:R) ~(``(cos x)==0``/\``(sin x)==0``).
-Intro; Red; Intro; Elim H; Intros; Generalize (sin2_cos2 x); Intro; Rewrite H0 in H2; Rewrite H1 in H2; Repeat Rewrite Rsqr_O in H2; Rewrite Rplus_Or in H2; Generalize Rlt_R0_R1; Intro; Rewrite <- H2 in H3; Elim (Rlt_antirefl ``0`` H3).
+Lemma SIN_bound : forall x:R, -1 <= sin x <= 1.
+intro; case (Rle_dec (-1) (sin x)); intro.
+case (Rle_dec (sin x) 1); intro.
+split; assumption.
+cut (1 < sin x).
+intro;
+ generalize
+ (Rsqr_incrst_1 1 (sin x) H (Rlt_le 0 1 Rlt_0_1)
+ (Rlt_le 0 (sin x) (Rlt_trans 0 1 (sin x) Rlt_0_1 H)));
+ rewrite Rsqr_1; intro; rewrite sin2 in H0; unfold Rminus in H0;
+ generalize (Rplus_lt_compat_l (-1) 1 (1 + - Rsqr (cos x)) H0);
+ repeat rewrite <- Rplus_assoc; repeat rewrite Rplus_opp_l;
+ rewrite Rplus_0_l; intro; rewrite <- Ropp_0 in H1;
+ generalize (Ropp_lt_gt_contravar (-0) (- Rsqr (cos x)) H1);
+ repeat rewrite Ropp_involutive; intro; generalize (Rle_0_sqr (cos x));
+ intro; elim (Rlt_irrefl 0 (Rle_lt_trans 0 (Rsqr (cos x)) 0 H3 H2)).
+auto with real.
+cut (sin x < -1).
+intro; generalize (Ropp_lt_gt_contravar (sin x) (-1) H);
+ rewrite Ropp_involutive; clear H; intro;
+ generalize
+ (Rsqr_incrst_1 1 (- sin x) H (Rlt_le 0 1 Rlt_0_1)
+ (Rlt_le 0 (- sin x) (Rlt_trans 0 1 (- sin x) Rlt_0_1 H)));
+ rewrite Rsqr_1; intro; rewrite <- Rsqr_neg in H0;
+ rewrite sin2 in H0; unfold Rminus in H0;
+ generalize (Rplus_lt_compat_l (-1) 1 (1 + - Rsqr (cos x)) H0);
+ repeat rewrite <- Rplus_assoc; repeat rewrite Rplus_opp_l;
+ rewrite Rplus_0_l; intro; rewrite <- Ropp_0 in H1;
+ generalize (Ropp_lt_gt_contravar (-0) (- Rsqr (cos x)) H1);
+ repeat rewrite Ropp_involutive; intro; generalize (Rle_0_sqr (cos x));
+ intro; elim (Rlt_irrefl 0 (Rle_lt_trans 0 (Rsqr (cos x)) 0 H3 H2)).
+auto with real.
+Qed.
+
+Lemma COS_bound : forall x:R, -1 <= cos x <= 1.
+intro; rewrite <- sin_shift; apply SIN_bound.
+Qed.
+
+Lemma cos_sin_0 : forall x:R, ~ (cos x = 0 /\ sin x = 0).
+intro; red in |- *; intro; elim H; intros; generalize (sin2_cos2 x); intro;
+ rewrite H0 in H2; rewrite H1 in H2; repeat rewrite Rsqr_0 in H2;
+ rewrite Rplus_0_r in H2; generalize Rlt_0_1; intro;
+ rewrite <- H2 in H3; elim (Rlt_irrefl 0 H3).
Qed.
-Lemma cos_sin_0_var : (x:R) ~``(cos x)==0``\/~``(sin x)==0``.
-Intro; Apply not_and_or; Apply cos_sin_0.
+Lemma cos_sin_0_var : forall x:R, cos x <> 0 \/ sin x <> 0.
+intro; apply not_and_or; apply cos_sin_0.
Qed.
(*****************************************************************)
(* Using series definitions of cos and sin *)
(*****************************************************************)
-Definition sin_lb [a:R] : R := (sin_approx a (3)).
-Definition sin_ub [a:R] : R := (sin_approx a (4)).
-Definition cos_lb [a:R] : R := (cos_approx a (3)).
-Definition cos_ub [a:R] : R := (cos_approx a (4)).
-
-Lemma sin_lb_gt_0 : (a:R) ``0<a``->``a<=PI/2``->``0<(sin_lb a)``.
-Intros.
-Unfold sin_lb; Unfold sin_approx; Unfold sin_term.
-Pose Un := [i:nat]``(pow a (plus (mult (S (S O)) i) (S O)))/(INR (fact (plus (mult (S (S O)) i) (S O))))``.
-Replace (sum_f_R0 [i:nat] ``(pow ( -1) i)*(pow a (plus (mult (S (S O)) i) (S O)))/(INR (fact (plus (mult (S (S O)) i) (S O))))`` (S (S (S O)))) with (sum_f_R0 [i:nat]``(pow (-1) i)*(Un i)`` (3)); [Idtac | Apply sum_eq; Intros; Unfold Un; Reflexivity].
-Cut (n:nat)``(Un (S n))<(Un n)``.
-Intro; Simpl.
-Repeat Rewrite Rmult_1l; Repeat Rewrite Rmult_1r; Replace ``-1*(Un (S O))`` with ``-(Un (S O))``; [Idtac | Ring]; Replace ``-1* -1*(Un (S (S O)))`` with ``(Un (S (S O)))``; [Idtac | Ring]; Replace ``-1*( -1* -1)*(Un (S (S (S O))))`` with ``-(Un (S (S (S O))))``; [Idtac | Ring]; Replace ``(Un O)+ -(Un (S O))+(Un (S (S O)))+ -(Un (S (S (S O))))`` with ``((Un O)-(Un (S O)))+((Un (S (S O)))-(Un (S (S (S O)))))``; [Idtac | Ring].
-Apply gt0_plus_gt0_is_gt0.
-Unfold Rminus; Apply Rlt_anti_compatibility with (Un (S O)); Rewrite Rplus_Or; Rewrite (Rplus_sym (Un (S O))); Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Apply H1.
-Unfold Rminus; Apply Rlt_anti_compatibility with (Un (S (S (S O)))); Rewrite Rplus_Or; Rewrite (Rplus_sym (Un (S (S (S O))))); Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Apply H1.
-Intro; Unfold Un.
-Cut (plus (mult (2) (S n)) (S O)) = (plus (plus (mult (2) n) (S O)) (2)).
-Intro; Rewrite H1.
-Rewrite pow_add; Unfold Rdiv; Rewrite Rmult_assoc; Apply Rlt_monotony.
-Apply pow_lt; Assumption.
-Rewrite <- H1; Apply Rlt_monotony_contra with (INR (fact (plus (mult (S (S O)) n) (S O)))).
-Apply lt_INR_0; Apply neq_O_lt.
-Assert H2 := (fact_neq_0 (plus (mult (2) n) (1))).
-Red; Intro; Elim H2; Symmetry; Assumption.
-Rewrite <- Rinv_r_sym.
-Apply Rlt_monotony_contra with (INR (fact (plus (mult (S (S O)) (S n)) (S O)))).
-Apply lt_INR_0; Apply neq_O_lt.
-Assert H2 := (fact_neq_0 (plus (mult (2) (S n)) (1))).
-Red; Intro; Elim H2; Symmetry; Assumption.
-Rewrite (Rmult_sym (INR (fact (plus (mult (S (S O)) (S n)) (S O))))); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Do 2 Rewrite Rmult_1r; Apply Rle_lt_trans with ``(INR (fact (plus (mult (S (S O)) n) (S O))))*4``.
-Apply Rle_monotony.
-Replace R0 with (INR O); [Idtac | Reflexivity]; Apply le_INR; Apply le_O_n.
-Simpl; Rewrite Rmult_1r; Replace ``4`` with ``(Rsqr 2)``; [Idtac | SqRing]; Replace ``a*a`` with (Rsqr a); [Idtac | Reflexivity]; Apply Rsqr_incr_1.
-Apply Rle_trans with ``PI/2``; [Assumption | Unfold Rdiv; Apply Rle_monotony_contra with ``2``; [ Sup0 | Rewrite <- Rmult_assoc; Rewrite Rinv_r_simpl_m; [Replace ``2*2`` with ``4``; [Apply PI_4 | Ring] | DiscrR]]].
-Left; Assumption.
-Left; Sup0.
-Rewrite H1; Replace (plus (plus (mult (S (S O)) n) (S O)) (S (S O))) with (S (S (plus (mult (S (S O)) n) (S O)))).
-Do 2 Rewrite fact_simpl; Do 2 Rewrite mult_INR.
-Repeat Rewrite <- Rmult_assoc.
-Rewrite <- (Rmult_sym (INR (fact (plus (mult (S (S O)) n) (S O))))).
-Rewrite Rmult_assoc.
-Apply Rlt_monotony.
-Apply lt_INR_0; Apply neq_O_lt.
-Assert H2 := (fact_neq_0 (plus (mult (2) n) (1))).
-Red; Intro; Elim H2; Symmetry; Assumption.
-Do 2 Rewrite S_INR; Rewrite plus_INR; Rewrite mult_INR; Pose x := (INR n); Unfold INR.
-Replace ``(2*x+1+1+1)*(2*x+1+1)`` with ``4*x*x+10*x+6``; [Idtac | Ring].
-Apply Rlt_anti_compatibility with ``-4``; Rewrite Rplus_Ropp_l; Replace ``-4+(4*x*x+10*x+6)`` with ``(4*x*x+10*x)+2``; [Idtac | Ring].
-Apply ge0_plus_gt0_is_gt0.
-Cut ``0<=x``.
-Intro; Apply ge0_plus_ge0_is_ge0; Repeat Apply Rmult_le_pos; Assumption Orelse Left; Sup.
-Unfold x; Replace R0 with (INR O); [Apply le_INR; Apply le_O_n | Reflexivity].
-Sup0.
-Apply INR_eq; Do 2 Rewrite S_INR; Do 3 Rewrite plus_INR; Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply INR_eq; Do 3 Rewrite plus_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Qed.
-
-Lemma SIN : (a:R) ``0<=a`` -> ``a<=PI`` -> ``(sin_lb a)<=(sin a)<=(sin_ub a)``.
-Intros; Unfold sin_lb sin_ub; Apply (sin_bound a (S O) H H0).
-Qed.
-
-Lemma COS : (a:R) ``-PI/2<=a`` -> ``a<=PI/2`` -> ``(cos_lb a)<=(cos a)<=(cos_ub a)``.
-Intros; Unfold cos_lb cos_ub; Apply (cos_bound a (S O) H H0).
+Definition sin_lb (a:R) : R := sin_approx a 3.
+Definition sin_ub (a:R) : R := sin_approx a 4.
+Definition cos_lb (a:R) : R := cos_approx a 3.
+Definition cos_ub (a:R) : R := cos_approx a 4.
+
+Lemma sin_lb_gt_0 : forall a:R, 0 < a -> a <= PI / 2 -> 0 < sin_lb a.
+intros.
+unfold sin_lb in |- *; unfold sin_approx in |- *; unfold sin_term in |- *.
+pose (Un := fun i:nat => a ^ (2 * i + 1) / INR (fact (2 * i + 1))).
+replace
+ (sum_f_R0
+ (fun i:nat => (-1) ^ i * (a ^ (2 * i + 1) / INR (fact (2 * i + 1)))) 3)
+ with (sum_f_R0 (fun i:nat => (-1) ^ i * Un i) 3);
+ [ idtac | apply sum_eq; intros; unfold Un in |- *; reflexivity ].
+cut (forall n:nat, Un (S n) < Un n).
+intro; simpl in |- *.
+repeat rewrite Rmult_1_l; repeat rewrite Rmult_1_r;
+ replace (-1 * Un 1%nat) with (- Un 1%nat); [ idtac | ring ];
+ replace (-1 * -1 * Un 2%nat) with (Un 2%nat); [ idtac | ring ];
+ replace (-1 * (-1 * -1) * Un 3%nat) with (- Un 3%nat);
+ [ idtac | ring ];
+ replace (Un 0%nat + - Un 1%nat + Un 2%nat + - Un 3%nat) with
+ (Un 0%nat - Un 1%nat + (Un 2%nat - Un 3%nat)); [ idtac | ring ].
+apply Rplus_lt_0_compat.
+unfold Rminus in |- *; apply Rplus_lt_reg_r with (Un 1%nat);
+ rewrite Rplus_0_r; rewrite (Rplus_comm (Un 1%nat));
+ rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r;
+ apply H1.
+unfold Rminus in |- *; apply Rplus_lt_reg_r with (Un 3%nat);
+ rewrite Rplus_0_r; rewrite (Rplus_comm (Un 3%nat));
+ rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r;
+ apply H1.
+intro; unfold Un in |- *.
+cut ((2 * S n + 1)%nat = (2 * n + 1 + 2)%nat).
+intro; rewrite H1.
+rewrite pow_add; unfold Rdiv in |- *; rewrite Rmult_assoc;
+ apply Rmult_lt_compat_l.
+apply pow_lt; assumption.
+rewrite <- H1; apply Rmult_lt_reg_l with (INR (fact (2 * n + 1))).
+apply lt_INR_0; apply neq_O_lt.
+assert (H2 := fact_neq_0 (2 * n + 1)).
+red in |- *; intro; elim H2; symmetry in |- *; assumption.
+rewrite <- Rinv_r_sym.
+apply Rmult_lt_reg_l with (INR (fact (2 * S n + 1))).
+apply lt_INR_0; apply neq_O_lt.
+assert (H2 := fact_neq_0 (2 * S n + 1)).
+red in |- *; intro; elim H2; symmetry in |- *; assumption.
+rewrite (Rmult_comm (INR (fact (2 * S n + 1)))); repeat rewrite Rmult_assoc;
+ rewrite <- Rinv_l_sym.
+do 2 rewrite Rmult_1_r; apply Rle_lt_trans with (INR (fact (2 * n + 1)) * 4).
+apply Rmult_le_compat_l.
+replace 0 with (INR 0); [ idtac | reflexivity ]; apply le_INR; apply le_O_n.
+simpl in |- *; rewrite Rmult_1_r; replace 4 with (Rsqr 2);
+ [ idtac | ring_Rsqr ]; replace (a * a) with (Rsqr a);
+ [ idtac | reflexivity ]; apply Rsqr_incr_1.
+apply Rle_trans with (PI / 2);
+ [ assumption
+ | unfold Rdiv in |- *; apply Rmult_le_reg_l with 2;
+ [ prove_sup0
+ | rewrite <- Rmult_assoc; rewrite Rinv_r_simpl_m;
+ [ replace 4 with 4; [ apply PI_4 | ring ] | discrR ] ] ].
+left; assumption.
+left; prove_sup0.
+rewrite H1; replace (2 * n + 1 + 2)%nat with (S (S (2 * n + 1))).
+do 2 rewrite fact_simpl; do 2 rewrite mult_INR.
+repeat rewrite <- Rmult_assoc.
+rewrite <- (Rmult_comm (INR (fact (2 * n + 1)))).
+rewrite Rmult_assoc.
+apply Rmult_lt_compat_l.
+apply lt_INR_0; apply neq_O_lt.
+assert (H2 := fact_neq_0 (2 * n + 1)).
+red in |- *; intro; elim H2; symmetry in |- *; assumption.
+do 2 rewrite S_INR; rewrite plus_INR; rewrite mult_INR; pose (x := INR n);
+ unfold INR in |- *.
+replace ((2 * x + 1 + 1 + 1) * (2 * x + 1 + 1)) with (4 * x * x + 10 * x + 6);
+ [ idtac | ring ].
+apply Rplus_lt_reg_r with (-4); rewrite Rplus_opp_l;
+ replace (-4 + (4 * x * x + 10 * x + 6)) with (4 * x * x + 10 * x + 2);
+ [ idtac | ring ].
+apply Rplus_le_lt_0_compat.
+cut (0 <= x).
+intro; apply Rplus_le_le_0_compat; repeat apply Rmult_le_pos;
+ assumption || left; prove_sup.
+unfold x in |- *; replace 0 with (INR 0);
+ [ apply le_INR; apply le_O_n | reflexivity ].
+prove_sup0.
+apply INR_eq; do 2 rewrite S_INR; do 3 rewrite plus_INR; rewrite mult_INR;
+ repeat rewrite S_INR; ring.
+apply INR_fact_neq_0.
+apply INR_fact_neq_0.
+apply INR_eq; do 3 rewrite plus_INR; do 2 rewrite mult_INR;
+ repeat rewrite S_INR; ring.
+Qed.
+
+Lemma SIN : forall a:R, 0 <= a -> a <= PI -> sin_lb a <= sin a <= sin_ub a.
+intros; unfold sin_lb, sin_ub in |- *; apply (sin_bound a 1 H H0).
+Qed.
+
+Lemma COS :
+ forall a:R, - PI / 2 <= a -> a <= PI / 2 -> cos_lb a <= cos a <= cos_ub a.
+intros; unfold cos_lb, cos_ub in |- *; apply (cos_bound a 1 H H0).
Qed.
(**********)
-Lemma _PI2_RLT_0 : ``-(PI/2)<0``.
-Rewrite <- Ropp_O; Apply Rlt_Ropp1; Apply PI2_RGT_0.
+Lemma _PI2_RLT_0 : - (PI / 2) < 0.
+rewrite <- Ropp_0; apply Ropp_lt_contravar; apply PI2_RGT_0.
Qed.
-Lemma PI4_RLT_PI2 : ``PI/4<PI/2``.
-Unfold Rdiv; Apply Rlt_monotony.
-Apply PI_RGT_0.
-Apply Rinv_lt.
-Apply Rmult_lt_pos; Sup0.
-Pattern 1 ``2``; Rewrite <- Rplus_Or.
-Replace ``4`` with ``2+2``; [Apply Rlt_compatibility; Sup0 | Ring].
+Lemma PI4_RLT_PI2 : PI / 4 < PI / 2.
+unfold Rdiv in |- *; apply Rmult_lt_compat_l.
+apply PI_RGT_0.
+apply Rinv_lt_contravar.
+apply Rmult_lt_0_compat; prove_sup0.
+pattern 2 at 1 in |- *; rewrite <- Rplus_0_r.
+replace 4 with (2 + 2); [ apply Rplus_lt_compat_l; prove_sup0 | ring ].
Qed.
-Lemma PI2_Rlt_PI : ``PI/2<PI``.
-Unfold Rdiv; Pattern 2 PI; Rewrite <- Rmult_1r.
-Apply Rlt_monotony.
-Apply PI_RGT_0.
-Pattern 3 R1; Rewrite <- Rinv_R1; Apply Rinv_lt.
-Rewrite Rmult_1l; Sup0.
-Pattern 1 R1; Rewrite <- Rplus_Or; Apply Rlt_compatibility; Apply Rlt_R0_R1.
+Lemma PI2_Rlt_PI : PI / 2 < PI.
+unfold Rdiv in |- *; pattern PI at 2 in |- *; rewrite <- Rmult_1_r.
+apply Rmult_lt_compat_l.
+apply PI_RGT_0.
+pattern 1 at 3 in |- *; rewrite <- Rinv_1; apply Rinv_lt_contravar.
+rewrite Rmult_1_l; prove_sup0.
+pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
+ apply Rlt_0_1.
Qed.
(********************************************)
(* Increasing and decreasing of COS and SIN *)
(********************************************)
-Theorem sin_gt_0 : (x:R) ``0<x`` -> ``x<PI`` -> ``0<(sin x)``.
-Intros; Elim (SIN x (Rlt_le R0 x H) (Rlt_le x PI H0)); Intros H1 _; Case (total_order x ``PI/2``); Intro H2.
-Apply Rlt_le_trans with (sin_lb x).
-Apply sin_lb_gt_0; [Assumption | Left; Assumption].
-Assumption.
-Elim H2; Intro H3.
-Rewrite H3; Rewrite sin_PI2; Apply Rlt_R0_R1.
-Rewrite <- sin_PI_x; Generalize (Rgt_Ropp x ``PI/2`` H3); Intro H4; Generalize (Rlt_compatibility PI (Ropp x) (Ropp ``PI/2``) H4).
-Replace ``PI+(-x)`` with ``PI-x``.
-Replace ``PI+ -(PI/2)`` with ``PI/2``.
-Intro H5; Generalize (Rlt_Ropp x PI H0); Intro H6; Change ``-PI < -x`` in H6; Generalize (Rlt_compatibility PI (Ropp PI) (Ropp x) H6).
-Rewrite Rplus_Ropp_r.
-Replace ``PI+ -x`` with ``PI-x``.
-Intro H7; Elim (SIN ``PI-x`` (Rlt_le R0 ``PI-x`` H7) (Rlt_le ``PI-x`` PI (Rlt_trans ``PI-x`` ``PI/2`` ``PI`` H5 PI2_Rlt_PI))); Intros H8 _; Generalize (sin_lb_gt_0 ``PI-x`` H7 (Rlt_le ``PI-x`` ``PI/2`` H5)); Intro H9; Apply (Rlt_le_trans ``0`` ``(sin_lb (PI-x))`` ``(sin (PI-x))`` H9 H8).
-Reflexivity.
-Pattern 2 PI; Rewrite double_var; Ring.
-Reflexivity.
-Qed.
-
-Theorem cos_gt_0 : (x:R) ``-(PI/2)<x`` -> ``x<PI/2`` -> ``0<(cos x)``.
-Intros; Rewrite cos_sin; Generalize (Rlt_compatibility ``PI/2`` ``-(PI/2)`` x H).
-Rewrite Rplus_Ropp_r; Intro H1; Generalize (Rlt_compatibility ``PI/2`` x ``PI/2`` H0); Rewrite <- double_var; Intro H2; Apply (sin_gt_0 ``PI/2+x`` H1 H2).
-Qed.
-
-Lemma sin_ge_0 : (x:R) ``0<=x`` -> ``x<=PI`` -> ``0<=(sin x)``.
-Intros x H1 H2; Elim H1; Intro H3; [ Elim H2; Intro H4; [ Left ; Apply (sin_gt_0 x H3 H4) | Rewrite H4; Right; Symmetry; Apply sin_PI ] | Rewrite <- H3; Right; Symmetry; Apply sin_0].
-Qed.
-
-Lemma cos_ge_0 : (x:R) ``-(PI/2)<=x`` -> ``x<=PI/2`` -> ``0<=(cos x)``.
-Intros x H1 H2; Elim H1; Intro H3; [ Elim H2; Intro H4; [ Left ; Apply (cos_gt_0 x H3 H4) | Rewrite H4; Right; Symmetry; Apply cos_PI2 ] | Rewrite <- H3; Rewrite cos_neg; Right; Symmetry; Apply cos_PI2 ].
-Qed.
-
-Lemma sin_le_0 : (x:R) ``PI<=x`` -> ``x<=2*PI`` -> ``(sin x)<=0``.
-Intros x H1 H2; Apply Rle_sym2; Rewrite <- Ropp_O; Rewrite <- (Ropp_Ropp (sin x)); Apply Rle_Ropp; Rewrite <- neg_sin; Replace ``x+PI`` with ``(x-PI)+2*(INR (S O))*PI``; [Rewrite -> (sin_period (Rminus x PI) (S O)); Apply sin_ge_0; [Replace ``x-PI`` with ``x+(-PI)``; [Rewrite Rplus_sym; Replace ``0`` with ``(-PI)+PI``; [Apply Rle_compatibility; Assumption | Ring] | Ring] | Replace ``x-PI`` with ``x+(-PI)``; Rewrite Rplus_sym; [Pattern 2 PI; Replace ``PI`` with ``(-PI)+2*PI``; [Apply Rle_compatibility; Assumption | Ring] | Ring]] |Unfold INR; Ring].
-Qed.
-
-Lemma cos_le_0 : (x:R) ``PI/2<=x``->``x<=3*(PI/2)``->``(cos x)<=0``.
-Intros x H1 H2; Apply Rle_sym2; Rewrite <- Ropp_O; Rewrite <- (Ropp_Ropp (cos x)); Apply Rle_Ropp; Rewrite <- neg_cos; Replace ``x+PI`` with ``(x-PI)+2*(INR (S O))*PI``.
-Rewrite cos_period; Apply cos_ge_0.
-Replace ``-(PI/2)`` with ``-PI+(PI/2)``.
-Unfold Rminus; Rewrite (Rplus_sym x); Apply Rle_compatibility; Assumption.
-Pattern 1 PI; Rewrite (double_var PI); Rewrite Ropp_distr1; Ring.
-Unfold Rminus; Rewrite Rplus_sym; Replace ``PI/2`` with ``(-PI)+3*(PI/2)``.
-Apply Rle_compatibility; Assumption.
-Pattern 1 PI; Rewrite (double_var PI); Rewrite Ropp_distr1; Ring.
-Unfold INR; Ring.
-Qed.
-
-Lemma sin_lt_0 : (x:R) ``PI<x`` -> ``x<2*PI`` -> ``(sin x)<0``.
-Intros x H1 H2; Rewrite <- Ropp_O; Rewrite <- (Ropp_Ropp (sin x)); Apply Rlt_Ropp; Rewrite <- neg_sin; Replace ``x+PI`` with ``(x-PI)+2*(INR (S O))*PI``; [Rewrite -> (sin_period (Rminus x PI) (S O)); Apply sin_gt_0; [Replace ``x-PI`` with ``x+(-PI)``; [Rewrite Rplus_sym; Replace ``0`` with ``(-PI)+PI``; [Apply Rlt_compatibility; Assumption | Ring] | Ring] | Replace ``x-PI`` with ``x+(-PI)``; Rewrite Rplus_sym; [Pattern 2 PI; Replace ``PI`` with ``(-PI)+2*PI``; [Apply Rlt_compatibility; Assumption | Ring] | Ring]] |Unfold INR; Ring].
-Qed.
-
-Lemma sin_lt_0_var : (x:R) ``-PI<x`` -> ``x<0`` -> ``(sin x)<0``.
-Intros; Generalize (Rlt_compatibility ``2*PI`` ``-PI`` x H); Replace ``2*PI+(-PI)`` with ``PI``; [Intro H1; Rewrite Rplus_sym in H1; Generalize (Rlt_compatibility ``2*PI`` x ``0`` H0); Intro H2; Rewrite (Rplus_sym ``2*PI``) in H2; Rewrite <- (Rplus_sym R0) in H2; Rewrite Rplus_Ol in H2; Rewrite <- (sin_period x (1)); Unfold INR; Replace ``2*1*PI`` with ``2*PI``; [Apply (sin_lt_0 ``x+2*PI`` H1 H2) | Ring] | Ring].
-Qed.
-
-Lemma cos_lt_0 : (x:R) ``PI/2<x`` -> ``x<3*(PI/2)``-> ``(cos x)<0``.
-Intros x H1 H2; Rewrite <- Ropp_O; Rewrite <- (Ropp_Ropp (cos x)); Apply Rlt_Ropp; Rewrite <- neg_cos; Replace ``x+PI`` with ``(x-PI)+2*(INR (S O))*PI``.
-Rewrite cos_period; Apply cos_gt_0.
-Replace ``-(PI/2)`` with ``-PI+(PI/2)``.
-Unfold Rminus; Rewrite (Rplus_sym x); Apply Rlt_compatibility; Assumption.
-Pattern 1 PI; Rewrite (double_var PI); Rewrite Ropp_distr1; Ring.
-Unfold Rminus; Rewrite Rplus_sym; Replace ``PI/2`` with ``(-PI)+3*(PI/2)``.
-Apply Rlt_compatibility; Assumption.
-Pattern 1 PI; Rewrite (double_var PI); Rewrite Ropp_distr1; Ring.
-Unfold INR; Ring.
-Qed.
-
-Lemma tan_gt_0 : (x:R) ``0<x`` -> ``x<PI/2`` -> ``0<(tan x)``.
-Intros x H1 H2; Unfold tan; Generalize _PI2_RLT_0; Generalize (Rlt_trans R0 x ``PI/2`` H1 H2); Intros; Generalize (Rlt_trans ``-(PI/2)`` R0 x H0 H1); Intro H5; Generalize (Rlt_trans x ``PI/2`` PI H2 PI2_Rlt_PI); Intro H7; Unfold Rdiv; Apply Rmult_lt_pos.
-Apply sin_gt_0; Assumption.
-Apply Rlt_Rinv; Apply cos_gt_0; Assumption.
-Qed.
-
-Lemma tan_lt_0 : (x:R) ``-(PI/2)<x``->``x<0``->``(tan x)<0``.
-Intros x H1 H2; Unfold tan; Generalize (cos_gt_0 x H1 (Rlt_trans x ``0`` ``PI/2`` H2 PI2_RGT_0)); Intro H3; Rewrite <- Ropp_O; Replace ``(sin x)/(cos x)`` with ``- ((-(sin x))/(cos x))``.
-Rewrite <- sin_neg; Apply Rgt_Ropp; Change ``0<(sin (-x))/(cos x)``; Unfold Rdiv; Apply Rmult_lt_pos.
-Apply sin_gt_0.
-Rewrite <- Ropp_O; Apply Rgt_Ropp; Assumption.
-Apply Rlt_trans with ``PI/2``.
-Rewrite <- (Ropp_Ropp ``PI/2``); Apply Rgt_Ropp; Assumption.
-Apply PI2_Rlt_PI.
-Apply Rlt_Rinv; Assumption.
-Unfold Rdiv; Ring.
-Qed.
-
-Lemma cos_ge_0_3PI2 : (x:R) ``3*(PI/2)<=x``->``x<=2*PI``->``0<=(cos x)``.
-Intros; Rewrite <- cos_neg; Rewrite <- (cos_period ``-x`` (1)); Unfold INR; Replace ``-x+2*1*PI`` with ``2*PI-x``.
-Generalize (Rle_Ropp x ``2*PI`` H0); Intro H1; Generalize (Rle_sym2 ``-(2*PI)`` ``-x`` H1); Clear H1; Intro H1; Generalize (Rle_compatibility ``2*PI`` ``-(2*PI)`` ``-x`` H1).
-Rewrite Rplus_Ropp_r.
-Intro H2; Generalize (Rle_Ropp ``3*(PI/2)`` x H); Intro H3; Generalize (Rle_sym2 ``-x`` ``-(3*(PI/2))`` H3); Clear H3; Intro H3; Generalize (Rle_compatibility ``2*PI`` ``-x`` ``-(3*(PI/2))`` H3).
-Replace ``2*PI+ -(3*PI/2)`` with ``PI/2``.
-Intro H4; Apply (cos_ge_0 ``2*PI-x`` (Rlt_le ``-(PI/2)`` ``2*PI-x`` (Rlt_le_trans ``-(PI/2)`` ``0`` ``2*PI-x`` _PI2_RLT_0 H2)) H4).
-Rewrite double; Pattern 2 3 PI; Rewrite double_var; Ring.
-Ring.
-Qed.
-
-Lemma form1 : (p,q:R) ``(cos p)+(cos q)==2*(cos ((p-q)/2))*(cos ((p+q)/2))``.
-Intros p q; Pattern 1 p; Replace ``p`` with ``(p-q)/2+(p+q)/2``.
-Rewrite <- (cos_neg q); Replace``-q`` with ``(p-q)/2-(p+q)/2``.
-Rewrite cos_plus; Rewrite cos_minus; Ring.
-Pattern 3 q; Rewrite double_var; Unfold Rdiv; Ring.
-Pattern 3 p; Rewrite double_var; Unfold Rdiv; Ring.
-Qed.
-
-Lemma form2 : (p,q:R) ``(cos p)-(cos q)==-2*(sin ((p-q)/2))*(sin ((p+q)/2))``.
-Intros p q; Pattern 1 p; Replace ``p`` with ``(p-q)/2+(p+q)/2``.
-Rewrite <- (cos_neg q); Replace``-q`` with ``(p-q)/2-(p+q)/2``.
-Rewrite cos_plus; Rewrite cos_minus; Ring.
-Pattern 3 q; Rewrite double_var; Unfold Rdiv; Ring.
-Pattern 3 p; Rewrite double_var; Unfold Rdiv; Ring.
-Qed.
-
-Lemma form3 : (p,q:R) ``(sin p)+(sin q)==2*(cos ((p-q)/2))*(sin ((p+q)/2))``.
-Intros p q; Pattern 1 p; Replace ``p`` with ``(p-q)/2+(p+q)/2``.
-Pattern 3 q; Replace ``q`` with ``(p+q)/2-(p-q)/2``.
-Rewrite sin_plus; Rewrite sin_minus; Ring.
-Pattern 3 q; Rewrite double_var; Unfold Rdiv; Ring.
-Pattern 3 p; Rewrite double_var; Unfold Rdiv; Ring.
-Qed.
-
-Lemma form4 : (p,q:R) ``(sin p)-(sin q)==2*(cos ((p+q)/2))*(sin ((p-q)/2))``.
-Intros p q; Pattern 1 p; Replace ``p`` with ``(p-q)/2+(p+q)/2``.
-Pattern 3 q; Replace ``q`` with ``(p+q)/2-(p-q)/2``.
-Rewrite sin_plus; Rewrite sin_minus; Ring.
-Pattern 3 q; Rewrite double_var; Unfold Rdiv; Ring.
-Pattern 3 p; Rewrite double_var; Unfold Rdiv; Ring.
-
-Qed.
-
-Lemma sin_increasing_0 : (x,y:R) ``-(PI/2)<=x``->``x<=PI/2``->``-(PI/2)<=y``->``y<=PI/2``->``(sin x)<(sin y)``->``x<y``.
-Intros; Cut ``(sin ((x-y)/2))<0``.
-Intro H4; Case (total_order ``(x-y)/2`` ``0``); Intro H5.
-Assert Hyp : ``0<2``.
-Sup0.
-Generalize (Rlt_monotony ``2`` ``(x-y)/2`` ``0`` Hyp H5).
-Unfold Rdiv.
-Rewrite <- Rmult_assoc.
-Rewrite Rinv_r_simpl_m.
-Rewrite Rmult_Or.
-Clear H5; Intro H5; Apply Rminus_lt; Assumption.
-DiscrR.
-Elim H5; Intro H6.
-Rewrite H6 in H4; Rewrite sin_0 in H4; Elim (Rlt_antirefl ``0`` H4).
-Change ``0<(x-y)/2`` in H6; Generalize (Rle_Ropp ``-(PI/2)`` y H1).
-Rewrite Ropp_Ropp.
-Intro H7; Generalize (Rle_sym2 ``-y`` ``PI/2`` H7); Clear H7; Intro H7; Generalize (Rplus_le x ``PI/2`` ``-y`` ``PI/2`` H0 H7).
-Rewrite <- double_var.
-Intro H8.
-Assert Hyp : ``0<2``.
-Sup0.
-Generalize (Rle_monotony ``(Rinv 2)`` ``x-y`` PI (Rlt_le ``0`` ``/2`` (Rlt_Rinv ``2`` Hyp)) H8).
-Repeat Rewrite (Rmult_sym ``/2``).
-Intro H9; Generalize (sin_gt_0 ``(x-y)/2`` H6 (Rle_lt_trans ``(x-y)/2`` ``PI/2`` PI H9 PI2_Rlt_PI)); Intro H10; Elim (Rlt_antirefl ``(sin ((x-y)/2))`` (Rlt_trans ``(sin ((x-y)/2))`` ``0`` ``(sin ((x-y)/2))`` H4 H10)).
-Generalize (Rlt_minus (sin x) (sin y) H3); Clear H3; Intro H3; Rewrite form4 in H3; Generalize (Rplus_le x ``PI/2`` y ``PI/2`` H0 H2).
-Rewrite <- double_var.
-Assert Hyp : ``0<2``.
-Sup0.
-Intro H4; Generalize (Rle_monotony ``(Rinv 2)`` ``x+y`` PI (Rlt_le ``0`` ``/2`` (Rlt_Rinv ``2`` Hyp)) H4).
-Repeat Rewrite (Rmult_sym ``/2``).
-Clear H4; Intro H4; Generalize (Rplus_le ``-(PI/2)`` x ``-(PI/2)`` y H H1); Replace ``-(PI/2)+(-(PI/2))`` with ``-PI``.
-Intro H5; Generalize (Rle_monotony ``(Rinv 2)`` ``-PI`` ``x+y`` (Rlt_le ``0`` ``/2`` (Rlt_Rinv ``2`` Hyp)) H5).
-Replace ``/2*(x+y)`` with ``(x+y)/2``.
-Replace ``/2*(-PI)`` with ``-(PI/2)``.
-Clear H5; Intro H5; Elim H4; Intro H40.
-Elim H5; Intro H50.
-Generalize (cos_gt_0 ``(x+y)/2`` H50 H40); Intro H6; Generalize (Rlt_monotony ``2`` ``0`` ``(cos ((x+y)/2))`` Hyp H6).
-Rewrite Rmult_Or.
-Clear H6; Intro H6; Case (case_Rabsolu ``(sin ((x-y)/2))``); Intro H7.
-Assumption.
-Generalize (Rle_sym2 ``0`` ``(sin ((x-y)/2))`` H7); Clear H7; Intro H7; Generalize (Rmult_le_pos ``2*(cos ((x+y)/2))`` ``(sin ((x-y)/2))`` (Rlt_le ``0`` ``2*(cos ((x+y)/2))`` H6) H7); Intro H8; Generalize (Rle_lt_trans ``0`` ``2*(cos ((x+y)/2))*(sin ((x-y)/2))`` ``0`` H8 H3); Intro H9; Elim (Rlt_antirefl ``0`` H9).
-Rewrite <- H50 in H3; Rewrite cos_neg in H3; Rewrite cos_PI2 in H3; Rewrite Rmult_Or in H3; Rewrite Rmult_Ol in H3; Elim (Rlt_antirefl ``0`` H3).
-Unfold Rdiv in H3.
-Rewrite H40 in H3; Assert H50 := cos_PI2; Unfold Rdiv in H50; Rewrite H50 in H3; Rewrite Rmult_Or in H3; Rewrite Rmult_Ol in H3; Elim (Rlt_antirefl ``0`` H3).
-Unfold Rdiv.
-Rewrite <- Ropp_mul1.
-Apply Rmult_sym.
-Unfold Rdiv; Apply Rmult_sym.
-Pattern 1 PI; Rewrite double_var.
-Rewrite Ropp_distr1.
-Reflexivity.
-Qed.
-
-Lemma sin_increasing_1 : (x,y:R) ``-(PI/2)<=x``->``x<=PI/2``->``-(PI/2)<=y``->``y<=PI/2``->``x<y``->``(sin x)<(sin y)``.
-Intros; Generalize (Rlt_compatibility ``x`` ``x`` ``y`` H3); Intro H4; Generalize (Rplus_le ``-(PI/2)`` x ``-(PI/2)`` x H H); Replace ``-(PI/2)+ (-(PI/2))`` with ``-PI``.
-Assert Hyp : ``0<2``.
-Sup0.
-Intro H5; Generalize (Rle_lt_trans ``-PI`` ``x+x`` ``x+y`` H5 H4); Intro H6; Generalize (Rlt_monotony ``(Rinv 2)`` ``-PI`` ``x+y`` (Rlt_Rinv ``2`` Hyp) H6); Replace ``/2*(-PI)`` with ``-(PI/2)``.
-Replace ``/2*(x+y)`` with ``(x+y)/2``.
-Clear H4 H5 H6; Intro H4; Generalize (Rlt_compatibility ``y`` ``x`` ``y`` H3); Intro H5; Rewrite Rplus_sym in H5; Generalize (Rplus_le y ``PI/2`` y ``PI/2`` H2 H2).
-Rewrite <- double_var.
-Intro H6; Generalize (Rlt_le_trans ``x+y`` ``y+y`` PI H5 H6); Intro H7; Generalize (Rlt_monotony ``(Rinv 2)`` ``x+y`` PI (Rlt_Rinv ``2`` Hyp) H7); Replace ``/2*PI`` with ``PI/2``.
-Replace ``/2*(x+y)`` with ``(x+y)/2``.
-Clear H5 H6 H7; Intro H5; Generalize (Rle_Ropp ``-(PI/2)`` y H1); Rewrite Ropp_Ropp; Clear H1; Intro H1; Generalize (Rle_sym2 ``-y`` ``PI/2`` H1); Clear H1; Intro H1; Generalize (Rle_Ropp y ``PI/2`` H2); Clear H2; Intro H2; Generalize (Rle_sym2 ``-(PI/2)`` ``-y`` H2); Clear H2; Intro H2; Generalize (Rlt_compatibility ``-y`` x y H3); Replace ``-y+x`` with ``x-y``.
-Rewrite Rplus_Ropp_l.
-Intro H6; Generalize (Rlt_monotony ``(Rinv 2)`` ``x-y`` ``0`` (Rlt_Rinv ``2`` Hyp) H6); Rewrite Rmult_Or; Replace ``/2*(x-y)`` with ``(x-y)/2``.
-Clear H6; Intro H6; Generalize (Rplus_le ``-(PI/2)`` x ``-(PI/2)`` ``-y`` H H2); Replace ``-(PI/2)+ (-(PI/2))`` with ``-PI``.
-Replace `` x+ -y`` with ``x-y``.
-Intro H7; Generalize (Rle_monotony ``(Rinv 2)`` ``-PI`` ``x-y`` (Rlt_le ``0`` ``/2`` (Rlt_Rinv ``2`` Hyp)) H7); Replace ``/2*(-PI)`` with ``-(PI/2)``.
-Replace ``/2*(x-y)`` with ``(x-y)/2``.
-Clear H7; Intro H7; Clear H H0 H1 H2; Apply Rminus_lt; Rewrite form4; Generalize (cos_gt_0 ``(x+y)/2`` H4 H5); Intro H8; Generalize (Rmult_lt_pos ``2`` ``(cos ((x+y)/2))`` Hyp H8); Clear H8; Intro H8; Cut ``-PI< -(PI/2)``.
-Intro H9; Generalize (sin_lt_0_var ``(x-y)/2`` (Rlt_le_trans ``-PI`` ``-(PI/2)`` ``(x-y)/2`` H9 H7) H6); Intro H10; Generalize (Rlt_anti_monotony ``(sin ((x-y)/2))`` ``0`` ``2*(cos ((x+y)/2))`` H10 H8); Intro H11; Rewrite Rmult_Or in H11; Rewrite Rmult_sym; Assumption.
-Apply Rlt_Ropp; Apply PI2_Rlt_PI.
-Unfold Rdiv; Apply Rmult_sym.
-Unfold Rdiv; Rewrite <- Ropp_mul1; Apply Rmult_sym.
-Reflexivity.
-Pattern 1 PI; Rewrite double_var.
-Rewrite Ropp_distr1.
-Reflexivity.
-Unfold Rdiv; Apply Rmult_sym.
-Unfold Rminus; Apply Rplus_sym.
-Unfold Rdiv; Apply Rmult_sym.
-Unfold Rdiv; Apply Rmult_sym.
-Unfold Rdiv; Apply Rmult_sym.
-Unfold Rdiv.
-Rewrite <- Ropp_mul1.
-Apply Rmult_sym.
-Pattern 1 PI; Rewrite double_var.
-Rewrite Ropp_distr1.
-Reflexivity.
-Qed.
-
-Lemma sin_decreasing_0 : (x,y:R) ``x<=3*(PI/2)``-> ``PI/2<=x`` -> ``y<=3*(PI/2)``-> ``PI/2<=y`` -> ``(sin x)<(sin y)`` -> ``y<x``.
-Intros; Rewrite <- (sin_PI_x x) in H3; Rewrite <- (sin_PI_x y) in H3; Generalize (Rlt_Ropp ``(sin (PI-x))`` ``(sin (PI-y))`` H3); Repeat Rewrite <- sin_neg; Generalize (Rle_compatibility ``-PI`` x ``3*(PI/2)`` H); Generalize (Rle_compatibility ``-PI`` ``PI/2`` x H0); Generalize (Rle_compatibility ``-PI`` y ``3*(PI/2)`` H1); Generalize (Rle_compatibility ``-PI`` ``PI/2`` y H2); Replace ``-PI+x`` with ``x-PI``.
-Replace ``-PI+PI/2`` with ``-(PI/2)``.
-Replace ``-PI+y`` with ``y-PI``.
-Replace ``-PI+3*(PI/2)`` with ``PI/2``.
-Replace ``-(PI-x)`` with ``x-PI``.
-Replace ``-(PI-y)`` with ``y-PI``.
-Intros; Change ``(sin (y-PI))<(sin (x-PI))`` in H8; Apply Rlt_anti_compatibility with ``-PI``; Rewrite Rplus_sym; Replace ``y+ (-PI)`` with ``y-PI``.
-Rewrite Rplus_sym; Replace ``x+ (-PI)`` with ``x-PI``.
-Apply (sin_increasing_0 ``y-PI`` ``x-PI`` H4 H5 H6 H7 H8).
-Reflexivity.
-Reflexivity.
-Unfold Rminus; Rewrite Ropp_distr1.
-Rewrite Ropp_Ropp.
-Apply Rplus_sym.
-Unfold Rminus; Rewrite Ropp_distr1.
-Rewrite Ropp_Ropp.
-Apply Rplus_sym.
-Pattern 2 PI; Rewrite double_var.
-Rewrite Ropp_distr1.
-Ring.
-Unfold Rminus; Apply Rplus_sym.
-Pattern 2 PI; Rewrite double_var.
-Rewrite Ropp_distr1.
-Ring.
-Unfold Rminus; Apply Rplus_sym.
-Qed.
-
-Lemma sin_decreasing_1 : (x,y:R) ``x<=3*(PI/2)``-> ``PI/2<=x`` -> ``y<=3*(PI/2)``-> ``PI/2<=y`` -> ``x<y`` -> ``(sin y)<(sin x)``.
-Intros; Rewrite <- (sin_PI_x x); Rewrite <- (sin_PI_x y); Generalize (Rle_compatibility ``-PI`` x ``3*(PI/2)`` H); Generalize (Rle_compatibility ``-PI`` ``PI/2`` x H0); Generalize (Rle_compatibility ``-PI`` y ``3*(PI/2)`` H1); Generalize (Rle_compatibility ``-PI`` ``PI/2`` y H2); Generalize (Rlt_compatibility ``-PI`` x y H3); Replace ``-PI+PI/2`` with ``-(PI/2)``.
-Replace ``-PI+y`` with ``y-PI``.
-Replace ``-PI+3*(PI/2)`` with ``PI/2``.
-Replace ``-PI+x`` with ``x-PI``.
-Intros; Apply Ropp_Rlt; Repeat Rewrite <- sin_neg; Replace ``-(PI-x)`` with ``x-PI``.
-Replace ``-(PI-y)`` with ``y-PI``.
-Apply (sin_increasing_1 ``x-PI`` ``y-PI`` H7 H8 H5 H6 H4).
-Unfold Rminus; Rewrite Ropp_distr1.
-Rewrite Ropp_Ropp.
-Apply Rplus_sym.
-Unfold Rminus; Rewrite Ropp_distr1.
-Rewrite Ropp_Ropp.
-Apply Rplus_sym.
-Unfold Rminus; Apply Rplus_sym.
-Pattern 2 PI; Rewrite double_var; Ring.
-Unfold Rminus; Apply Rplus_sym.
-Pattern 2 PI; Rewrite double_var; Ring.
-Qed.
-
-Lemma cos_increasing_0 : (x,y:R) ``PI<=x`` -> ``x<=2*PI`` ->``PI<=y`` -> ``y<=2*PI`` -> ``(cos x)<(cos y)`` -> ``x<y``.
-Intros x y H1 H2 H3 H4; Rewrite <- (cos_neg x); Rewrite <- (cos_neg y); Rewrite <- (cos_period ``-x`` (1)); Rewrite <- (cos_period ``-y`` (1)); Unfold INR; Replace ``-x+2*1*PI`` with ``PI/2-(x-3*(PI/2))``.
-Replace ``-y+2*1*PI`` with ``PI/2-(y-3*(PI/2))``.
-Repeat Rewrite cos_shift; Intro H5; Generalize (Rle_compatibility ``-3*(PI/2)`` PI x H1); Generalize (Rle_compatibility ``-3*(PI/2)`` x ``2*PI`` H2); Generalize (Rle_compatibility ``-3*(PI/2)`` PI y H3); Generalize (Rle_compatibility ``-3*(PI/2)`` y ``2*PI`` H4).
-Replace ``-3*(PI/2)+y`` with ``y-3*(PI/2)``.
-Replace ``-3*(PI/2)+x`` with ``x-3*(PI/2)``.
-Replace ``-3*(PI/2)+2*PI`` with ``PI/2``.
-Replace ``-3*PI/2+PI`` with ``-(PI/2)``.
-Clear H1 H2 H3 H4; Intros H1 H2 H3 H4; Apply Rlt_anti_compatibility with ``-3*(PI/2)``; Replace ``-3*PI/2+x`` with ``x-3*(PI/2)``.
-Replace ``-3*PI/2+y`` with ``y-3*(PI/2)``.
-Apply (sin_increasing_0 ``x-3*(PI/2)`` ``y-3*(PI/2)`` H4 H3 H2 H1 H5).
-Unfold Rminus.
-Rewrite Ropp_mul1.
-Apply Rplus_sym.
-Unfold Rminus.
-Rewrite Ropp_mul1.
-Apply Rplus_sym.
-Pattern 3 PI; Rewrite double_var.
-Ring.
-Rewrite double; Pattern 3 4 PI; Rewrite double_var.
-Ring.
-Unfold Rminus.
-Rewrite Ropp_mul1.
-Apply Rplus_sym.
-Unfold Rminus.
-Rewrite Ropp_mul1.
-Apply Rplus_sym.
-Rewrite Rmult_1r.
-Rewrite (double PI); Pattern 3 4 PI; Rewrite double_var.
-Ring.
-Rewrite Rmult_1r.
-Rewrite (double PI); Pattern 3 4 PI; Rewrite double_var.
-Ring.
-Qed.
-
-Lemma cos_increasing_1 : (x,y:R) ``PI<=x`` -> ``x<=2*PI`` ->``PI<=y`` -> ``y<=2*PI`` -> ``x<y`` -> ``(cos x)<(cos y)``.
-Intros x y H1 H2 H3 H4 H5; Generalize (Rle_compatibility ``-3*(PI/2)`` PI x H1); Generalize (Rle_compatibility ``-3*(PI/2)`` x ``2*PI`` H2); Generalize (Rle_compatibility ``-3*(PI/2)`` PI y H3); Generalize (Rle_compatibility ``-3*(PI/2)`` y ``2*PI`` H4); Generalize (Rlt_compatibility ``-3*(PI/2)`` x y H5); Rewrite <- (cos_neg x); Rewrite <- (cos_neg y); Rewrite <- (cos_period ``-x`` (1)); Rewrite <- (cos_period ``-y`` (1)); Unfold INR; Replace ``-3*(PI/2)+x`` with ``x-3*(PI/2)``.
-Replace ``-3*(PI/2)+y`` with ``y-3*(PI/2)``.
-Replace ``-3*(PI/2)+PI`` with ``-(PI/2)``.
-Replace ``-3*(PI/2)+2*PI`` with ``PI/2``.
-Clear H1 H2 H3 H4 H5; Intros H1 H2 H3 H4 H5; Replace ``-x+2*1*PI`` with ``(PI/2)-(x-3*(PI/2))``.
-Replace ``-y+2*1*PI`` with ``(PI/2)-(y-3*(PI/2))``.
-Repeat Rewrite cos_shift; Apply (sin_increasing_1 ``x-3*(PI/2)`` ``y-3*(PI/2)`` H5 H4 H3 H2 H1).
-Rewrite Rmult_1r.
-Rewrite (double PI); Pattern 3 4 PI; Rewrite double_var.
-Ring.
-Rewrite Rmult_1r.
-Rewrite (double PI); Pattern 3 4 PI; Rewrite double_var.
-Ring.
-Rewrite (double PI); Pattern 3 4 PI; Rewrite double_var.
-Ring.
-Pattern 3 PI; Rewrite double_var; Ring.
-Unfold Rminus.
-Rewrite <- Ropp_mul1.
-Apply Rplus_sym.
-Unfold Rminus.
-Rewrite <- Ropp_mul1.
-Apply Rplus_sym.
-Qed.
-
-Lemma cos_decreasing_0 : (x,y:R) ``0<=x``->``x<=PI``->``0<=y``->``y<=PI``->``(cos x)<(cos y)``->``y<x``.
-Intros; Generalize (Rlt_Ropp (cos x) (cos y) H3); Repeat Rewrite <- neg_cos; Intro H4; Change ``(cos (y+PI))<(cos (x+PI))`` in H4; Rewrite (Rplus_sym x) in H4; Rewrite (Rplus_sym y) in H4; Generalize (Rle_compatibility PI ``0`` x H); Generalize (Rle_compatibility PI x PI H0); Generalize (Rle_compatibility PI ``0`` y H1); Generalize (Rle_compatibility PI y PI H2); Rewrite Rplus_Or.
-Rewrite <- double.
-Clear H H0 H1 H2 H3; Intros; Apply Rlt_anti_compatibility with ``PI``; Apply (cos_increasing_0 ``PI+y`` ``PI+x`` H0 H H2 H1 H4).
-Qed.
-
-Lemma cos_decreasing_1 : (x,y:R) ``0<=x``->``x<=PI``->``0<=y``->``y<=PI``->``x<y``->``(cos y)<(cos x)``.
-Intros; Apply Ropp_Rlt; Repeat Rewrite <- neg_cos; Rewrite (Rplus_sym x); Rewrite (Rplus_sym y); Generalize (Rle_compatibility PI ``0`` x H); Generalize (Rle_compatibility PI x PI H0); Generalize (Rle_compatibility PI ``0`` y H1); Generalize (Rle_compatibility PI y PI H2); Rewrite Rplus_Or.
-Rewrite <- double.
-Generalize (Rlt_compatibility PI x y H3); Clear H H0 H1 H2 H3; Intros; Apply (cos_increasing_1 ``PI+x`` ``PI+y`` H3 H2 H1 H0 H).
-Qed.
-
-Lemma tan_diff : (x,y:R) ~``(cos x)==0``->~``(cos y)==0``->``(tan x)-(tan y)==(sin (x-y))/((cos x)*(cos y))``.
-Intros; Unfold tan;Rewrite sin_minus.
-Unfold Rdiv.
-Unfold Rminus.
-Rewrite Rmult_Rplus_distrl.
-Rewrite Rinv_Rmult.
-Repeat Rewrite (Rmult_sym (sin x)).
-Repeat Rewrite Rmult_assoc.
-Rewrite (Rmult_sym (cos y)).
-Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Rewrite (Rmult_sym (sin x)).
-Apply Rplus_plus_r.
-Rewrite <- Ropp_mul1.
-Rewrite <- Ropp_mul3.
-Rewrite (Rmult_sym ``/(cos x)``).
-Repeat Rewrite Rmult_assoc.
-Rewrite (Rmult_sym (cos x)).
-Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Reflexivity.
-Assumption.
-Assumption.
-Assumption.
-Assumption.
-Qed.
-
-Lemma tan_increasing_0 : (x,y:R) ``-(PI/4)<=x``->``x<=PI/4`` ->``-(PI/4)<=y``->``y<=PI/4``->``(tan x)<(tan y)``->``x<y``.
-Intros; Generalize PI4_RLT_PI2; Intro H4; Generalize (Rlt_Ropp ``PI/4`` ``PI/2`` H4); Intro H5; Change ``-(PI/2)< -(PI/4)`` in H5; Generalize (cos_gt_0 x (Rlt_le_trans ``-(PI/2)`` ``-(PI/4)`` x H5 H) (Rle_lt_trans x ``PI/4`` ``PI/2`` H0 H4)); Intro HP1; Generalize (cos_gt_0 y (Rlt_le_trans ``-(PI/2)`` ``-(PI/4)`` y H5 H1) (Rle_lt_trans y ``PI/4`` ``PI/2`` H2 H4)); Intro HP2; Generalize (not_sym ``0`` (cos x) (Rlt_not_eq ``0`` (cos x) (cos_gt_0 x (Rlt_le_trans ``-(PI/2)`` ``-(PI/4)`` x H5 H) (Rle_lt_trans x ``PI/4`` ``PI/2`` H0 H4)))); Intro H6; Generalize (not_sym ``0`` (cos y) (Rlt_not_eq ``0`` (cos y) (cos_gt_0 y (Rlt_le_trans ``-(PI/2)`` ``-(PI/4)`` y H5 H1) (Rle_lt_trans y ``PI/4`` ``PI/2`` H2 H4)))); Intro H7; Generalize (tan_diff x y H6 H7); Intro H8; Generalize (Rlt_minus (tan x) (tan y) H3); Clear H3; Intro H3; Rewrite H8 in H3; Cut ``(sin (x-y))<0``.
-Intro H9; Generalize (Rle_Ropp ``-(PI/4)`` y H1); Rewrite Ropp_Ropp; Intro H10; Generalize (Rle_sym2 ``-y`` ``PI/4`` H10); Clear H10; Intro H10; Generalize (Rle_Ropp y ``PI/4`` H2); Intro H11; Generalize (Rle_sym2 ``-(PI/4)`` ``-y`` H11); Clear H11; Intro H11; Generalize (Rplus_le ``-(PI/4)`` x ``-(PI/4)`` ``-y`` H H11); Generalize (Rplus_le x ``PI/4`` ``-y`` ``PI/4`` H0 H10); Replace ``x+ -y`` with ``x-y``.
-Replace ``PI/4+PI/4`` with ``PI/2``.
-Replace ``-(PI/4)+ -(PI/4)`` with ``-(PI/2)``.
-Intros; Case (total_order ``0`` ``x-y``); Intro H14.
-Generalize (sin_gt_0 ``x-y`` H14 (Rle_lt_trans ``x-y`` ``PI/2`` PI H12 PI2_Rlt_PI)); Intro H15; Elim (Rlt_antirefl ``0`` (Rlt_trans ``0`` ``(sin (x-y))`` ``0`` H15 H9)).
-Elim H14; Intro H15.
-Rewrite <- H15 in H9; Rewrite -> sin_0 in H9; Elim (Rlt_antirefl ``0`` H9).
-Apply Rminus_lt; Assumption.
-Pattern 1 PI; Rewrite double_var.
-Unfold Rdiv.
-Rewrite Rmult_Rplus_distrl.
-Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_Rmult.
-Rewrite Ropp_distr1.
-Replace ``2*2`` with ``4``.
-Reflexivity.
-Ring.
-DiscrR.
-DiscrR.
-Pattern 1 PI; Rewrite double_var.
-Unfold Rdiv.
-Rewrite Rmult_Rplus_distrl.
-Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_Rmult.
-Replace ``2*2`` with ``4``.
-Reflexivity.
-Ring.
-DiscrR.
-DiscrR.
-Reflexivity.
-Case (case_Rabsolu ``(sin (x-y))``); Intro H9.
-Assumption.
-Generalize (Rle_sym2 ``0`` ``(sin (x-y))`` H9); Clear H9; Intro H9; Generalize (Rlt_Rinv (cos x) HP1); Intro H10; Generalize (Rlt_Rinv (cos y) HP2); Intro H11; Generalize (Rmult_lt_pos (Rinv (cos x)) (Rinv (cos y)) H10 H11); Replace ``/(cos x)*/(cos y)`` with ``/((cos x)*(cos y))``.
-Intro H12; Generalize (Rmult_le_pos ``(sin (x-y))`` ``/((cos x)*(cos y))`` H9 (Rlt_le ``0`` ``/((cos x)*(cos y))`` H12)); Intro H13; Elim (Rlt_antirefl ``0`` (Rle_lt_trans ``0`` ``(sin (x-y))*/((cos x)*(cos y))`` ``0`` H13 H3)).
-Rewrite Rinv_Rmult.
-Reflexivity.
-Assumption.
-Assumption.
-Qed.
-
-Lemma tan_increasing_1 : (x,y:R) ``-(PI/4)<=x``->``x<=PI/4`` ->``-(PI/4)<=y``->``y<=PI/4``->``x<y``->``(tan x)<(tan y)``.
-Intros; Apply Rminus_lt; Generalize PI4_RLT_PI2; Intro H4; Generalize (Rlt_Ropp ``PI/4`` ``PI/2`` H4); Intro H5; Change ``-(PI/2)< -(PI/4)`` in H5; Generalize (cos_gt_0 x (Rlt_le_trans ``-(PI/2)`` ``-(PI/4)`` x H5 H) (Rle_lt_trans x ``PI/4`` ``PI/2`` H0 H4)); Intro HP1; Generalize (cos_gt_0 y (Rlt_le_trans ``-(PI/2)`` ``-(PI/4)`` y H5 H1) (Rle_lt_trans y ``PI/4`` ``PI/2`` H2 H4)); Intro HP2; Generalize (not_sym ``0`` (cos x) (Rlt_not_eq ``0`` (cos x) (cos_gt_0 x (Rlt_le_trans ``-(PI/2)`` ``-(PI/4)`` x H5 H) (Rle_lt_trans x ``PI/4`` ``PI/2`` H0 H4)))); Intro H6; Generalize (not_sym ``0`` (cos y) (Rlt_not_eq ``0`` (cos y) (cos_gt_0 y (Rlt_le_trans ``-(PI/2)`` ``-(PI/4)`` y H5 H1) (Rle_lt_trans y ``PI/4`` ``PI/2`` H2 H4)))); Intro H7; Rewrite (tan_diff x y H6 H7); Generalize (Rlt_Rinv (cos x) HP1); Intro H10; Generalize (Rlt_Rinv (cos y) HP2); Intro H11; Generalize (Rmult_lt_pos (Rinv (cos x)) (Rinv (cos y)) H10 H11); Replace ``/(cos x)*/(cos y)`` with ``/((cos x)*(cos y))``.
-Clear H10 H11; Intro H8; Generalize (Rle_Ropp y ``PI/4`` H2); Intro H11; Generalize (Rle_sym2 ``-(PI/4)`` ``-y`` H11); Clear H11; Intro H11; Generalize (Rplus_le ``-(PI/4)`` x ``-(PI/4)`` ``-y`` H H11); Replace ``x+ -y`` with ``x-y``.
-Replace ``-(PI/4)+ -(PI/4)`` with ``-(PI/2)``.
-Clear H11; Intro H9; Generalize (Rlt_minus x y H3); Clear H3; Intro H3; Clear H H0 H1 H2 H4 H5 HP1 HP2; Generalize PI2_Rlt_PI; Intro H1; Generalize (Rlt_Ropp ``PI/2`` PI H1); Clear H1; Intro H1; Generalize (sin_lt_0_var ``x-y`` (Rlt_le_trans ``-PI`` ``-(PI/2)`` ``x-y`` H1 H9) H3); Intro H2; Generalize (Rlt_anti_monotony ``(sin (x-y))`` ``0`` ``/((cos x)*(cos y))`` H2 H8); Rewrite Rmult_Or; Intro H4; Assumption.
-Pattern 1 PI; Rewrite double_var.
-Unfold Rdiv.
-Rewrite Rmult_Rplus_distrl.
-Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_Rmult.
-Replace ``2*2`` with ``4``.
-Rewrite Ropp_distr1.
-Reflexivity.
-Ring.
-DiscrR.
-DiscrR.
-Reflexivity.
-Apply Rinv_Rmult; Assumption.
-Qed.
-
-Lemma sin_incr_0 : (x,y:R) ``-(PI/2)<=x``->``x<=PI/2``->``-(PI/2)<=y``->``y<=PI/2``->``(sin x)<=(sin y)``->``x<=y``.
-Intros; Case (total_order (sin x) (sin y)); Intro H4; [Left; Apply (sin_increasing_0 x y H H0 H1 H2 H4) | Elim H4; Intro H5; [Case (total_order x y); Intro H6; [Left; Assumption | Elim H6; Intro H7; [Right; Assumption | Generalize (sin_increasing_1 y x H1 H2 H H0 H7); Intro H8; Rewrite H5 in H8; Elim (Rlt_antirefl (sin y) H8)]] | Elim (Rlt_antirefl (sin x) (Rle_lt_trans (sin x) (sin y) (sin x) H3 H5))]].
-Qed.
-
-Lemma sin_incr_1 : (x,y:R) ``-(PI/2)<=x``->``x<=PI/2``->``-(PI/2)<=y``->``y<=PI/2``->``x<=y``->``(sin x)<=(sin y)``.
-Intros; Case (total_order x y); Intro H4; [Left; Apply (sin_increasing_1 x y H H0 H1 H2 H4) | Elim H4; Intro H5; [Case (total_order (sin x) (sin y)); Intro H6; [Left; Assumption | Elim H6; Intro H7; [Right; Assumption | Generalize (sin_increasing_0 y x H1 H2 H H0 H7); Intro H8; Rewrite H5 in H8; Elim (Rlt_antirefl y H8)]] | Elim (Rlt_antirefl x (Rle_lt_trans x y x H3 H5))]].
-Qed.
-
-Lemma sin_decr_0 : (x,y:R) ``x<=3*(PI/2)``->``PI/2<=x``->``y<=3*(PI/2)``->``PI/2<=y``-> ``(sin x)<=(sin y)`` -> ``y<=x``.
-Intros; Case (total_order (sin x) (sin y)); Intro H4; [Left; Apply (sin_decreasing_0 x y H H0 H1 H2 H4) | Elim H4; Intro H5; [Case (total_order x y); Intro H6; [Generalize (sin_decreasing_1 x y H H0 H1 H2 H6); Intro H8; Rewrite H5 in H8; Elim (Rlt_antirefl (sin y) H8) | Elim H6; Intro H7; [Right; Symmetry; Assumption | Left; Assumption]] | Elim (Rlt_antirefl (sin x) (Rle_lt_trans (sin x) (sin y) (sin x) H3 H5))]].
-Qed.
-
-Lemma sin_decr_1 : (x,y:R) ``x<=3*(PI/2)``-> ``PI/2<=x`` -> ``y<=3*(PI/2)``-> ``PI/2<=y`` -> ``x<=y`` -> ``(sin y)<=(sin x)``.
-Intros; Case (total_order x y); Intro H4; [Left; Apply (sin_decreasing_1 x y H H0 H1 H2 H4) | Elim H4; Intro H5; [Case (total_order (sin x) (sin y)); Intro H6; [Generalize (sin_decreasing_0 x y H H0 H1 H2 H6); Intro H8; Rewrite H5 in H8; Elim (Rlt_antirefl y H8) | Elim H6; Intro H7; [Right; Symmetry; Assumption | Left; Assumption]] | Elim (Rlt_antirefl x (Rle_lt_trans x y x H3 H5))]].
-Qed.
-
-Lemma cos_incr_0 : (x,y:R) ``PI<=x`` -> ``x<=2*PI`` ->``PI<=y`` -> ``y<=2*PI`` -> ``(cos x)<=(cos y)`` -> ``x<=y``.
-Intros; Case (total_order (cos x) (cos y)); Intro H4; [Left; Apply (cos_increasing_0 x y H H0 H1 H2 H4) | Elim H4; Intro H5; [Case (total_order x y); Intro H6; [Left; Assumption | Elim H6; Intro H7; [Right; Assumption | Generalize (cos_increasing_1 y x H1 H2 H H0 H7); Intro H8; Rewrite H5 in H8; Elim (Rlt_antirefl (cos y) H8)]] | Elim (Rlt_antirefl (cos x) (Rle_lt_trans (cos x) (cos y) (cos x) H3 H5))]].
-Qed.
-
-Lemma cos_incr_1 : (x,y:R) ``PI<=x`` -> ``x<=2*PI`` ->``PI<=y`` -> ``y<=2*PI`` -> ``x<=y`` -> ``(cos x)<=(cos y)``.
-Intros; Case (total_order x y); Intro H4; [Left; Apply (cos_increasing_1 x y H H0 H1 H2 H4) | Elim H4; Intro H5; [Case (total_order (cos x) (cos y)); Intro H6; [Left; Assumption | Elim H6; Intro H7; [Right; Assumption | Generalize (cos_increasing_0 y x H1 H2 H H0 H7); Intro H8; Rewrite H5 in H8; Elim (Rlt_antirefl y H8)]] | Elim (Rlt_antirefl x (Rle_lt_trans x y x H3 H5))]].
-Qed.
-
-Lemma cos_decr_0 : (x,y:R) ``0<=x``->``x<=PI``->``0<=y``->``y<=PI``->``(cos x)<=(cos y)`` -> ``y<=x``.
-Intros; Case (total_order (cos x) (cos y)); Intro H4; [Left; Apply (cos_decreasing_0 x y H H0 H1 H2 H4) | Elim H4; Intro H5; [Case (total_order x y); Intro H6; [Generalize (cos_decreasing_1 x y H H0 H1 H2 H6); Intro H8; Rewrite H5 in H8; Elim (Rlt_antirefl (cos y) H8) | Elim H6; Intro H7; [Right; Symmetry; Assumption | Left; Assumption]] | Elim (Rlt_antirefl (cos x) (Rle_lt_trans (cos x) (cos y) (cos x) H3 H5))]].
-Qed.
-
-Lemma cos_decr_1 : (x,y:R) ``0<=x``->``x<=PI``->``0<=y``->``y<=PI``->``x<=y``->``(cos y)<=(cos x)``.
-Intros; Case (total_order x y); Intro H4; [Left; Apply (cos_decreasing_1 x y H H0 H1 H2 H4) | Elim H4; Intro H5; [Case (total_order (cos x) (cos y)); Intro H6; [Generalize (cos_decreasing_0 x y H H0 H1 H2 H6); Intro H8; Rewrite H5 in H8; Elim (Rlt_antirefl y H8) | Elim H6; Intro H7; [Right; Symmetry; Assumption | Left; Assumption]] | Elim (Rlt_antirefl x (Rle_lt_trans x y x H3 H5))]].
-Qed.
-
-Lemma tan_incr_0 : (x,y:R) ``-(PI/4)<=x``->``x<=PI/4`` ->``-(PI/4)<=y``->``y<=PI/4``->``(tan x)<=(tan y)``->``x<=y``.
-Intros; Case (total_order (tan x) (tan y)); Intro H4; [Left; Apply (tan_increasing_0 x y H H0 H1 H2 H4) | Elim H4; Intro H5; [Case (total_order x y); Intro H6; [Left; Assumption | Elim H6; Intro H7; [Right; Assumption | Generalize (tan_increasing_1 y x H1 H2 H H0 H7); Intro H8; Rewrite H5 in H8; Elim (Rlt_antirefl (tan y) H8)]] | Elim (Rlt_antirefl (tan x) (Rle_lt_trans (tan x) (tan y) (tan x) H3 H5))]].
-Qed.
-
-Lemma tan_incr_1 : (x,y:R) ``-(PI/4)<=x``->``x<=PI/4`` ->``-(PI/4)<=y``->``y<=PI/4``->``x<=y``->``(tan x)<=(tan y)``.
-Intros; Case (total_order x y); Intro H4; [Left; Apply (tan_increasing_1 x y H H0 H1 H2 H4) | Elim H4; Intro H5; [Case (total_order (tan x) (tan y)); Intro H6; [Left; Assumption | Elim H6; Intro H7; [Right; Assumption | Generalize (tan_increasing_0 y x H1 H2 H H0 H7); Intro H8; Rewrite H5 in H8; Elim (Rlt_antirefl y H8)]] | Elim (Rlt_antirefl x (Rle_lt_trans x y x H3 H5))]].
+Theorem sin_gt_0 : forall x:R, 0 < x -> x < PI -> 0 < sin x.
+intros; elim (SIN x (Rlt_le 0 x H) (Rlt_le x PI H0)); intros H1 _;
+ case (Rtotal_order x (PI / 2)); intro H2.
+apply Rlt_le_trans with (sin_lb x).
+apply sin_lb_gt_0; [ assumption | left; assumption ].
+assumption.
+elim H2; intro H3.
+rewrite H3; rewrite sin_PI2; apply Rlt_0_1.
+rewrite <- sin_PI_x; generalize (Ropp_gt_lt_contravar x (PI / 2) H3);
+ intro H4; generalize (Rplus_lt_compat_l PI (- x) (- (PI / 2)) H4).
+replace (PI + - x) with (PI - x).
+replace (PI + - (PI / 2)) with (PI / 2).
+intro H5; generalize (Ropp_lt_gt_contravar x PI H0); intro H6;
+ change (- PI < - x) in H6; generalize (Rplus_lt_compat_l PI (- PI) (- x) H6).
+rewrite Rplus_opp_r.
+replace (PI + - x) with (PI - x).
+intro H7;
+ elim
+ (SIN (PI - x) (Rlt_le 0 (PI - x) H7)
+ (Rlt_le (PI - x) PI (Rlt_trans (PI - x) (PI / 2) PI H5 PI2_Rlt_PI)));
+ intros H8 _;
+ generalize (sin_lb_gt_0 (PI - x) H7 (Rlt_le (PI - x) (PI / 2) H5));
+ intro H9; apply (Rlt_le_trans 0 (sin_lb (PI - x)) (sin (PI - x)) H9 H8).
+reflexivity.
+pattern PI at 2 in |- *; rewrite double_var; ring.
+reflexivity.
+Qed.
+
+Theorem cos_gt_0 : forall x:R, - (PI / 2) < x -> x < PI / 2 -> 0 < cos x.
+intros; rewrite cos_sin;
+ generalize (Rplus_lt_compat_l (PI / 2) (- (PI / 2)) x H).
+rewrite Rplus_opp_r; intro H1;
+ generalize (Rplus_lt_compat_l (PI / 2) x (PI / 2) H0);
+ rewrite <- double_var; intro H2; apply (sin_gt_0 (PI / 2 + x) H1 H2).
+Qed.
+
+Lemma sin_ge_0 : forall x:R, 0 <= x -> x <= PI -> 0 <= sin x.
+intros x H1 H2; elim H1; intro H3;
+ [ elim H2; intro H4;
+ [ left; apply (sin_gt_0 x H3 H4)
+ | rewrite H4; right; symmetry in |- *; apply sin_PI ]
+ | rewrite <- H3; right; symmetry in |- *; apply sin_0 ].
+Qed.
+
+Lemma cos_ge_0 : forall x:R, - (PI / 2) <= x -> x <= PI / 2 -> 0 <= cos x.
+intros x H1 H2; elim H1; intro H3;
+ [ elim H2; intro H4;
+ [ left; apply (cos_gt_0 x H3 H4)
+ | rewrite H4; right; symmetry in |- *; apply cos_PI2 ]
+ | rewrite <- H3; rewrite cos_neg; right; symmetry in |- *; apply cos_PI2 ].
+Qed.
+
+Lemma sin_le_0 : forall x:R, PI <= x -> x <= 2 * PI -> sin x <= 0.
+intros x H1 H2; apply Rge_le; rewrite <- Ropp_0;
+ rewrite <- (Ropp_involutive (sin x)); apply Ropp_le_ge_contravar;
+ rewrite <- neg_sin; replace (x + PI) with (x - PI + 2 * INR 1 * PI);
+ [ rewrite (sin_period (x - PI) 1); apply sin_ge_0;
+ [ replace (x - PI) with (x + - PI);
+ [ rewrite Rplus_comm; replace 0 with (- PI + PI);
+ [ apply Rplus_le_compat_l; assumption | ring ]
+ | ring ]
+ | replace (x - PI) with (x + - PI); rewrite Rplus_comm;
+ [ pattern PI at 2 in |- *; replace PI with (- PI + 2 * PI);
+ [ apply Rplus_le_compat_l; assumption | ring ]
+ | ring ] ]
+ | unfold INR in |- *; ring ].
+Qed.
+
+Lemma cos_le_0 : forall x:R, PI / 2 <= x -> x <= 3 * (PI / 2) -> cos x <= 0.
+intros x H1 H2; apply Rge_le; rewrite <- Ropp_0;
+ rewrite <- (Ropp_involutive (cos x)); apply Ropp_le_ge_contravar;
+ rewrite <- neg_cos; replace (x + PI) with (x - PI + 2 * INR 1 * PI).
+rewrite cos_period; apply cos_ge_0.
+replace (- (PI / 2)) with (- PI + PI / 2).
+unfold Rminus in |- *; rewrite (Rplus_comm x); apply Rplus_le_compat_l;
+ assumption.
+pattern PI at 1 in |- *; rewrite (double_var PI); rewrite Ropp_plus_distr;
+ ring.
+unfold Rminus in |- *; rewrite Rplus_comm;
+ replace (PI / 2) with (- PI + 3 * (PI / 2)).
+apply Rplus_le_compat_l; assumption.
+pattern PI at 1 in |- *; rewrite (double_var PI); rewrite Ropp_plus_distr;
+ ring.
+unfold INR in |- *; ring.
+Qed.
+
+Lemma sin_lt_0 : forall x:R, PI < x -> x < 2 * PI -> sin x < 0.
+intros x H1 H2; rewrite <- Ropp_0; rewrite <- (Ropp_involutive (sin x));
+ apply Ropp_lt_gt_contravar; rewrite <- neg_sin;
+ replace (x + PI) with (x - PI + 2 * INR 1 * PI);
+ [ rewrite (sin_period (x - PI) 1); apply sin_gt_0;
+ [ replace (x - PI) with (x + - PI);
+ [ rewrite Rplus_comm; replace 0 with (- PI + PI);
+ [ apply Rplus_lt_compat_l; assumption | ring ]
+ | ring ]
+ | replace (x - PI) with (x + - PI); rewrite Rplus_comm;
+ [ pattern PI at 2 in |- *; replace PI with (- PI + 2 * PI);
+ [ apply Rplus_lt_compat_l; assumption | ring ]
+ | ring ] ]
+ | unfold INR in |- *; ring ].
+Qed.
+
+Lemma sin_lt_0_var : forall x:R, - PI < x -> x < 0 -> sin x < 0.
+intros; generalize (Rplus_lt_compat_l (2 * PI) (- PI) x H);
+ replace (2 * PI + - PI) with PI;
+ [ intro H1; rewrite Rplus_comm in H1;
+ generalize (Rplus_lt_compat_l (2 * PI) x 0 H0);
+ intro H2; rewrite (Rplus_comm (2 * PI)) in H2;
+ rewrite <- (Rplus_comm 0) in H2; rewrite Rplus_0_l in H2;
+ rewrite <- (sin_period x 1); unfold INR in |- *;
+ replace (2 * 1 * PI) with (2 * PI);
+ [ apply (sin_lt_0 (x + 2 * PI) H1 H2) | ring ]
+ | ring ].
+Qed.
+
+Lemma cos_lt_0 : forall x:R, PI / 2 < x -> x < 3 * (PI / 2) -> cos x < 0.
+intros x H1 H2; rewrite <- Ropp_0; rewrite <- (Ropp_involutive (cos x));
+ apply Ropp_lt_gt_contravar; rewrite <- neg_cos;
+ replace (x + PI) with (x - PI + 2 * INR 1 * PI).
+rewrite cos_period; apply cos_gt_0.
+replace (- (PI / 2)) with (- PI + PI / 2).
+unfold Rminus in |- *; rewrite (Rplus_comm x); apply Rplus_lt_compat_l;
+ assumption.
+pattern PI at 1 in |- *; rewrite (double_var PI); rewrite Ropp_plus_distr;
+ ring.
+unfold Rminus in |- *; rewrite Rplus_comm;
+ replace (PI / 2) with (- PI + 3 * (PI / 2)).
+apply Rplus_lt_compat_l; assumption.
+pattern PI at 1 in |- *; rewrite (double_var PI); rewrite Ropp_plus_distr;
+ ring.
+unfold INR in |- *; ring.
+Qed.
+
+Lemma tan_gt_0 : forall x:R, 0 < x -> x < PI / 2 -> 0 < tan x.
+intros x H1 H2; unfold tan in |- *; generalize _PI2_RLT_0;
+ generalize (Rlt_trans 0 x (PI / 2) H1 H2); intros;
+ generalize (Rlt_trans (- (PI / 2)) 0 x H0 H1); intro H5;
+ generalize (Rlt_trans x (PI / 2) PI H2 PI2_Rlt_PI);
+ intro H7; unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+apply sin_gt_0; assumption.
+apply Rinv_0_lt_compat; apply cos_gt_0; assumption.
+Qed.
+
+Lemma tan_lt_0 : forall x:R, - (PI / 2) < x -> x < 0 -> tan x < 0.
+intros x H1 H2; unfold tan in |- *;
+ generalize (cos_gt_0 x H1 (Rlt_trans x 0 (PI / 2) H2 PI2_RGT_0));
+ intro H3; rewrite <- Ropp_0;
+ replace (sin x / cos x) with (- (- sin x / cos x)).
+rewrite <- sin_neg; apply Ropp_gt_lt_contravar;
+ change (0 < sin (- x) / cos x) in |- *; unfold Rdiv in |- *;
+ apply Rmult_lt_0_compat.
+apply sin_gt_0.
+rewrite <- Ropp_0; apply Ropp_gt_lt_contravar; assumption.
+apply Rlt_trans with (PI / 2).
+rewrite <- (Ropp_involutive (PI / 2)); apply Ropp_gt_lt_contravar; assumption.
+apply PI2_Rlt_PI.
+apply Rinv_0_lt_compat; assumption.
+unfold Rdiv in |- *; ring.
+Qed.
+
+Lemma cos_ge_0_3PI2 :
+ forall x:R, 3 * (PI / 2) <= x -> x <= 2 * PI -> 0 <= cos x.
+intros; rewrite <- cos_neg; rewrite <- (cos_period (- x) 1);
+ unfold INR in |- *; replace (- x + 2 * 1 * PI) with (2 * PI - x).
+generalize (Ropp_le_ge_contravar x (2 * PI) H0); intro H1;
+ generalize (Rge_le (- x) (- (2 * PI)) H1); clear H1;
+ intro H1; generalize (Rplus_le_compat_l (2 * PI) (- (2 * PI)) (- x) H1).
+rewrite Rplus_opp_r.
+intro H2; generalize (Ropp_le_ge_contravar (3 * (PI / 2)) x H); intro H3;
+ generalize (Rge_le (- (3 * (PI / 2))) (- x) H3); clear H3;
+ intro H3;
+ generalize (Rplus_le_compat_l (2 * PI) (- x) (- (3 * (PI / 2))) H3).
+replace (2 * PI + - (3 * (PI / 2))) with (PI / 2).
+intro H4;
+ apply
+ (cos_ge_0 (2 * PI - x)
+ (Rlt_le (- (PI / 2)) (2 * PI - x)
+ (Rlt_le_trans (- (PI / 2)) 0 (2 * PI - x) _PI2_RLT_0 H2)) H4).
+rewrite double; pattern PI at 2 3 in |- *; rewrite double_var; ring.
+ring.
+Qed.
+
+Lemma form1 :
+ forall p q:R, cos p + cos q = 2 * cos ((p - q) / 2) * cos ((p + q) / 2).
+intros p q; pattern p at 1 in |- *;
+ replace p with ((p - q) / 2 + (p + q) / 2).
+rewrite <- (cos_neg q); replace (- q) with ((p - q) / 2 - (p + q) / 2).
+rewrite cos_plus; rewrite cos_minus; ring.
+pattern q at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
+pattern p at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
+Qed.
+
+Lemma form2 :
+ forall p q:R, cos p - cos q = -2 * sin ((p - q) / 2) * sin ((p + q) / 2).
+intros p q; pattern p at 1 in |- *;
+ replace p with ((p - q) / 2 + (p + q) / 2).
+rewrite <- (cos_neg q); replace (- q) with ((p - q) / 2 - (p + q) / 2).
+rewrite cos_plus; rewrite cos_minus; ring.
+pattern q at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
+pattern p at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
+Qed.
+
+Lemma form3 :
+ forall p q:R, sin p + sin q = 2 * cos ((p - q) / 2) * sin ((p + q) / 2).
+intros p q; pattern p at 1 in |- *;
+ replace p with ((p - q) / 2 + (p + q) / 2).
+pattern q at 3 in |- *; replace q with ((p + q) / 2 - (p - q) / 2).
+rewrite sin_plus; rewrite sin_minus; ring.
+pattern q at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
+pattern p at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
+Qed.
+
+Lemma form4 :
+ forall p q:R, sin p - sin q = 2 * cos ((p + q) / 2) * sin ((p - q) / 2).
+intros p q; pattern p at 1 in |- *;
+ replace p with ((p - q) / 2 + (p + q) / 2).
+pattern q at 3 in |- *; replace q with ((p + q) / 2 - (p - q) / 2).
+rewrite sin_plus; rewrite sin_minus; ring.
+pattern q at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
+pattern p at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
+
+Qed.
+
+Lemma sin_increasing_0 :
+ forall x y:R,
+ - (PI / 2) <= x ->
+ x <= PI / 2 -> - (PI / 2) <= y -> y <= PI / 2 -> sin x < sin y -> x < y.
+intros; cut (sin ((x - y) / 2) < 0).
+intro H4; case (Rtotal_order ((x - y) / 2) 0); intro H5.
+assert (Hyp : 0 < 2).
+prove_sup0.
+generalize (Rmult_lt_compat_l 2 ((x - y) / 2) 0 Hyp H5).
+unfold Rdiv in |- *.
+rewrite <- Rmult_assoc.
+rewrite Rinv_r_simpl_m.
+rewrite Rmult_0_r.
+clear H5; intro H5; apply Rminus_lt; assumption.
+discrR.
+elim H5; intro H6.
+rewrite H6 in H4; rewrite sin_0 in H4; elim (Rlt_irrefl 0 H4).
+change (0 < (x - y) / 2) in H6;
+ generalize (Ropp_le_ge_contravar (- (PI / 2)) y H1).
+rewrite Ropp_involutive.
+intro H7; generalize (Rge_le (PI / 2) (- y) H7); clear H7; intro H7;
+ generalize (Rplus_le_compat x (PI / 2) (- y) (PI / 2) H0 H7).
+rewrite <- double_var.
+intro H8.
+assert (Hyp : 0 < 2).
+prove_sup0.
+generalize
+ (Rmult_le_compat_l (/ 2) (x - y) PI
+ (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H8).
+repeat rewrite (Rmult_comm (/ 2)).
+intro H9;
+ generalize
+ (sin_gt_0 ((x - y) / 2) H6
+ (Rle_lt_trans ((x - y) / 2) (PI / 2) PI H9 PI2_Rlt_PI));
+ intro H10;
+ elim
+ (Rlt_irrefl (sin ((x - y) / 2))
+ (Rlt_trans (sin ((x - y) / 2)) 0 (sin ((x - y) / 2)) H4 H10)).
+generalize (Rlt_minus (sin x) (sin y) H3); clear H3; intro H3;
+ rewrite form4 in H3;
+ generalize (Rplus_le_compat x (PI / 2) y (PI / 2) H0 H2).
+rewrite <- double_var.
+assert (Hyp : 0 < 2).
+prove_sup0.
+intro H4;
+ generalize
+ (Rmult_le_compat_l (/ 2) (x + y) PI
+ (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H4).
+repeat rewrite (Rmult_comm (/ 2)).
+clear H4; intro H4;
+ generalize (Rplus_le_compat (- (PI / 2)) x (- (PI / 2)) y H H1);
+ replace (- (PI / 2) + - (PI / 2)) with (- PI).
+intro H5;
+ generalize
+ (Rmult_le_compat_l (/ 2) (- PI) (x + y)
+ (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H5).
+replace (/ 2 * (x + y)) with ((x + y) / 2).
+replace (/ 2 * - PI) with (- (PI / 2)).
+clear H5; intro H5; elim H4; intro H40.
+elim H5; intro H50.
+generalize (cos_gt_0 ((x + y) / 2) H50 H40); intro H6;
+ generalize (Rmult_lt_compat_l 2 0 (cos ((x + y) / 2)) Hyp H6).
+rewrite Rmult_0_r.
+clear H6; intro H6; case (Rcase_abs (sin ((x - y) / 2))); intro H7.
+assumption.
+generalize (Rge_le (sin ((x - y) / 2)) 0 H7); clear H7; intro H7;
+ generalize
+ (Rmult_le_pos (2 * cos ((x + y) / 2)) (sin ((x - y) / 2))
+ (Rlt_le 0 (2 * cos ((x + y) / 2)) H6) H7); intro H8;
+ generalize
+ (Rle_lt_trans 0 (2 * cos ((x + y) / 2) * sin ((x - y) / 2)) 0 H8 H3);
+ intro H9; elim (Rlt_irrefl 0 H9).
+rewrite <- H50 in H3; rewrite cos_neg in H3; rewrite cos_PI2 in H3;
+ rewrite Rmult_0_r in H3; rewrite Rmult_0_l in H3;
+ elim (Rlt_irrefl 0 H3).
+unfold Rdiv in H3.
+rewrite H40 in H3; assert (H50 := cos_PI2); unfold Rdiv in H50;
+ rewrite H50 in H3; rewrite Rmult_0_r in H3; rewrite Rmult_0_l in H3;
+ elim (Rlt_irrefl 0 H3).
+unfold Rdiv in |- *.
+rewrite <- Ropp_mult_distr_l_reverse.
+apply Rmult_comm.
+unfold Rdiv in |- *; apply Rmult_comm.
+pattern PI at 1 in |- *; rewrite double_var.
+rewrite Ropp_plus_distr.
+reflexivity.
+Qed.
+
+Lemma sin_increasing_1 :
+ forall x y:R,
+ - (PI / 2) <= x ->
+ x <= PI / 2 -> - (PI / 2) <= y -> y <= PI / 2 -> x < y -> sin x < sin y.
+intros; generalize (Rplus_lt_compat_l x x y H3); intro H4;
+ generalize (Rplus_le_compat (- (PI / 2)) x (- (PI / 2)) x H H);
+ replace (- (PI / 2) + - (PI / 2)) with (- PI).
+assert (Hyp : 0 < 2).
+prove_sup0.
+intro H5; generalize (Rle_lt_trans (- PI) (x + x) (x + y) H5 H4); intro H6;
+ generalize
+ (Rmult_lt_compat_l (/ 2) (- PI) (x + y) (Rinv_0_lt_compat 2 Hyp) H6);
+ replace (/ 2 * - PI) with (- (PI / 2)).
+replace (/ 2 * (x + y)) with ((x + y) / 2).
+clear H4 H5 H6; intro H4; generalize (Rplus_lt_compat_l y x y H3); intro H5;
+ rewrite Rplus_comm in H5;
+ generalize (Rplus_le_compat y (PI / 2) y (PI / 2) H2 H2).
+rewrite <- double_var.
+intro H6; generalize (Rlt_le_trans (x + y) (y + y) PI H5 H6); intro H7;
+ generalize (Rmult_lt_compat_l (/ 2) (x + y) PI (Rinv_0_lt_compat 2 Hyp) H7);
+ replace (/ 2 * PI) with (PI / 2).
+replace (/ 2 * (x + y)) with ((x + y) / 2).
+clear H5 H6 H7; intro H5; generalize (Ropp_le_ge_contravar (- (PI / 2)) y H1);
+ rewrite Ropp_involutive; clear H1; intro H1;
+ generalize (Rge_le (PI / 2) (- y) H1); clear H1; intro H1;
+ generalize (Ropp_le_ge_contravar y (PI / 2) H2); clear H2;
+ intro H2; generalize (Rge_le (- y) (- (PI / 2)) H2);
+ clear H2; intro H2; generalize (Rplus_lt_compat_l (- y) x y H3);
+ replace (- y + x) with (x - y).
+rewrite Rplus_opp_l.
+intro H6;
+ generalize (Rmult_lt_compat_l (/ 2) (x - y) 0 (Rinv_0_lt_compat 2 Hyp) H6);
+ rewrite Rmult_0_r; replace (/ 2 * (x - y)) with ((x - y) / 2).
+clear H6; intro H6;
+ generalize (Rplus_le_compat (- (PI / 2)) x (- (PI / 2)) (- y) H H2);
+ replace (- (PI / 2) + - (PI / 2)) with (- PI).
+replace (x + - y) with (x - y).
+intro H7;
+ generalize
+ (Rmult_le_compat_l (/ 2) (- PI) (x - y)
+ (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H7);
+ replace (/ 2 * - PI) with (- (PI / 2)).
+replace (/ 2 * (x - y)) with ((x - y) / 2).
+clear H7; intro H7; clear H H0 H1 H2; apply Rminus_lt; rewrite form4;
+ generalize (cos_gt_0 ((x + y) / 2) H4 H5); intro H8;
+ generalize (Rmult_lt_0_compat 2 (cos ((x + y) / 2)) Hyp H8);
+ clear H8; intro H8; cut (- PI < - (PI / 2)).
+intro H9;
+ generalize
+ (sin_lt_0_var ((x - y) / 2)
+ (Rlt_le_trans (- PI) (- (PI / 2)) ((x - y) / 2) H9 H7) H6);
+ intro H10;
+ generalize
+ (Rmult_lt_gt_compat_neg_l (sin ((x - y) / 2)) 0 (
+ 2 * cos ((x + y) / 2)) H10 H8); intro H11; rewrite Rmult_0_r in H11;
+ rewrite Rmult_comm; assumption.
+apply Ropp_lt_gt_contravar; apply PI2_Rlt_PI.
+unfold Rdiv in |- *; apply Rmult_comm.
+unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse; apply Rmult_comm.
+reflexivity.
+pattern PI at 1 in |- *; rewrite double_var.
+rewrite Ropp_plus_distr.
+reflexivity.
+unfold Rdiv in |- *; apply Rmult_comm.
+unfold Rminus in |- *; apply Rplus_comm.
+unfold Rdiv in |- *; apply Rmult_comm.
+unfold Rdiv in |- *; apply Rmult_comm.
+unfold Rdiv in |- *; apply Rmult_comm.
+unfold Rdiv in |- *.
+rewrite <- Ropp_mult_distr_l_reverse.
+apply Rmult_comm.
+pattern PI at 1 in |- *; rewrite double_var.
+rewrite Ropp_plus_distr.
+reflexivity.
+Qed.
+
+Lemma sin_decreasing_0 :
+ forall x y:R,
+ x <= 3 * (PI / 2) ->
+ PI / 2 <= x -> y <= 3 * (PI / 2) -> PI / 2 <= y -> sin x < sin y -> y < x.
+intros; rewrite <- (sin_PI_x x) in H3; rewrite <- (sin_PI_x y) in H3;
+ generalize (Ropp_lt_gt_contravar (sin (PI - x)) (sin (PI - y)) H3);
+ repeat rewrite <- sin_neg;
+ generalize (Rplus_le_compat_l (- PI) x (3 * (PI / 2)) H);
+ generalize (Rplus_le_compat_l (- PI) (PI / 2) x H0);
+ generalize (Rplus_le_compat_l (- PI) y (3 * (PI / 2)) H1);
+ generalize (Rplus_le_compat_l (- PI) (PI / 2) y H2);
+ replace (- PI + x) with (x - PI).
+replace (- PI + PI / 2) with (- (PI / 2)).
+replace (- PI + y) with (y - PI).
+replace (- PI + 3 * (PI / 2)) with (PI / 2).
+replace (- (PI - x)) with (x - PI).
+replace (- (PI - y)) with (y - PI).
+intros; change (sin (y - PI) < sin (x - PI)) in H8;
+ apply Rplus_lt_reg_r with (- PI); rewrite Rplus_comm;
+ replace (y + - PI) with (y - PI).
+rewrite Rplus_comm; replace (x + - PI) with (x - PI).
+apply (sin_increasing_0 (y - PI) (x - PI) H4 H5 H6 H7 H8).
+reflexivity.
+reflexivity.
+unfold Rminus in |- *; rewrite Ropp_plus_distr.
+rewrite Ropp_involutive.
+apply Rplus_comm.
+unfold Rminus in |- *; rewrite Ropp_plus_distr.
+rewrite Ropp_involutive.
+apply Rplus_comm.
+pattern PI at 2 in |- *; rewrite double_var.
+rewrite Ropp_plus_distr.
+ring.
+unfold Rminus in |- *; apply Rplus_comm.
+pattern PI at 2 in |- *; rewrite double_var.
+rewrite Ropp_plus_distr.
+ring.
+unfold Rminus in |- *; apply Rplus_comm.
+Qed.
+
+Lemma sin_decreasing_1 :
+ forall x y:R,
+ x <= 3 * (PI / 2) ->
+ PI / 2 <= x -> y <= 3 * (PI / 2) -> PI / 2 <= y -> x < y -> sin y < sin x.
+intros; rewrite <- (sin_PI_x x); rewrite <- (sin_PI_x y);
+ generalize (Rplus_le_compat_l (- PI) x (3 * (PI / 2)) H);
+ generalize (Rplus_le_compat_l (- PI) (PI / 2) x H0);
+ generalize (Rplus_le_compat_l (- PI) y (3 * (PI / 2)) H1);
+ generalize (Rplus_le_compat_l (- PI) (PI / 2) y H2);
+ generalize (Rplus_lt_compat_l (- PI) x y H3);
+ replace (- PI + PI / 2) with (- (PI / 2)).
+replace (- PI + y) with (y - PI).
+replace (- PI + 3 * (PI / 2)) with (PI / 2).
+replace (- PI + x) with (x - PI).
+intros; apply Ropp_lt_cancel; repeat rewrite <- sin_neg;
+ replace (- (PI - x)) with (x - PI).
+replace (- (PI - y)) with (y - PI).
+apply (sin_increasing_1 (x - PI) (y - PI) H7 H8 H5 H6 H4).
+unfold Rminus in |- *; rewrite Ropp_plus_distr.
+rewrite Ropp_involutive.
+apply Rplus_comm.
+unfold Rminus in |- *; rewrite Ropp_plus_distr.
+rewrite Ropp_involutive.
+apply Rplus_comm.
+unfold Rminus in |- *; apply Rplus_comm.
+pattern PI at 2 in |- *; rewrite double_var; ring.
+unfold Rminus in |- *; apply Rplus_comm.
+pattern PI at 2 in |- *; rewrite double_var; ring.
+Qed.
+
+Lemma cos_increasing_0 :
+ forall x y:R,
+ PI <= x -> x <= 2 * PI -> PI <= y -> y <= 2 * PI -> cos x < cos y -> x < y.
+intros x y H1 H2 H3 H4; rewrite <- (cos_neg x); rewrite <- (cos_neg y);
+ rewrite <- (cos_period (- x) 1); rewrite <- (cos_period (- y) 1);
+ unfold INR in |- *;
+ replace (- x + 2 * 1 * PI) with (PI / 2 - (x - 3 * (PI / 2))).
+replace (- y + 2 * 1 * PI) with (PI / 2 - (y - 3 * (PI / 2))).
+repeat rewrite cos_shift; intro H5;
+ generalize (Rplus_le_compat_l (-3 * (PI / 2)) PI x H1);
+ generalize (Rplus_le_compat_l (-3 * (PI / 2)) x (2 * PI) H2);
+ generalize (Rplus_le_compat_l (-3 * (PI / 2)) PI y H3);
+ generalize (Rplus_le_compat_l (-3 * (PI / 2)) y (2 * PI) H4).
+replace (-3 * (PI / 2) + y) with (y - 3 * (PI / 2)).
+replace (-3 * (PI / 2) + x) with (x - 3 * (PI / 2)).
+replace (-3 * (PI / 2) + 2 * PI) with (PI / 2).
+replace (-3 * (PI / 2) + PI) with (- (PI / 2)).
+clear H1 H2 H3 H4; intros H1 H2 H3 H4;
+ apply Rplus_lt_reg_r with (-3 * (PI / 2));
+ replace (-3 * (PI / 2) + x) with (x - 3 * (PI / 2)).
+replace (-3 * (PI / 2) + y) with (y - 3 * (PI / 2)).
+apply (sin_increasing_0 (x - 3 * (PI / 2)) (y - 3 * (PI / 2)) H4 H3 H2 H1 H5).
+unfold Rminus in |- *.
+rewrite Ropp_mult_distr_l_reverse.
+apply Rplus_comm.
+unfold Rminus in |- *.
+rewrite Ropp_mult_distr_l_reverse.
+apply Rplus_comm.
+pattern PI at 3 in |- *; rewrite double_var.
+ring.
+rewrite double; pattern PI at 3 4 in |- *; rewrite double_var.
+ring.
+unfold Rminus in |- *.
+rewrite Ropp_mult_distr_l_reverse.
+apply Rplus_comm.
+unfold Rminus in |- *.
+rewrite Ropp_mult_distr_l_reverse.
+apply Rplus_comm.
+rewrite Rmult_1_r.
+rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var.
+ring.
+rewrite Rmult_1_r.
+rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var.
+ring.
+Qed.
+
+Lemma cos_increasing_1 :
+ forall x y:R,
+ PI <= x -> x <= 2 * PI -> PI <= y -> y <= 2 * PI -> x < y -> cos x < cos y.
+intros x y H1 H2 H3 H4 H5;
+ generalize (Rplus_le_compat_l (-3 * (PI / 2)) PI x H1);
+ generalize (Rplus_le_compat_l (-3 * (PI / 2)) x (2 * PI) H2);
+ generalize (Rplus_le_compat_l (-3 * (PI / 2)) PI y H3);
+ generalize (Rplus_le_compat_l (-3 * (PI / 2)) y (2 * PI) H4);
+ generalize (Rplus_lt_compat_l (-3 * (PI / 2)) x y H5);
+ rewrite <- (cos_neg x); rewrite <- (cos_neg y);
+ rewrite <- (cos_period (- x) 1); rewrite <- (cos_period (- y) 1);
+ unfold INR in |- *; replace (-3 * (PI / 2) + x) with (x - 3 * (PI / 2)).
+replace (-3 * (PI / 2) + y) with (y - 3 * (PI / 2)).
+replace (-3 * (PI / 2) + PI) with (- (PI / 2)).
+replace (-3 * (PI / 2) + 2 * PI) with (PI / 2).
+clear H1 H2 H3 H4 H5; intros H1 H2 H3 H4 H5;
+ replace (- x + 2 * 1 * PI) with (PI / 2 - (x - 3 * (PI / 2))).
+replace (- y + 2 * 1 * PI) with (PI / 2 - (y - 3 * (PI / 2))).
+repeat rewrite cos_shift;
+ apply
+ (sin_increasing_1 (x - 3 * (PI / 2)) (y - 3 * (PI / 2)) H5 H4 H3 H2 H1).
+rewrite Rmult_1_r.
+rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var.
+ring.
+rewrite Rmult_1_r.
+rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var.
+ring.
+rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var.
+ring.
+pattern PI at 3 in |- *; rewrite double_var; ring.
+unfold Rminus in |- *.
+rewrite <- Ropp_mult_distr_l_reverse.
+apply Rplus_comm.
+unfold Rminus in |- *.
+rewrite <- Ropp_mult_distr_l_reverse.
+apply Rplus_comm.
+Qed.
+
+Lemma cos_decreasing_0 :
+ forall x y:R,
+ 0 <= x -> x <= PI -> 0 <= y -> y <= PI -> cos x < cos y -> y < x.
+intros; generalize (Ropp_lt_gt_contravar (cos x) (cos y) H3);
+ repeat rewrite <- neg_cos; intro H4;
+ change (cos (y + PI) < cos (x + PI)) in H4; rewrite (Rplus_comm x) in H4;
+ rewrite (Rplus_comm y) in H4; generalize (Rplus_le_compat_l PI 0 x H);
+ generalize (Rplus_le_compat_l PI x PI H0);
+ generalize (Rplus_le_compat_l PI 0 y H1);
+ generalize (Rplus_le_compat_l PI y PI H2); rewrite Rplus_0_r.
+rewrite <- double.
+clear H H0 H1 H2 H3; intros; apply Rplus_lt_reg_r with PI;
+ apply (cos_increasing_0 (PI + y) (PI + x) H0 H H2 H1 H4).
+Qed.
+
+Lemma cos_decreasing_1 :
+ forall x y:R,
+ 0 <= x -> x <= PI -> 0 <= y -> y <= PI -> x < y -> cos y < cos x.
+intros; apply Ropp_lt_cancel; repeat rewrite <- neg_cos;
+ rewrite (Rplus_comm x); rewrite (Rplus_comm y);
+ generalize (Rplus_le_compat_l PI 0 x H);
+ generalize (Rplus_le_compat_l PI x PI H0);
+ generalize (Rplus_le_compat_l PI 0 y H1);
+ generalize (Rplus_le_compat_l PI y PI H2); rewrite Rplus_0_r.
+rewrite <- double.
+generalize (Rplus_lt_compat_l PI x y H3); clear H H0 H1 H2 H3; intros;
+ apply (cos_increasing_1 (PI + x) (PI + y) H3 H2 H1 H0 H).
+Qed.
+
+Lemma tan_diff :
+ forall x y:R,
+ cos x <> 0 -> cos y <> 0 -> tan x - tan y = sin (x - y) / (cos x * cos y).
+intros; unfold tan in |- *; rewrite sin_minus.
+unfold Rdiv in |- *.
+unfold Rminus in |- *.
+rewrite Rmult_plus_distr_r.
+rewrite Rinv_mult_distr.
+repeat rewrite (Rmult_comm (sin x)).
+repeat rewrite Rmult_assoc.
+rewrite (Rmult_comm (cos y)).
+repeat rewrite Rmult_assoc.
+rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r.
+rewrite (Rmult_comm (sin x)).
+apply Rplus_eq_compat_l.
+rewrite <- Ropp_mult_distr_l_reverse.
+rewrite <- Ropp_mult_distr_r_reverse.
+rewrite (Rmult_comm (/ cos x)).
+repeat rewrite Rmult_assoc.
+rewrite (Rmult_comm (cos x)).
+repeat rewrite Rmult_assoc.
+rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r.
+reflexivity.
+assumption.
+assumption.
+assumption.
+assumption.
+Qed.
+
+Lemma tan_increasing_0 :
+ forall x y:R,
+ - (PI / 4) <= x ->
+ x <= PI / 4 -> - (PI / 4) <= y -> y <= PI / 4 -> tan x < tan y -> x < y.
+intros; generalize PI4_RLT_PI2; intro H4;
+ generalize (Ropp_lt_gt_contravar (PI / 4) (PI / 2) H4);
+ intro H5; change (- (PI / 2) < - (PI / 4)) in H5;
+ generalize
+ (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H)
+ (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4)); intro HP1;
+ generalize
+ (cos_gt_0 y (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) y H5 H1)
+ (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4)); intro HP2;
+ generalize
+ (sym_not_eq
+ (Rlt_not_eq 0 (cos x)
+ (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H)
+ (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4))));
+ intro H6;
+ generalize
+ (sym_not_eq
+ (Rlt_not_eq 0 (cos y)
+ (cos_gt_0 y (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) y H5 H1)
+ (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4))));
+ intro H7; generalize (tan_diff x y H6 H7); intro H8;
+ generalize (Rlt_minus (tan x) (tan y) H3); clear H3;
+ intro H3; rewrite H8 in H3; cut (sin (x - y) < 0).
+intro H9; generalize (Ropp_le_ge_contravar (- (PI / 4)) y H1);
+ rewrite Ropp_involutive; intro H10; generalize (Rge_le (PI / 4) (- y) H10);
+ clear H10; intro H10; generalize (Ropp_le_ge_contravar y (PI / 4) H2);
+ intro H11; generalize (Rge_le (- y) (- (PI / 4)) H11);
+ clear H11; intro H11;
+ generalize (Rplus_le_compat (- (PI / 4)) x (- (PI / 4)) (- y) H H11);
+ generalize (Rplus_le_compat x (PI / 4) (- y) (PI / 4) H0 H10);
+ replace (x + - y) with (x - y).
+replace (PI / 4 + PI / 4) with (PI / 2).
+replace (- (PI / 4) + - (PI / 4)) with (- (PI / 2)).
+intros; case (Rtotal_order 0 (x - y)); intro H14.
+generalize
+ (sin_gt_0 (x - y) H14 (Rle_lt_trans (x - y) (PI / 2) PI H12 PI2_Rlt_PI));
+ intro H15; elim (Rlt_irrefl 0 (Rlt_trans 0 (sin (x - y)) 0 H15 H9)).
+elim H14; intro H15.
+rewrite <- H15 in H9; rewrite sin_0 in H9; elim (Rlt_irrefl 0 H9).
+apply Rminus_lt; assumption.
+pattern PI at 1 in |- *; rewrite double_var.
+unfold Rdiv in |- *.
+rewrite Rmult_plus_distr_r.
+repeat rewrite Rmult_assoc.
+rewrite <- Rinv_mult_distr.
+rewrite Ropp_plus_distr.
+replace 4 with 4.
+reflexivity.
+ring.
+discrR.
+discrR.
+pattern PI at 1 in |- *; rewrite double_var.
+unfold Rdiv in |- *.
+rewrite Rmult_plus_distr_r.
+repeat rewrite Rmult_assoc.
+rewrite <- Rinv_mult_distr.
+replace 4 with 4.
+reflexivity.
+ring.
+discrR.
+discrR.
+reflexivity.
+case (Rcase_abs (sin (x - y))); intro H9.
+assumption.
+generalize (Rge_le (sin (x - y)) 0 H9); clear H9; intro H9;
+ generalize (Rinv_0_lt_compat (cos x) HP1); intro H10;
+ generalize (Rinv_0_lt_compat (cos y) HP2); intro H11;
+ generalize (Rmult_lt_0_compat (/ cos x) (/ cos y) H10 H11);
+ replace (/ cos x * / cos y) with (/ (cos x * cos y)).
+intro H12;
+ generalize
+ (Rmult_le_pos (sin (x - y)) (/ (cos x * cos y)) H9
+ (Rlt_le 0 (/ (cos x * cos y)) H12)); intro H13;
+ elim
+ (Rlt_irrefl 0 (Rle_lt_trans 0 (sin (x - y) * / (cos x * cos y)) 0 H13 H3)).
+rewrite Rinv_mult_distr.
+reflexivity.
+assumption.
+assumption.
+Qed.
+
+Lemma tan_increasing_1 :
+ forall x y:R,
+ - (PI / 4) <= x ->
+ x <= PI / 4 -> - (PI / 4) <= y -> y <= PI / 4 -> x < y -> tan x < tan y.
+intros; apply Rminus_lt; generalize PI4_RLT_PI2; intro H4;
+ generalize (Ropp_lt_gt_contravar (PI / 4) (PI / 2) H4);
+ intro H5; change (- (PI / 2) < - (PI / 4)) in H5;
+ generalize
+ (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H)
+ (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4)); intro HP1;
+ generalize
+ (cos_gt_0 y (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) y H5 H1)
+ (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4)); intro HP2;
+ generalize
+ (sym_not_eq
+ (Rlt_not_eq 0 (cos x)
+ (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H)
+ (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4))));
+ intro H6;
+ generalize
+ (sym_not_eq
+ (Rlt_not_eq 0 (cos y)
+ (cos_gt_0 y (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) y H5 H1)
+ (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4))));
+ intro H7; rewrite (tan_diff x y H6 H7);
+ generalize (Rinv_0_lt_compat (cos x) HP1); intro H10;
+ generalize (Rinv_0_lt_compat (cos y) HP2); intro H11;
+ generalize (Rmult_lt_0_compat (/ cos x) (/ cos y) H10 H11);
+ replace (/ cos x * / cos y) with (/ (cos x * cos y)).
+clear H10 H11; intro H8; generalize (Ropp_le_ge_contravar y (PI / 4) H2);
+ intro H11; generalize (Rge_le (- y) (- (PI / 4)) H11);
+ clear H11; intro H11;
+ generalize (Rplus_le_compat (- (PI / 4)) x (- (PI / 4)) (- y) H H11);
+ replace (x + - y) with (x - y).
+replace (- (PI / 4) + - (PI / 4)) with (- (PI / 2)).
+clear H11; intro H9; generalize (Rlt_minus x y H3); clear H3; intro H3;
+ clear H H0 H1 H2 H4 H5 HP1 HP2; generalize PI2_Rlt_PI;
+ intro H1; generalize (Ropp_lt_gt_contravar (PI / 2) PI H1);
+ clear H1; intro H1;
+ generalize
+ (sin_lt_0_var (x - y) (Rlt_le_trans (- PI) (- (PI / 2)) (x - y) H1 H9) H3);
+ intro H2;
+ generalize
+ (Rmult_lt_gt_compat_neg_l (sin (x - y)) 0 (/ (cos x * cos y)) H2 H8);
+ rewrite Rmult_0_r; intro H4; assumption.
+pattern PI at 1 in |- *; rewrite double_var.
+unfold Rdiv in |- *.
+rewrite Rmult_plus_distr_r.
+repeat rewrite Rmult_assoc.
+rewrite <- Rinv_mult_distr.
+replace 4 with 4.
+rewrite Ropp_plus_distr.
+reflexivity.
+ring.
+discrR.
+discrR.
+reflexivity.
+apply Rinv_mult_distr; assumption.
+Qed.
+
+Lemma sin_incr_0 :
+ forall x y:R,
+ - (PI / 2) <= x ->
+ x <= PI / 2 -> - (PI / 2) <= y -> y <= PI / 2 -> sin x <= sin y -> x <= y.
+intros; case (Rtotal_order (sin x) (sin y)); intro H4;
+ [ left; apply (sin_increasing_0 x y H H0 H1 H2 H4)
+ | elim H4; intro H5;
+ [ case (Rtotal_order x y); intro H6;
+ [ left; assumption
+ | elim H6; intro H7;
+ [ right; assumption
+ | generalize (sin_increasing_1 y x H1 H2 H H0 H7); intro H8;
+ rewrite H5 in H8; elim (Rlt_irrefl (sin y) H8) ] ]
+ | elim (Rlt_irrefl (sin x) (Rle_lt_trans (sin x) (sin y) (sin x) H3 H5)) ] ].
+Qed.
+
+Lemma sin_incr_1 :
+ forall x y:R,
+ - (PI / 2) <= x ->
+ x <= PI / 2 -> - (PI / 2) <= y -> y <= PI / 2 -> x <= y -> sin x <= sin y.
+intros; case (Rtotal_order x y); intro H4;
+ [ left; apply (sin_increasing_1 x y H H0 H1 H2 H4)
+ | elim H4; intro H5;
+ [ case (Rtotal_order (sin x) (sin y)); intro H6;
+ [ left; assumption
+ | elim H6; intro H7;
+ [ right; assumption
+ | generalize (sin_increasing_0 y x H1 H2 H H0 H7); intro H8;
+ rewrite H5 in H8; elim (Rlt_irrefl y H8) ] ]
+ | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ].
+Qed.
+
+Lemma sin_decr_0 :
+ forall x y:R,
+ x <= 3 * (PI / 2) ->
+ PI / 2 <= x ->
+ y <= 3 * (PI / 2) -> PI / 2 <= y -> sin x <= sin y -> y <= x.
+intros; case (Rtotal_order (sin x) (sin y)); intro H4;
+ [ left; apply (sin_decreasing_0 x y H H0 H1 H2 H4)
+ | elim H4; intro H5;
+ [ case (Rtotal_order x y); intro H6;
+ [ generalize (sin_decreasing_1 x y H H0 H1 H2 H6); intro H8;
+ rewrite H5 in H8; elim (Rlt_irrefl (sin y) H8)
+ | elim H6; intro H7;
+ [ right; symmetry in |- *; assumption | left; assumption ] ]
+ | elim (Rlt_irrefl (sin x) (Rle_lt_trans (sin x) (sin y) (sin x) H3 H5)) ] ].
+Qed.
+
+Lemma sin_decr_1 :
+ forall x y:R,
+ x <= 3 * (PI / 2) ->
+ PI / 2 <= x ->
+ y <= 3 * (PI / 2) -> PI / 2 <= y -> x <= y -> sin y <= sin x.
+intros; case (Rtotal_order x y); intro H4;
+ [ left; apply (sin_decreasing_1 x y H H0 H1 H2 H4)
+ | elim H4; intro H5;
+ [ case (Rtotal_order (sin x) (sin y)); intro H6;
+ [ generalize (sin_decreasing_0 x y H H0 H1 H2 H6); intro H8;
+ rewrite H5 in H8; elim (Rlt_irrefl y H8)
+ | elim H6; intro H7;
+ [ right; symmetry in |- *; assumption | left; assumption ] ]
+ | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ].
+Qed.
+
+Lemma cos_incr_0 :
+ forall x y:R,
+ PI <= x ->
+ x <= 2 * PI -> PI <= y -> y <= 2 * PI -> cos x <= cos y -> x <= y.
+intros; case (Rtotal_order (cos x) (cos y)); intro H4;
+ [ left; apply (cos_increasing_0 x y H H0 H1 H2 H4)
+ | elim H4; intro H5;
+ [ case (Rtotal_order x y); intro H6;
+ [ left; assumption
+ | elim H6; intro H7;
+ [ right; assumption
+ | generalize (cos_increasing_1 y x H1 H2 H H0 H7); intro H8;
+ rewrite H5 in H8; elim (Rlt_irrefl (cos y) H8) ] ]
+ | elim (Rlt_irrefl (cos x) (Rle_lt_trans (cos x) (cos y) (cos x) H3 H5)) ] ].
+Qed.
+
+Lemma cos_incr_1 :
+ forall x y:R,
+ PI <= x ->
+ x <= 2 * PI -> PI <= y -> y <= 2 * PI -> x <= y -> cos x <= cos y.
+intros; case (Rtotal_order x y); intro H4;
+ [ left; apply (cos_increasing_1 x y H H0 H1 H2 H4)
+ | elim H4; intro H5;
+ [ case (Rtotal_order (cos x) (cos y)); intro H6;
+ [ left; assumption
+ | elim H6; intro H7;
+ [ right; assumption
+ | generalize (cos_increasing_0 y x H1 H2 H H0 H7); intro H8;
+ rewrite H5 in H8; elim (Rlt_irrefl y H8) ] ]
+ | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ].
+Qed.
+
+Lemma cos_decr_0 :
+ forall x y:R,
+ 0 <= x -> x <= PI -> 0 <= y -> y <= PI -> cos x <= cos y -> y <= x.
+intros; case (Rtotal_order (cos x) (cos y)); intro H4;
+ [ left; apply (cos_decreasing_0 x y H H0 H1 H2 H4)
+ | elim H4; intro H5;
+ [ case (Rtotal_order x y); intro H6;
+ [ generalize (cos_decreasing_1 x y H H0 H1 H2 H6); intro H8;
+ rewrite H5 in H8; elim (Rlt_irrefl (cos y) H8)
+ | elim H6; intro H7;
+ [ right; symmetry in |- *; assumption | left; assumption ] ]
+ | elim (Rlt_irrefl (cos x) (Rle_lt_trans (cos x) (cos y) (cos x) H3 H5)) ] ].
+Qed.
+
+Lemma cos_decr_1 :
+ forall x y:R,
+ 0 <= x -> x <= PI -> 0 <= y -> y <= PI -> x <= y -> cos y <= cos x.
+intros; case (Rtotal_order x y); intro H4;
+ [ left; apply (cos_decreasing_1 x y H H0 H1 H2 H4)
+ | elim H4; intro H5;
+ [ case (Rtotal_order (cos x) (cos y)); intro H6;
+ [ generalize (cos_decreasing_0 x y H H0 H1 H2 H6); intro H8;
+ rewrite H5 in H8; elim (Rlt_irrefl y H8)
+ | elim H6; intro H7;
+ [ right; symmetry in |- *; assumption | left; assumption ] ]
+ | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ].
+Qed.
+
+Lemma tan_incr_0 :
+ forall x y:R,
+ - (PI / 4) <= x ->
+ x <= PI / 4 -> - (PI / 4) <= y -> y <= PI / 4 -> tan x <= tan y -> x <= y.
+intros; case (Rtotal_order (tan x) (tan y)); intro H4;
+ [ left; apply (tan_increasing_0 x y H H0 H1 H2 H4)
+ | elim H4; intro H5;
+ [ case (Rtotal_order x y); intro H6;
+ [ left; assumption
+ | elim H6; intro H7;
+ [ right; assumption
+ | generalize (tan_increasing_1 y x H1 H2 H H0 H7); intro H8;
+ rewrite H5 in H8; elim (Rlt_irrefl (tan y) H8) ] ]
+ | elim (Rlt_irrefl (tan x) (Rle_lt_trans (tan x) (tan y) (tan x) H3 H5)) ] ].
+Qed.
+
+Lemma tan_incr_1 :
+ forall x y:R,
+ - (PI / 4) <= x ->
+ x <= PI / 4 -> - (PI / 4) <= y -> y <= PI / 4 -> x <= y -> tan x <= tan y.
+intros; case (Rtotal_order x y); intro H4;
+ [ left; apply (tan_increasing_1 x y H H0 H1 H2 H4)
+ | elim H4; intro H5;
+ [ case (Rtotal_order (tan x) (tan y)); intro H6;
+ [ left; assumption
+ | elim H6; intro H7;
+ [ right; assumption
+ | generalize (tan_increasing_0 y x H1 H2 H H0 H7); intro H8;
+ rewrite H5 in H8; elim (Rlt_irrefl y H8) ] ]
+ | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ].
Qed.
(**********)
-Lemma sin_eq_0_1 : (x:R) (EXT k:Z | x==(Rmult (IZR k) PI)) -> (sin x)==R0.
-Intros.
-Elim H; Intros.
-Apply (Zcase_sign x0).
-Intro.
-Rewrite H1 in H0.
-Simpl in H0.
-Rewrite H0; Rewrite Rmult_Ol; Apply sin_0.
-Intro.
-Cut `0<=x0`.
-Intro.
-Elim (IZN x0 H2); Intros.
-Rewrite H3 in H0.
-Rewrite <- INR_IZR_INZ in H0.
-Rewrite H0.
-Elim (even_odd_cor x1); Intros.
-Elim H4; Intro.
-Rewrite H5.
-Rewrite mult_INR.
-Simpl.
-Rewrite <- (Rplus_Ol ``2*(INR x2)*PI``).
-Rewrite sin_period.
-Apply sin_0.
-Rewrite H5.
-Rewrite S_INR; Rewrite mult_INR.
-Simpl.
-Rewrite Rmult_Rplus_distrl.
-Rewrite Rmult_1l; Rewrite sin_plus.
-Rewrite sin_PI.
-Rewrite Rmult_Or.
-Rewrite <- (Rplus_Ol ``2*(INR x2)*PI``).
-Rewrite sin_period.
-Rewrite sin_0; Ring.
-Apply le_IZR.
-Left; Apply IZR_lt.
-Assert H2 := Zgt_iff_lt.
-Elim (H2 x0 `0`); Intros.
-Apply H3; Assumption.
-Intro.
-Rewrite H0.
-Replace ``(sin ((IZR x0)*PI))`` with ``-(sin (-(IZR x0)*PI))``.
-Cut `0<=-x0`.
-Intro.
-Rewrite <- Ropp_Ropp_IZR.
-Elim (IZN `-x0` H2); Intros.
-Rewrite H3.
-Rewrite <- INR_IZR_INZ.
-Elim (even_odd_cor x1); Intros.
-Elim H4; Intro.
-Rewrite H5.
-Rewrite mult_INR.
-Simpl.
-Rewrite <- (Rplus_Ol ``2*(INR x2)*PI``).
-Rewrite sin_period.
-Rewrite sin_0; Ring.
-Rewrite H5.
-Rewrite S_INR; Rewrite mult_INR.
-Simpl.
-Rewrite Rmult_Rplus_distrl.
-Rewrite Rmult_1l; Rewrite sin_plus.
-Rewrite sin_PI.
-Rewrite Rmult_Or.
-Rewrite <- (Rplus_Ol ``2*(INR x2)*PI``).
-Rewrite sin_period.
-Rewrite sin_0; Ring.
-Apply le_IZR.
-Apply Rle_anti_compatibility with ``(IZR x0)``.
-Rewrite Rplus_Or.
-Rewrite Ropp_Ropp_IZR.
-Rewrite Rplus_Ropp_r.
-Left; Replace R0 with (IZR `0`); [Apply IZR_lt | Reflexivity].
-Assumption.
-Rewrite <- sin_neg.
-Rewrite Ropp_mul1.
-Rewrite Ropp_Ropp.
-Reflexivity.
-Qed.
-
-Lemma sin_eq_0_0 : (x:R) (sin x)==R0 -> (EXT k:Z | x==(Rmult (IZR k) PI)).
-Intros.
-Assert H0 := (euclidian_division x PI PI_neq0).
-Elim H0; Intros q H1.
-Elim H1; Intros r H2.
-Exists q.
-Cut r==R0.
-Intro.
-Elim H2; Intros H4 _; Rewrite H4; Rewrite H3.
-Apply Rplus_Or.
-Elim H2; Intros.
-Rewrite H3 in H.
-Rewrite sin_plus in H.
-Cut ``(sin ((IZR q)*PI))==0``.
-Intro.
-Rewrite H5 in H.
-Rewrite Rmult_Ol in H.
-Rewrite Rplus_Ol in H.
-Assert H6 := (without_div_Od ? ? H).
-Elim H6; Intro.
-Assert H8 := (sin2_cos2 ``(IZR q)*PI``).
-Rewrite H5 in H8; Rewrite H7 in H8.
-Rewrite Rsqr_O in H8.
-Rewrite Rplus_Or in H8.
-Elim R1_neq_R0; Symmetry; Assumption.
-Cut r==R0\/``0<r<PI``.
-Intro; Elim H8; Intro.
-Assumption.
-Elim H9; Intros.
-Assert H12 := (sin_gt_0 ? H10 H11).
-Rewrite H7 in H12; Elim (Rlt_antirefl ? H12).
-Rewrite Rabsolu_right in H4.
-Elim H4; Intros.
-Case (total_order R0 r); Intro.
-Right; Split; Assumption.
-Elim H10; Intro.
-Left; Symmetry; Assumption.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H8 H11)).
-Apply Rle_sym1.
-Left; Apply PI_RGT_0.
-Apply sin_eq_0_1.
-Exists q; Reflexivity.
-Qed.
-
-Lemma cos_eq_0_0 : (x:R) (cos x)==R0 -> (EXT k : Z | ``x==(IZR k)*PI+PI/2``).
-Intros x H; Rewrite -> cos_sin in H; Generalize (sin_eq_0_0 (Rplus (Rdiv PI (INR (2))) x) H); Intro H2; Elim H2; Intros x0 H3; Exists (Zminus x0 (inject_nat (S O))); Rewrite <- Z_R_minus; Ring; Rewrite Rmult_sym; Rewrite <- H3; Unfold INR.
-Rewrite (double_var ``-PI``); Unfold Rdiv; Ring.
-Qed.
-
-Lemma cos_eq_0_1 : (x:R) (EXT k : Z | ``x==(IZR k)*PI+PI/2``) -> ``(cos x)==0``.
-Intros x H1; Rewrite cos_sin; Elim H1; Intros x0 H2; Rewrite H2; Replace ``PI/2+((IZR x0)*PI+PI/2)`` with ``(IZR x0)*PI+PI``.
-Rewrite neg_sin; Rewrite <- Ropp_O.
-Apply eq_Ropp; Apply sin_eq_0_1; Exists x0; Reflexivity.
-Pattern 2 PI; Rewrite (double_var PI); Ring.
-Qed.
-
-Lemma sin_eq_O_2PI_0 : (x:R) ``0<=x`` -> ``x<=2*PI`` -> ``(sin x)==0`` -> ``x==0``\/``x==PI``\/``x==2*PI``.
-Intros; Generalize (sin_eq_0_0 x H1); Intro.
-Elim H2; Intros k0 H3.
-Case (total_order PI x); Intro.
-Rewrite H3 in H4; Rewrite H3 in H0.
-Right; Right.
-Generalize (Rlt_monotony_r ``/PI`` ``PI`` ``(IZR k0)*PI`` (Rlt_Rinv ``PI`` PI_RGT_0) H4); Rewrite Rmult_assoc; Repeat Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Intro; Generalize (Rle_monotony_r ``/PI`` ``(IZR k0)*PI`` ``2*PI`` (Rlt_le ``0`` ``/PI`` (Rlt_Rinv ``PI`` PI_RGT_0)) H0); Repeat Rewrite Rmult_assoc; Repeat Rewrite <- Rinv_r_sym.
-Repeat Rewrite Rmult_1r; Intro; Generalize (Rlt_compatibility (IZR `-2`) ``1`` (IZR k0) H5); Rewrite <- plus_IZR.
-Replace ``(IZR (NEG (xO xH)))+1`` with ``-1``.
-Intro; Generalize (Rle_compatibility (IZR `-2`) (IZR k0) ``2`` H6); Rewrite <- plus_IZR.
-Replace ``(IZR (NEG (xO xH)))+2`` with ``0``.
-Intro; Cut ``-1 < (IZR (Zplus (NEG (xO xH)) k0)) < 1``.
-Intro; Generalize (one_IZR_lt1 (Zplus (NEG (xO xH)) k0) H9); Intro.
-Cut k0=`2`.
-Intro; Rewrite H11 in H3; Rewrite H3; Simpl.
-Reflexivity.
-Rewrite <- (Zplus_inverse_l `2`) in H10; Generalize (Zsimpl_plus_l `-2` k0 `2` H10); Intro; Assumption.
-Split.
-Assumption.
-Apply Rle_lt_trans with ``0``.
-Assumption.
-Apply Rlt_R0_R1.
-Simpl; Ring.
-Simpl; Ring.
-Apply PI_neq0.
-Apply PI_neq0.
-Elim H4; Intro.
-Right; Left.
-Symmetry; Assumption.
-Left.
-Rewrite H3 in H5; Rewrite H3 in H; Generalize (Rlt_monotony_r ``/PI`` ``(IZR k0)*PI`` PI (Rlt_Rinv ``PI`` PI_RGT_0) H5); Rewrite Rmult_assoc; Repeat Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Intro; Generalize (Rle_monotony_r ``/PI`` ``0`` ``(IZR k0)*PI`` (Rlt_le ``0`` ``/PI`` (Rlt_Rinv ``PI`` PI_RGT_0)) H); Repeat Rewrite Rmult_assoc; Repeat Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Rewrite Rmult_Ol; Intro.
-Cut ``-1 < (IZR (k0)) < 1``.
-Intro; Generalize (one_IZR_lt1 k0 H8); Intro; Rewrite H9 in H3; Rewrite H3; Simpl; Apply Rmult_Ol.
-Split.
-Apply Rlt_le_trans with ``0``.
-Rewrite <- Ropp_O; Apply Rgt_Ropp; Apply Rlt_R0_R1.
-Assumption.
-Assumption.
-Apply PI_neq0.
-Apply PI_neq0.
-Qed.
-
-Lemma sin_eq_O_2PI_1 : (x:R) ``0<=x`` -> ``x<=2*PI`` -> ``x==0``\/``x==PI``\/``x==2*PI`` -> ``(sin x)==0``.
-Intros x H1 H2 H3; Elim H3; Intro H4; [ Rewrite H4; Rewrite -> sin_0; Reflexivity | Elim H4; Intro H5; [Rewrite H5; Rewrite -> sin_PI; Reflexivity | Rewrite H5; Rewrite -> sin_2PI; Reflexivity]].
-Qed.
-
-Lemma cos_eq_0_2PI_0 : (x:R) ``R0<=x`` -> ``x<=2*PI`` -> ``(cos x)==0`` -> ``x==(PI/2)``\/``x==3*(PI/2)``.
-Intros; Case (total_order x ``3*(PI/2)``); Intro.
-Rewrite cos_sin in H1.
-Cut ``0<=PI/2+x``.
-Cut ``PI/2+x<=2*PI``.
-Intros; Generalize (sin_eq_O_2PI_0 ``PI/2+x`` H4 H3 H1); Intros.
-Decompose [or] H5.
-Generalize (Rle_compatibility ``PI/2`` ``0`` x H); Rewrite Rplus_Or; Rewrite H6; Intro.
-Elim (Rlt_antirefl ``0`` (Rlt_le_trans ``0`` ``PI/2`` ``0`` PI2_RGT_0 H7)).
-Left.
-Generalize (Rplus_plus_r ``-(PI/2)`` ``PI/2+x`` PI H7).
-Replace ``-(PI/2)+(PI/2+x)`` with x.
-Replace ``-(PI/2)+PI`` with ``PI/2``.
-Intro; Assumption.
-Pattern 3 PI; Rewrite (double_var PI); Ring.
-Ring.
-Right.
-Generalize (Rplus_plus_r ``-(PI/2)`` ``PI/2+x`` ``2*PI`` H7).
-Replace ``-(PI/2)+(PI/2+x)`` with x.
-Replace ``-(PI/2)+2*PI`` with ``3*(PI/2)``.
-Intro; Assumption.
-Rewrite double; Pattern 3 4 PI; Rewrite (double_var PI); Ring.
-Ring.
-Left; Replace ``2*PI`` with ``PI/2+3*(PI/2)``.
-Apply Rlt_compatibility; Assumption.
-Rewrite (double PI); Pattern 3 4 PI; Rewrite (double_var PI); Ring.
-Apply ge0_plus_ge0_is_ge0.
-Left; Unfold Rdiv; Apply Rmult_lt_pos.
-Apply PI_RGT_0.
-Apply Rlt_Rinv; Sup0.
-Assumption.
-Elim H2; Intro.
-Right; Assumption.
-Generalize (cos_eq_0_0 x H1); Intro; Elim H4; Intros k0 H5.
-Rewrite H5 in H3; Rewrite H5 in H0; Generalize (Rlt_compatibility ``-(PI/2)`` ``3*PI/2`` ``(IZR k0)*PI+PI/2`` H3); Generalize (Rle_compatibility ``-(PI/2)`` ``(IZR k0)*PI+PI/2`` ``2*PI`` H0).
-Replace ``-(PI/2)+3*PI/2`` with PI.
-Replace ``-(PI/2)+((IZR k0)*PI+PI/2)`` with ``(IZR k0)*PI``.
-Replace ``-(PI/2)+2*PI`` with ``3*(PI/2)``.
-Intros; Generalize (Rlt_monotony ``/PI`` ``PI`` ``(IZR k0)*PI`` (Rlt_Rinv PI PI_RGT_0) H7); Generalize (Rle_monotony ``/PI`` ``(IZR k0)*PI`` ``3*(PI/2)`` (Rlt_le ``0`` ``/PI`` (Rlt_Rinv PI PI_RGT_0)) H6).
-Replace ``/PI*((IZR k0)*PI)`` with (IZR k0).
-Replace ``/PI*(3*PI/2)`` with ``3*/2``.
-Rewrite <- Rinv_l_sym.
-Intros; Generalize (Rlt_compatibility (IZR `-2`) ``1`` (IZR k0) H9); Rewrite <- plus_IZR.
-Replace ``(IZR (NEG (xO xH)))+1`` with ``-1``.
-Intro; Generalize (Rle_compatibility (IZR `-2`) (IZR k0) ``3*/2`` H8); Rewrite <- plus_IZR.
-Replace ``(IZR (NEG (xO xH)))+2`` with ``0``.
-Intro; Cut `` -1 < (IZR (Zplus (NEG (xO xH)) k0)) < 1``.
-Intro; Generalize (one_IZR_lt1 (Zplus (NEG (xO xH)) k0) H12); Intro.
-Cut k0=`2`.
-Intro; Rewrite H14 in H8.
-Assert Hyp : ``0<2``.
-Sup0.
-Generalize (Rle_monotony ``2`` ``(IZR (POS (xO xH)))`` ``3*/2`` (Rlt_le ``0`` ``2`` Hyp) H8); Simpl.
-Replace ``2*2`` with ``4``.
-Replace ``2*(3*/2)`` with ``3``.
-Intro; Cut ``3<4``.
-Intro; Elim (Rlt_antirefl ``3`` (Rlt_le_trans ``3`` ``4`` ``3`` H16 H15)).
-Generalize (Rlt_compatibility ``3`` ``0`` ``1`` Rlt_R0_R1); Rewrite Rplus_Or.
-Replace ``3+1`` with ``4``.
-Intro; Assumption.
-Ring.
-Symmetry; Rewrite <- Rmult_assoc; Apply Rinv_r_simpl_m.
-DiscrR.
-Ring.
-Rewrite <- (Zplus_inverse_l `2`) in H13; Generalize (Zsimpl_plus_l `-2` k0 `2` H13); Intro; Assumption.
-Split.
-Assumption.
-Apply Rle_lt_trans with ``(IZR (NEG (xO xH)))+3*/2``.
-Assumption.
-Simpl; Replace ``-2+3*/2`` with ``-(1*/2)``.
-Apply Rlt_trans with ``0``.
-Rewrite <- Ropp_O; Apply Rlt_Ropp.
-Apply Rmult_lt_pos; [Apply Rlt_R0_R1 | Apply Rlt_Rinv; Sup0].
-Apply Rlt_R0_R1.
-Rewrite Rmult_1l; Apply r_Rmult_mult with ``2``.
-Rewrite Ropp_mul3; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_Rplus_distr; Rewrite <- Rmult_assoc; Rewrite Rinv_r_simpl_m.
-Ring.
-DiscrR.
-DiscrR.
-DiscrR.
-Simpl; Ring.
-Simpl; Ring.
-Apply PI_neq0.
-Unfold Rdiv; Pattern 1 ``3``; Rewrite (Rmult_sym ``3``); Repeat Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l; Apply Rmult_sym.
-Apply PI_neq0.
-Symmetry; Rewrite (Rmult_sym ``/PI``); Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym.
-Apply Rmult_1r.
-Apply PI_neq0.
-Rewrite double; Pattern 3 4 PI; Rewrite double_var; Ring.
-Ring.
-Pattern 1 PI; Rewrite double_var; Ring.
-Qed.
-
-Lemma cos_eq_0_2PI_1 : (x:R) ``0<=x`` -> ``x<=2*PI`` -> ``x==PI/2``\/``x==3*(PI/2)`` -> ``(cos x)==0``.
-Intros x H1 H2 H3; Elim H3; Intro H4; [ Rewrite H4; Rewrite -> cos_PI2; Reflexivity | Rewrite H4; Rewrite -> cos_3PI2; Reflexivity ].
-Qed.
+Lemma sin_eq_0_1 : forall x:R, ( exists k : Z | x = IZR k * PI) -> sin x = 0.
+intros.
+elim H; intros.
+apply (Zcase_sign x0).
+intro.
+rewrite H1 in H0.
+simpl in H0.
+rewrite H0; rewrite Rmult_0_l; apply sin_0.
+intro.
+cut (0 <= x0)%Z.
+intro.
+elim (IZN x0 H2); intros.
+rewrite H3 in H0.
+rewrite <- INR_IZR_INZ in H0.
+rewrite H0.
+elim (even_odd_cor x1); intros.
+elim H4; intro.
+rewrite H5.
+rewrite mult_INR.
+simpl in |- *.
+rewrite <- (Rplus_0_l (2 * INR x2 * PI)).
+rewrite sin_period.
+apply sin_0.
+rewrite H5.
+rewrite S_INR; rewrite mult_INR.
+simpl in |- *.
+rewrite Rmult_plus_distr_r.
+rewrite Rmult_1_l; rewrite sin_plus.
+rewrite sin_PI.
+rewrite Rmult_0_r.
+rewrite <- (Rplus_0_l (2 * INR x2 * PI)).
+rewrite sin_period.
+rewrite sin_0; ring.
+apply le_IZR.
+left; apply IZR_lt.
+assert (H2 := Zorder.Zgt_iff_lt).
+elim (H2 x0 0%Z); intros.
+apply H3; assumption.
+intro.
+rewrite H0.
+replace (sin (IZR x0 * PI)) with (- sin (- IZR x0 * PI)).
+cut (0 <= - x0)%Z.
+intro.
+rewrite <- Ropp_Ropp_IZR.
+elim (IZN (- x0) H2); intros.
+rewrite H3.
+rewrite <- INR_IZR_INZ.
+elim (even_odd_cor x1); intros.
+elim H4; intro.
+rewrite H5.
+rewrite mult_INR.
+simpl in |- *.
+rewrite <- (Rplus_0_l (2 * INR x2 * PI)).
+rewrite sin_period.
+rewrite sin_0; ring.
+rewrite H5.
+rewrite S_INR; rewrite mult_INR.
+simpl in |- *.
+rewrite Rmult_plus_distr_r.
+rewrite Rmult_1_l; rewrite sin_plus.
+rewrite sin_PI.
+rewrite Rmult_0_r.
+rewrite <- (Rplus_0_l (2 * INR x2 * PI)).
+rewrite sin_period.
+rewrite sin_0; ring.
+apply le_IZR.
+apply Rplus_le_reg_l with (IZR x0).
+rewrite Rplus_0_r.
+rewrite Ropp_Ropp_IZR.
+rewrite Rplus_opp_r.
+left; replace 0 with (IZR 0); [ apply IZR_lt | reflexivity ].
+assumption.
+rewrite <- sin_neg.
+rewrite Ropp_mult_distr_l_reverse.
+rewrite Ropp_involutive.
+reflexivity.
+Qed.
+
+Lemma sin_eq_0_0 : forall x:R, sin x = 0 -> exists k : Z | x = IZR k * PI.
+intros.
+assert (H0 := euclidian_division x PI PI_neq0).
+elim H0; intros q H1.
+elim H1; intros r H2.
+exists q.
+cut (r = 0).
+intro.
+elim H2; intros H4 _; rewrite H4; rewrite H3.
+apply Rplus_0_r.
+elim H2; intros.
+rewrite H3 in H.
+rewrite sin_plus in H.
+cut (sin (IZR q * PI) = 0).
+intro.
+rewrite H5 in H.
+rewrite Rmult_0_l in H.
+rewrite Rplus_0_l in H.
+assert (H6 := Rmult_integral _ _ H).
+elim H6; intro.
+assert (H8 := sin2_cos2 (IZR q * PI)).
+rewrite H5 in H8; rewrite H7 in H8.
+rewrite Rsqr_0 in H8.
+rewrite Rplus_0_r in H8.
+elim R1_neq_R0; symmetry in |- *; assumption.
+cut (r = 0 \/ 0 < r < PI).
+intro; elim H8; intro.
+assumption.
+elim H9; intros.
+assert (H12 := sin_gt_0 _ H10 H11).
+rewrite H7 in H12; elim (Rlt_irrefl _ H12).
+rewrite Rabs_right in H4.
+elim H4; intros.
+case (Rtotal_order 0 r); intro.
+right; split; assumption.
+elim H10; intro.
+left; symmetry in |- *; assumption.
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H8 H11)).
+apply Rle_ge.
+left; apply PI_RGT_0.
+apply sin_eq_0_1.
+exists q; reflexivity.
+Qed.
+
+Lemma cos_eq_0_0 :
+ forall x:R, cos x = 0 -> exists k : Z | x = IZR k * PI + PI / 2.
+intros x H; rewrite cos_sin in H; generalize (sin_eq_0_0 (PI / INR 2 + x) H);
+ intro H2; elim H2; intros x0 H3; exists (x0 - Z_of_nat 1)%Z;
+ rewrite <- Z_R_minus; ring; rewrite Rmult_comm; rewrite <- H3;
+ unfold INR in |- *.
+rewrite (double_var (- PI)); unfold Rdiv in |- *; ring.
+Qed.
+
+Lemma cos_eq_0_1 :
+ forall x:R, ( exists k : Z | x = IZR k * PI + PI / 2) -> cos x = 0.
+intros x H1; rewrite cos_sin; elim H1; intros x0 H2; rewrite H2;
+ replace (PI / 2 + (IZR x0 * PI + PI / 2)) with (IZR x0 * PI + PI).
+rewrite neg_sin; rewrite <- Ropp_0.
+apply Ropp_eq_compat; apply sin_eq_0_1; exists x0; reflexivity.
+pattern PI at 2 in |- *; rewrite (double_var PI); ring.
+Qed.
+
+Lemma sin_eq_O_2PI_0 :
+ forall x:R,
+ 0 <= x -> x <= 2 * PI -> sin x = 0 -> x = 0 \/ x = PI \/ x = 2 * PI.
+intros; generalize (sin_eq_0_0 x H1); intro.
+elim H2; intros k0 H3.
+case (Rtotal_order PI x); intro.
+rewrite H3 in H4; rewrite H3 in H0.
+right; right.
+generalize
+ (Rmult_lt_compat_r (/ PI) PI (IZR k0 * PI) (Rinv_0_lt_compat PI PI_RGT_0) H4);
+ rewrite Rmult_assoc; repeat rewrite <- Rinv_r_sym.
+rewrite Rmult_1_r; intro;
+ generalize
+ (Rmult_le_compat_r (/ PI) (IZR k0 * PI) (2 * PI)
+ (Rlt_le 0 (/ PI) (Rinv_0_lt_compat PI PI_RGT_0)) H0);
+ repeat rewrite Rmult_assoc; repeat rewrite <- Rinv_r_sym.
+repeat rewrite Rmult_1_r; intro;
+ generalize (Rplus_lt_compat_l (IZR (-2)) 1 (IZR k0) H5);
+ rewrite <- plus_IZR.
+replace (IZR (-2) + 1) with (-1).
+intro; generalize (Rplus_le_compat_l (IZR (-2)) (IZR k0) 2 H6);
+ rewrite <- plus_IZR.
+replace (IZR (-2) + 2) with 0.
+intro; cut (-1 < IZR (-2 + k0) < 1).
+intro; generalize (one_IZR_lt1 (-2 + k0) H9); intro.
+cut (k0 = 2%Z).
+intro; rewrite H11 in H3; rewrite H3; simpl in |- *.
+reflexivity.
+rewrite <- (Zplus_opp_l 2) in H10; generalize (Zplus_reg_l (-2) k0 2 H10);
+ intro; assumption.
+split.
+assumption.
+apply Rle_lt_trans with 0.
+assumption.
+apply Rlt_0_1.
+simpl in |- *; ring.
+simpl in |- *; ring.
+apply PI_neq0.
+apply PI_neq0.
+elim H4; intro.
+right; left.
+symmetry in |- *; assumption.
+left.
+rewrite H3 in H5; rewrite H3 in H;
+ generalize
+ (Rmult_lt_compat_r (/ PI) (IZR k0 * PI) PI (Rinv_0_lt_compat PI PI_RGT_0)
+ H5); rewrite Rmult_assoc; repeat rewrite <- Rinv_r_sym.
+rewrite Rmult_1_r; intro;
+ generalize
+ (Rmult_le_compat_r (/ PI) 0 (IZR k0 * PI)
+ (Rlt_le 0 (/ PI) (Rinv_0_lt_compat PI PI_RGT_0)) H);
+ repeat rewrite Rmult_assoc; repeat rewrite <- Rinv_r_sym.
+rewrite Rmult_1_r; rewrite Rmult_0_l; intro.
+cut (-1 < IZR k0 < 1).
+intro; generalize (one_IZR_lt1 k0 H8); intro; rewrite H9 in H3; rewrite H3;
+ simpl in |- *; apply Rmult_0_l.
+split.
+apply Rlt_le_trans with 0.
+rewrite <- Ropp_0; apply Ropp_gt_lt_contravar; apply Rlt_0_1.
+assumption.
+assumption.
+apply PI_neq0.
+apply PI_neq0.
+Qed.
+
+Lemma sin_eq_O_2PI_1 :
+ forall x:R,
+ 0 <= x -> x <= 2 * PI -> x = 0 \/ x = PI \/ x = 2 * PI -> sin x = 0.
+intros x H1 H2 H3; elim H3; intro H4;
+ [ rewrite H4; rewrite sin_0; reflexivity
+ | elim H4; intro H5;
+ [ rewrite H5; rewrite sin_PI; reflexivity
+ | rewrite H5; rewrite sin_2PI; reflexivity ] ].
+Qed.
+
+Lemma cos_eq_0_2PI_0 :
+ forall x:R,
+ 0 <= x -> x <= 2 * PI -> cos x = 0 -> x = PI / 2 \/ x = 3 * (PI / 2).
+intros; case (Rtotal_order x (3 * (PI / 2))); intro.
+rewrite cos_sin in H1.
+cut (0 <= PI / 2 + x).
+cut (PI / 2 + x <= 2 * PI).
+intros; generalize (sin_eq_O_2PI_0 (PI / 2 + x) H4 H3 H1); intros.
+decompose [or] H5.
+generalize (Rplus_le_compat_l (PI / 2) 0 x H); rewrite Rplus_0_r; rewrite H6;
+ intro.
+elim (Rlt_irrefl 0 (Rlt_le_trans 0 (PI / 2) 0 PI2_RGT_0 H7)).
+left.
+generalize (Rplus_eq_compat_l (- (PI / 2)) (PI / 2 + x) PI H7).
+replace (- (PI / 2) + (PI / 2 + x)) with x.
+replace (- (PI / 2) + PI) with (PI / 2).
+intro; assumption.
+pattern PI at 3 in |- *; rewrite (double_var PI); ring.
+ring.
+right.
+generalize (Rplus_eq_compat_l (- (PI / 2)) (PI / 2 + x) (2 * PI) H7).
+replace (- (PI / 2) + (PI / 2 + x)) with x.
+replace (- (PI / 2) + 2 * PI) with (3 * (PI / 2)).
+intro; assumption.
+rewrite double; pattern PI at 3 4 in |- *; rewrite (double_var PI); ring.
+ring.
+left; replace (2 * PI) with (PI / 2 + 3 * (PI / 2)).
+apply Rplus_lt_compat_l; assumption.
+rewrite (double PI); pattern PI at 3 4 in |- *; rewrite (double_var PI); ring.
+apply Rplus_le_le_0_compat.
+left; unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+apply PI_RGT_0.
+apply Rinv_0_lt_compat; prove_sup0.
+assumption.
+elim H2; intro.
+right; assumption.
+generalize (cos_eq_0_0 x H1); intro; elim H4; intros k0 H5.
+rewrite H5 in H3; rewrite H5 in H0;
+ generalize
+ (Rplus_lt_compat_l (- (PI / 2)) (3 * (PI / 2)) (IZR k0 * PI + PI / 2) H3);
+ generalize
+ (Rplus_le_compat_l (- (PI / 2)) (IZR k0 * PI + PI / 2) (2 * PI) H0).
+replace (- (PI / 2) + 3 * (PI / 2)) with PI.
+replace (- (PI / 2) + (IZR k0 * PI + PI / 2)) with (IZR k0 * PI).
+replace (- (PI / 2) + 2 * PI) with (3 * (PI / 2)).
+intros;
+ generalize
+ (Rmult_lt_compat_l (/ PI) PI (IZR k0 * PI) (Rinv_0_lt_compat PI PI_RGT_0)
+ H7);
+ generalize
+ (Rmult_le_compat_l (/ PI) (IZR k0 * PI) (3 * (PI / 2))
+ (Rlt_le 0 (/ PI) (Rinv_0_lt_compat PI PI_RGT_0)) H6).
+replace (/ PI * (IZR k0 * PI)) with (IZR k0).
+replace (/ PI * (3 * (PI / 2))) with (3 * / 2).
+rewrite <- Rinv_l_sym.
+intros; generalize (Rplus_lt_compat_l (IZR (-2)) 1 (IZR k0) H9);
+ rewrite <- plus_IZR.
+replace (IZR (-2) + 1) with (-1).
+intro; generalize (Rplus_le_compat_l (IZR (-2)) (IZR k0) (3 * / 2) H8);
+ rewrite <- plus_IZR.
+replace (IZR (-2) + 2) with 0.
+intro; cut (-1 < IZR (-2 + k0) < 1).
+intro; generalize (one_IZR_lt1 (-2 + k0) H12); intro.
+cut (k0 = 2%Z).
+intro; rewrite H14 in H8.
+assert (Hyp : 0 < 2).
+prove_sup0.
+generalize (Rmult_le_compat_l 2 (IZR 2) (3 * / 2) (Rlt_le 0 2 Hyp) H8);
+ simpl in |- *.
+replace 4 with 4.
+replace (2 * (3 * / 2)) with 3.
+intro; cut (3 < 4).
+intro; elim (Rlt_irrefl 3 (Rlt_le_trans 3 4 3 H16 H15)).
+generalize (Rplus_lt_compat_l 3 0 1 Rlt_0_1); rewrite Rplus_0_r.
+replace (3 + 1) with 4.
+intro; assumption.
+ring.
+symmetry in |- *; rewrite <- Rmult_assoc; apply Rinv_r_simpl_m.
+discrR.
+ring.
+rewrite <- (Zplus_opp_l 2) in H13; generalize (Zplus_reg_l (-2) k0 2 H13);
+ intro; assumption.
+split.
+assumption.
+apply Rle_lt_trans with (IZR (-2) + 3 * / 2).
+assumption.
+simpl in |- *; replace (-2 + 3 * / 2) with (- (1 * / 2)).
+apply Rlt_trans with 0.
+rewrite <- Ropp_0; apply Ropp_lt_gt_contravar.
+apply Rmult_lt_0_compat;
+ [ apply Rlt_0_1 | apply Rinv_0_lt_compat; prove_sup0 ].
+apply Rlt_0_1.
+rewrite Rmult_1_l; apply Rmult_eq_reg_l with 2.
+rewrite Ropp_mult_distr_r_reverse; rewrite <- Rinv_r_sym.
+rewrite Rmult_plus_distr_l; rewrite <- Rmult_assoc; rewrite Rinv_r_simpl_m.
+ring.
+discrR.
+discrR.
+discrR.
+simpl in |- *; ring.
+simpl in |- *; ring.
+apply PI_neq0.
+unfold Rdiv in |- *; pattern 3 at 1 in |- *; rewrite (Rmult_comm 3);
+ repeat rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
+rewrite Rmult_1_l; apply Rmult_comm.
+apply PI_neq0.
+symmetry in |- *; rewrite (Rmult_comm (/ PI)); rewrite Rmult_assoc;
+ rewrite <- Rinv_r_sym.
+apply Rmult_1_r.
+apply PI_neq0.
+rewrite double; pattern PI at 3 4 in |- *; rewrite double_var; ring.
+ring.
+pattern PI at 1 in |- *; rewrite double_var; ring.
+Qed.
+
+Lemma cos_eq_0_2PI_1 :
+ forall x:R,
+ 0 <= x -> x <= 2 * PI -> x = PI / 2 \/ x = 3 * (PI / 2) -> cos x = 0.
+intros x H1 H2 H3; elim H3; intro H4;
+ [ rewrite H4; rewrite cos_PI2; reflexivity
+ | rewrite H4; rewrite cos_3PI2; reflexivity ].
+Qed. \ No newline at end of file
diff --git a/theories/Reals/Rtrigo_alt.v b/theories/Reals/Rtrigo_alt.v
index 4fdc39106..c1ffc68ea 100644
--- a/theories/Reals/Rtrigo_alt.v
+++ b/theories/Reals/Rtrigo_alt.v
@@ -8,287 +8,419 @@
(*i $Id$ i*)
-Require Rbase.
-Require Rfunctions.
-Require SeqSeries.
-Require Rtrigo_def.
-V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
+Require Import Rbase.
+Require Import Rfunctions.
+Require Import SeqSeries.
+Require Import Rtrigo_def.
Open Local Scope R_scope.
(*****************************************************************)
(* Using series definitions of cos and sin *)
(*****************************************************************)
-Definition sin_term [a:R] : nat->R := [i:nat] ``(pow (-1) i)*(pow a (plus (mult (S (S O)) i) (S O)))/(INR (fact (plus (mult (S (S O)) i) (S O))))``.
+Definition sin_term (a:R) (i:nat) : R :=
+ (-1) ^ i * (a ^ (2 * i + 1) / INR (fact (2 * i + 1))).
-Definition cos_term [a:R] : nat->R := [i:nat] ``(pow (-1) i)*(pow a (mult (S (S O)) i))/(INR (fact (mult (S (S O)) i)))``.
+Definition cos_term (a:R) (i:nat) : R :=
+ (-1) ^ i * (a ^ (2 * i) / INR (fact (2 * i))).
-Definition sin_approx [a:R;n:nat] : R := (sum_f_R0 (sin_term a) n).
+Definition sin_approx (a:R) (n:nat) : R := sum_f_R0 (sin_term a) n.
-Definition cos_approx [a:R;n:nat] : R := (sum_f_R0 (cos_term a) n).
+Definition cos_approx (a:R) (n:nat) : R := sum_f_R0 (cos_term a) n.
(**********)
-Lemma PI_4 : ``PI<=4``.
-Assert H0 := (PI_ineq O).
-Elim H0; Clear H0; Intros _ H0.
-Unfold tg_alt PI_tg in H0; Simpl in H0.
-Rewrite Rinv_R1 in H0; Rewrite Rmult_1r in H0; Unfold Rdiv in H0.
-Apply Rle_monotony_contra with ``/4``.
-Apply Rlt_Rinv; Sup0.
-Rewrite <- Rinv_l_sym; [Rewrite Rmult_sym; Assumption | DiscrR].
+Lemma PI_4 : PI <= 4.
+assert (H0 := PI_ineq 0).
+elim H0; clear H0; intros _ H0.
+unfold tg_alt, PI_tg in H0; simpl in H0.
+rewrite Rinv_1 in H0; rewrite Rmult_1_r in H0; unfold Rdiv in H0.
+apply Rmult_le_reg_l with (/ 4).
+apply Rinv_0_lt_compat; prove_sup0.
+rewrite <- Rinv_l_sym; [ rewrite Rmult_comm; assumption | discrR ].
Qed.
(**********)
-Theorem sin_bound : (a:R; n:nat) ``0 <= a``->``a <= PI``->``(sin_approx a (plus (mult (S (S O)) n) (S O))) <= (sin a)<= (sin_approx a (mult (S (S O)) (plus n (S O))))``.
-Intros; Case (Req_EM a R0); Intro Hyp_a.
-Rewrite Hyp_a; Rewrite sin_0; Split; Right; Unfold sin_approx; Apply sum_eq_R0 Orelse (Symmetry; Apply sum_eq_R0); Intros; Unfold sin_term; Rewrite pow_add; Simpl; Unfold Rdiv; Rewrite Rmult_Ol; Ring.
-Unfold sin_approx; Cut ``0<a``.
-Intro Hyp_a_pos.
-Rewrite (decomp_sum (sin_term a) (plus (mult (S (S O)) n) (S O))).
-Rewrite (decomp_sum (sin_term a) (mult (S (S O)) (plus n (S O)))).
-Replace (sin_term a O) with a.
-Cut (Rle (sum_f_R0 [i:nat](sin_term a (S i)) (pred (plus (mult (S (S O)) n) (S O)))) ``(sin a)-a``)/\(Rle ``(sin a)-a`` (sum_f_R0 [i:nat](sin_term a (S i)) (pred (mult (S (S O)) (plus n (S O)))))) -> (Rle (Rplus a (sum_f_R0 [i:nat](sin_term a (S i)) (pred (plus (mult (S (S O)) n) (S O))))) (sin a))/\(Rle (sin a) (Rplus a (sum_f_R0 [i:nat](sin_term a (S i)) (pred (mult (S (S O)) (plus n (S O))))))).
-Intro; Apply H1.
-Pose Un := [n:nat]``(pow a (plus (mult (S (S O)) (S n)) (S O)))/(INR (fact (plus (mult (S (S O)) (S n)) (S O))))``.
-Replace (pred (plus (mult (S (S O)) n) (S O))) with (mult (S (S O)) n).
-Replace (pred (mult (S (S O)) (plus n (S O)))) with (S (mult (S (S O)) n)).
-Replace (sum_f_R0 [i:nat](sin_term a (S i)) (mult (S (S O)) n)) with ``-(sum_f_R0 (tg_alt Un) (mult (S (S O)) n))``.
-Replace (sum_f_R0 [i:nat](sin_term a (S i)) (S (mult (S (S O)) n))) with ``-(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) n)))``.
-Cut ``(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) n)))<=a-(sin a)<=(sum_f_R0 (tg_alt Un) (mult (S (S O)) n))``->`` -(sum_f_R0 (tg_alt Un) (mult (S (S O)) n)) <= (sin a)-a <= -(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) n)))``.
-Intro; Apply H2.
-Apply alternated_series_ineq.
-Unfold Un_decreasing Un; Intro; Cut (plus (mult (S (S O)) (S (S n0))) (S O))=(S (S (plus (mult (S (S O)) (S n0)) (S O)))).
-Intro; Rewrite H3.
-Replace ``(pow a (S (S (plus (mult (S (S O)) (S n0)) (S O)))))`` with ``(pow a (plus (mult (S (S O)) (S n0)) (S O)))*(a*a)``.
-Unfold Rdiv; Rewrite Rmult_assoc; Apply Rle_monotony.
-Left; Apply pow_lt; Assumption.
-Apply Rle_monotony_contra with ``(INR (fact (S (S (plus (mult (S (S O)) (S n0)) (S O))))))``.
-Rewrite <- H3; Apply lt_INR_0; Apply neq_O_lt; Red; Intro; Assert H5 := (sym_eq ? ? ? H4); Elim (fact_neq_0 ? H5).
-Rewrite <- H3; Rewrite (Rmult_sym ``(INR (fact (plus (mult (S (S O)) (S (S n0))) (S O))))``); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Rewrite H3; Do 2 Rewrite fact_simpl; Do 2 Rewrite mult_INR; Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r.
-Do 2 Rewrite S_INR; Rewrite plus_INR; Rewrite mult_INR; Repeat Rewrite S_INR; Simpl; Replace ``((0+1+1)*((INR n0)+1)+(0+1)+1+1)*((0+1+1)*((INR n0)+1)+(0+1)+1)`` with ``4*(INR n0)*(INR n0)+18*(INR n0)+20``; [Idtac | Ring].
-Apply Rle_trans with ``20``.
-Apply Rle_trans with ``16``.
-Replace ``16`` with ``(Rsqr 4)``; [Idtac | SqRing].
-Replace ``a*a`` with (Rsqr a); [Idtac | Reflexivity].
-Apply Rsqr_incr_1.
-Apply Rle_trans with PI; [Assumption | Apply PI_4].
-Assumption.
-Left; Sup0.
-Rewrite <- (Rplus_Or ``16``); Replace ``20`` with ``16+4``; [Apply Rle_compatibility; Left; Sup0 | Ring].
-Rewrite <- (Rplus_sym ``20``); Pattern 1 ``20``; Rewrite <- Rplus_Or; Apply Rle_compatibility.
-Apply ge0_plus_ge0_is_ge0.
-Repeat Apply Rmult_le_pos.
-Left; Sup0.
-Left; Sup0.
-Replace R0 with (INR O); [Apply le_INR; Apply le_O_n | Reflexivity].
-Replace R0 with (INR O); [Apply le_INR; Apply le_O_n | Reflexivity].
-Apply Rmult_le_pos.
-Left; Sup0.
-Replace R0 with (INR O); [Apply le_INR; Apply le_O_n | Reflexivity].
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Simpl; Ring.
-Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite plus_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Assert H3 := (cv_speed_pow_fact a); Unfold Un; Unfold Un_cv in H3; Unfold R_dist in H3; Unfold Un_cv; Unfold R_dist; Intros; Elim (H3 eps H4); Intros N H5.
-Exists N; Intros; Apply H5.
-Replace (plus (mult (2) (S n0)) (1)) with (S (mult (2) (S n0))).
-Unfold ge; Apply le_trans with (mult (2) (S n0)).
-Apply le_trans with (mult (2) (S N)).
-Apply le_trans with (mult (2) N).
-Apply le_n_2n.
-Apply mult_le; Apply le_n_Sn.
-Apply mult_le; Apply le_n_S; Assumption.
-Apply le_n_Sn.
-Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Rewrite mult_INR; Reflexivity.
-Assert X := (exist_sin (Rsqr a)); Elim X; Intros.
-Cut ``x==(sin a)/a``.
-Intro; Rewrite H3 in p; Unfold sin_in in p; Unfold infinit_sum in p; Unfold R_dist in p; Unfold Un_cv; Unfold R_dist; Intros.
-Cut ``0<eps/(Rabsolu a)``.
-Intro; Elim (p ? H5); Intros N H6.
-Exists N; Intros.
-Replace (sum_f_R0 (tg_alt Un) n0) with (Rmult a (Rminus R1 (sum_f_R0 [i:nat]``(sin_n i)*(pow (Rsqr a) i)`` (S n0)))).
-Unfold Rminus; Rewrite Rmult_Rplus_distr; Rewrite Rmult_1r; Rewrite Ropp_distr1; Rewrite Ropp_Ropp; Repeat Rewrite Rplus_assoc; Rewrite (Rplus_sym a); Rewrite (Rplus_sym ``-a``); Repeat Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Apply Rlt_monotony_contra with ``/(Rabsolu a)``.
-Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption.
-Pattern 1 ``/(Rabsolu a)``; Rewrite <- (Rabsolu_Rinv a Hyp_a).
-Rewrite <- Rabsolu_mult; Rewrite Rmult_Rplus_distr; Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym; [Rewrite Rmult_1l | Assumption]; Rewrite (Rmult_sym ``/a``); Rewrite (Rmult_sym ``/(Rabsolu a)``); Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr1; Rewrite Ropp_Ropp; Unfold Rminus Rdiv in H6; Apply H6; Unfold ge; Apply le_trans with n0; [Exact H7 | Apply le_n_Sn].
-Rewrite (decomp_sum [i:nat]``(sin_n i)*(pow (Rsqr a) i)`` (S n0)).
-Replace (sin_n O) with R1.
-Simpl; Rewrite Rmult_1r; Unfold Rminus; Rewrite Ropp_distr1; Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Ol; Rewrite Ropp_mul3; Rewrite <- Ropp_mul1; Rewrite scal_sum; Apply sum_eq.
-Intros; Unfold sin_n Un tg_alt; Replace ``(pow (-1) (S i))`` with ``-(pow (-1) i)``.
-Replace ``(pow a (plus (mult (S (S O)) (S i)) (S O)))`` with ``(Rsqr a)*(pow (Rsqr a) i)*a``.
-Unfold Rdiv; Ring.
-Rewrite pow_add; Rewrite pow_Rsqr; Simpl; Ring.
-Simpl; Ring.
-Unfold sin_n; Unfold Rdiv; Simpl; Rewrite Rinv_R1; Rewrite Rmult_1r; Reflexivity.
-Apply lt_O_Sn.
-Unfold Rdiv; Apply Rmult_lt_pos.
-Assumption.
-Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption.
-Unfold sin; Case (exist_sin (Rsqr a)).
-Intros; Cut x==x0.
-Intro; Rewrite H3; Unfold Rdiv.
-Symmetry; Apply Rinv_r_simpl_m; Assumption.
-Unfold sin_in in p; Unfold sin_in in s; EApply unicity_sum.
-Apply p.
-Apply s.
-Intros; Elim H2; Intros.
-Replace ``(sin a)-a`` with ``-(a-(sin a))``; [Idtac | Ring].
-Split; Apply Rle_Ropp1; Assumption.
-Replace ``-(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) n)))`` with ``-1*(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) n)))``; [Rewrite scal_sum | Ring].
-Apply sum_eq; Intros; Unfold sin_term Un tg_alt; Replace ``(pow (-1) (S i))`` with ``-1*(pow (-1) i)``.
-Unfold Rdiv; Ring.
-Reflexivity.
-Replace ``-(sum_f_R0 (tg_alt Un) (mult (S (S O)) n))`` with ``-1*(sum_f_R0 (tg_alt Un) (mult (S (S O)) n))``; [Rewrite scal_sum | Ring].
-Apply sum_eq; Intros.
-Unfold sin_term Un tg_alt; Replace ``(pow (-1) (S i))`` with ``-1*(pow (-1) i)``.
-Unfold Rdiv; Ring.
-Reflexivity.
-Replace (mult (2) (plus n (1))) with (S (S (mult (2) n))).
-Reflexivity.
-Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Rewrite plus_INR; Repeat Rewrite S_INR; Ring.
-Replace (plus (mult (2) n) (1)) with (S (mult (2) n)).
-Reflexivity.
-Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Intro; Elim H1; Intros.
-Split.
-Apply Rle_anti_compatibility with ``-a``.
-Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Rewrite (Rplus_sym ``-a``); Apply H2.
-Apply Rle_anti_compatibility with ``-a``.
-Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Rewrite (Rplus_sym ``-a``); Apply H3.
-Unfold sin_term; Simpl; Unfold Rdiv; Rewrite Rinv_R1; Ring.
-Replace (mult (2) (plus n (1))) with (S (S (mult (2) n))).
-Apply lt_O_Sn.
-Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Rewrite plus_INR; Repeat Rewrite S_INR; Ring.
-Replace (plus (mult (2) n) (1)) with (S (mult (2) n)).
-Apply lt_O_Sn.
-Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Inversion H; [Assumption | Elim Hyp_a; Symmetry; Assumption].
+Theorem sin_bound :
+ forall (a:R) (n:nat),
+ 0 <= a ->
+ a <= PI -> sin_approx a (2 * n + 1) <= sin a <= sin_approx a (2 * (n + 1)).
+intros; case (Req_dec a 0); intro Hyp_a.
+rewrite Hyp_a; rewrite sin_0; split; right; unfold sin_approx in |- *;
+ apply sum_eq_R0 || (symmetry in |- *; apply sum_eq_R0);
+ intros; unfold sin_term in |- *; rewrite pow_add;
+ simpl in |- *; unfold Rdiv in |- *; rewrite Rmult_0_l;
+ ring.
+unfold sin_approx in |- *; cut (0 < a).
+intro Hyp_a_pos.
+rewrite (decomp_sum (sin_term a) (2 * n + 1)).
+rewrite (decomp_sum (sin_term a) (2 * (n + 1))).
+replace (sin_term a 0) with a.
+cut
+ (sum_f_R0 (fun i:nat => sin_term a (S i)) (pred (2 * n + 1)) <= sin a - a /\
+ sin a - a <= sum_f_R0 (fun i:nat => sin_term a (S i)) (pred (2 * (n + 1))) ->
+ a + sum_f_R0 (fun i:nat => sin_term a (S i)) (pred (2 * n + 1)) <= sin a /\
+ sin a <= a + sum_f_R0 (fun i:nat => sin_term a (S i)) (pred (2 * (n + 1)))).
+intro; apply H1.
+pose (Un := fun n:nat => a ^ (2 * S n + 1) / INR (fact (2 * S n + 1))).
+replace (pred (2 * n + 1)) with (2 * n)%nat.
+replace (pred (2 * (n + 1))) with (S (2 * n)).
+replace (sum_f_R0 (fun i:nat => sin_term a (S i)) (2 * n)) with
+ (- sum_f_R0 (tg_alt Un) (2 * n)).
+replace (sum_f_R0 (fun i:nat => sin_term a (S i)) (S (2 * n))) with
+ (- sum_f_R0 (tg_alt Un) (S (2 * n))).
+cut
+ (sum_f_R0 (tg_alt Un) (S (2 * n)) <= a - sin a <=
+ sum_f_R0 (tg_alt Un) (2 * n) ->
+ - sum_f_R0 (tg_alt Un) (2 * n) <= sin a - a <=
+ - sum_f_R0 (tg_alt Un) (S (2 * n))).
+intro; apply H2.
+apply alternated_series_ineq.
+unfold Un_decreasing, Un in |- *; intro;
+ cut ((2 * S (S n0) + 1)%nat = S (S (2 * S n0 + 1))).
+intro; rewrite H3.
+replace (a ^ S (S (2 * S n0 + 1))) with (a ^ (2 * S n0 + 1) * (a * a)).
+unfold Rdiv in |- *; rewrite Rmult_assoc; apply Rmult_le_compat_l.
+left; apply pow_lt; assumption.
+apply Rmult_le_reg_l with (INR (fact (S (S (2 * S n0 + 1))))).
+rewrite <- H3; apply lt_INR_0; apply neq_O_lt; red in |- *; intro;
+ assert (H5 := sym_eq H4); elim (fact_neq_0 _ H5).
+rewrite <- H3; rewrite (Rmult_comm (INR (fact (2 * S (S n0) + 1))));
+ rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r; rewrite H3; do 2 rewrite fact_simpl; do 2 rewrite mult_INR;
+ repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym.
+rewrite Rmult_1_r.
+do 2 rewrite S_INR; rewrite plus_INR; rewrite mult_INR; repeat rewrite S_INR;
+ simpl in |- *;
+ replace
+ (((0 + 1 + 1) * (INR n0 + 1) + (0 + 1) + 1 + 1) *
+ ((0 + 1 + 1) * (INR n0 + 1) + (0 + 1) + 1)) with
+ (4 * INR n0 * INR n0 + 18 * INR n0 + 20); [ idtac | ring ].
+apply Rle_trans with 20.
+apply Rle_trans with 16.
+replace 16 with (Rsqr 4); [ idtac | ring_Rsqr ].
+replace (a * a) with (Rsqr a); [ idtac | reflexivity ].
+apply Rsqr_incr_1.
+apply Rle_trans with PI; [ assumption | apply PI_4 ].
+assumption.
+left; prove_sup0.
+rewrite <- (Rplus_0_r 16); replace 20 with (16 + 4);
+ [ apply Rplus_le_compat_l; left; prove_sup0 | ring ].
+rewrite <- (Rplus_comm 20); pattern 20 at 1 in |- *; rewrite <- Rplus_0_r;
+ apply Rplus_le_compat_l.
+apply Rplus_le_le_0_compat.
+repeat apply Rmult_le_pos.
+left; prove_sup0.
+left; prove_sup0.
+replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ].
+replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ].
+apply Rmult_le_pos.
+left; prove_sup0.
+replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ].
+apply INR_fact_neq_0.
+apply INR_fact_neq_0.
+simpl in |- *; ring.
+apply INR_eq; do 2 rewrite S_INR; do 2 rewrite plus_INR;
+ do 2 rewrite mult_INR; repeat rewrite S_INR; ring.
+assert (H3 := cv_speed_pow_fact a); unfold Un in |- *; unfold Un_cv in H3;
+ unfold R_dist in H3; unfold Un_cv in |- *; unfold R_dist in |- *;
+ intros; elim (H3 eps H4); intros N H5.
+exists N; intros; apply H5.
+replace (2 * S n0 + 1)%nat with (S (2 * S n0)).
+unfold ge in |- *; apply le_trans with (2 * S n0)%nat.
+apply le_trans with (2 * S N)%nat.
+apply le_trans with (2 * N)%nat.
+apply le_n_2n.
+apply (fun m n p:nat => mult_le_compat_l p n m); apply le_n_Sn.
+apply (fun m n p:nat => mult_le_compat_l p n m); apply le_n_S; assumption.
+apply le_n_Sn.
+apply INR_eq; rewrite S_INR; rewrite plus_INR; rewrite mult_INR; reflexivity.
+assert (X := exist_sin (Rsqr a)); elim X; intros.
+cut (x = sin a / a).
+intro; rewrite H3 in p; unfold sin_in in p; unfold infinit_sum in p;
+ unfold R_dist in p; unfold Un_cv in |- *; unfold R_dist in |- *;
+ intros.
+cut (0 < eps / Rabs a).
+intro; elim (p _ H5); intros N H6.
+exists N; intros.
+replace (sum_f_R0 (tg_alt Un) n0) with
+ (a * (1 - sum_f_R0 (fun i:nat => sin_n i * Rsqr a ^ i) (S n0))).
+unfold Rminus in |- *; rewrite Rmult_plus_distr_l; rewrite Rmult_1_r;
+ rewrite Ropp_plus_distr; rewrite Ropp_involutive;
+ repeat rewrite Rplus_assoc; rewrite (Rplus_comm a);
+ rewrite (Rplus_comm (- a)); repeat rewrite Rplus_assoc;
+ rewrite Rplus_opp_l; rewrite Rplus_0_r; apply Rmult_lt_reg_l with (/ Rabs a).
+apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption.
+pattern (/ Rabs a) at 1 in |- *; rewrite <- (Rabs_Rinv a Hyp_a).
+rewrite <- Rabs_mult; rewrite Rmult_plus_distr_l; rewrite <- Rmult_assoc;
+ rewrite <- Rinv_l_sym; [ rewrite Rmult_1_l | assumption ];
+ rewrite (Rmult_comm (/ a)); rewrite (Rmult_comm (/ Rabs a));
+ rewrite <- Rabs_Ropp; rewrite Ropp_plus_distr; rewrite Ropp_involutive;
+ unfold Rminus, Rdiv in H6; apply H6; unfold ge in |- *;
+ apply le_trans with n0; [ exact H7 | apply le_n_Sn ].
+rewrite (decomp_sum (fun i:nat => sin_n i * Rsqr a ^ i) (S n0)).
+replace (sin_n 0) with 1.
+simpl in |- *; rewrite Rmult_1_r; unfold Rminus in |- *;
+ rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; rewrite Rplus_opp_r;
+ rewrite Rplus_0_l; rewrite Ropp_mult_distr_r_reverse;
+ rewrite <- Ropp_mult_distr_l_reverse; rewrite scal_sum;
+ apply sum_eq.
+intros; unfold sin_n, Un, tg_alt in |- *;
+ replace ((-1) ^ S i) with (- (-1) ^ i).
+replace (a ^ (2 * S i + 1)) with (Rsqr a * Rsqr a ^ i * a).
+unfold Rdiv in |- *; ring.
+rewrite pow_add; rewrite pow_Rsqr; simpl in |- *; ring.
+simpl in |- *; ring.
+unfold sin_n in |- *; unfold Rdiv in |- *; simpl in |- *; rewrite Rinv_1;
+ rewrite Rmult_1_r; reflexivity.
+apply lt_O_Sn.
+unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+assumption.
+apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption.
+unfold sin in |- *; case (exist_sin (Rsqr a)).
+intros; cut (x = x0).
+intro; rewrite H3; unfold Rdiv in |- *.
+symmetry in |- *; apply Rinv_r_simpl_m; assumption.
+unfold sin_in in p; unfold sin_in in s; eapply uniqueness_sum.
+apply p.
+apply s.
+intros; elim H2; intros.
+replace (sin a - a) with (- (a - sin a)); [ idtac | ring ].
+split; apply Ropp_le_contravar; assumption.
+replace (- sum_f_R0 (tg_alt Un) (S (2 * n))) with
+ (-1 * sum_f_R0 (tg_alt Un) (S (2 * n))); [ rewrite scal_sum | ring ].
+apply sum_eq; intros; unfold sin_term, Un, tg_alt in |- *;
+ replace ((-1) ^ S i) with (-1 * (-1) ^ i).
+unfold Rdiv in |- *; ring.
+reflexivity.
+replace (- sum_f_R0 (tg_alt Un) (2 * n)) with
+ (-1 * sum_f_R0 (tg_alt Un) (2 * n)); [ rewrite scal_sum | ring ].
+apply sum_eq; intros.
+unfold sin_term, Un, tg_alt in |- *;
+ replace ((-1) ^ S i) with (-1 * (-1) ^ i).
+unfold Rdiv in |- *; ring.
+reflexivity.
+replace (2 * (n + 1))%nat with (S (S (2 * n))).
+reflexivity.
+apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; rewrite plus_INR;
+ repeat rewrite S_INR; ring.
+replace (2 * n + 1)%nat with (S (2 * n)).
+reflexivity.
+apply INR_eq; rewrite S_INR; rewrite plus_INR; rewrite mult_INR;
+ repeat rewrite S_INR; ring.
+intro; elim H1; intros.
+split.
+apply Rplus_le_reg_l with (- a).
+rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l;
+ rewrite (Rplus_comm (- a)); apply H2.
+apply Rplus_le_reg_l with (- a).
+rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l;
+ rewrite (Rplus_comm (- a)); apply H3.
+unfold sin_term in |- *; simpl in |- *; unfold Rdiv in |- *; rewrite Rinv_1;
+ ring.
+replace (2 * (n + 1))%nat with (S (S (2 * n))).
+apply lt_O_Sn.
+apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; rewrite plus_INR;
+ repeat rewrite S_INR; ring.
+replace (2 * n + 1)%nat with (S (2 * n)).
+apply lt_O_Sn.
+apply INR_eq; rewrite S_INR; rewrite plus_INR; rewrite mult_INR;
+ repeat rewrite S_INR; ring.
+inversion H; [ assumption | elim Hyp_a; symmetry in |- *; assumption ].
Qed.
(**********)
-Lemma cos_bound : (a:R; n:nat) `` -PI/2 <= a``->``a <= PI/2``->``(cos_approx a (plus (mult (S (S O)) n) (S O))) <= (cos a) <= (cos_approx a (mult (S (S O)) (plus n (S O))))``.
-Cut ((a:R; n:nat) ``0 <= a``->``a <= PI/2``->``(cos_approx a (plus (mult (S (S O)) n) (S O))) <= (cos a) <= (cos_approx a (mult (S (S O)) (plus n (S O))))``) -> ((a:R; n:nat) `` -PI/2 <= a``->``a <= PI/2``->``(cos_approx a (plus (mult (S (S O)) n) (S O))) <= (cos a) <= (cos_approx a (mult (S (S O)) (plus n (S O))))``).
-Intros H a n; Apply H.
-Intros; Unfold cos_approx.
-Rewrite (decomp_sum (cos_term a0) (plus (mult (S (S O)) n0) (S O))).
-Rewrite (decomp_sum (cos_term a0) (mult (S (S O)) (plus n0 (S O)))).
-Replace (cos_term a0 O) with R1.
-Cut (Rle (sum_f_R0 [i:nat](cos_term a0 (S i)) (pred (plus (mult (S (S O)) n0) (S O)))) ``(cos a0)-1``)/\(Rle ``(cos a0)-1`` (sum_f_R0 [i:nat](cos_term a0 (S i)) (pred (mult (S (S O)) (plus n0 (S O)))))) -> (Rle (Rplus R1 (sum_f_R0 [i:nat](cos_term a0 (S i)) (pred (plus (mult (S (S O)) n0) (S O))))) (cos a0))/\(Rle (cos a0) (Rplus R1 (sum_f_R0 [i:nat](cos_term a0 (S i)) (pred (mult (S (S O)) (plus n0 (S O))))))).
-Intro; Apply H2.
-Pose Un := [n:nat]``(pow a0 (mult (S (S O)) (S n)))/(INR (fact (mult (S (S O)) (S n))))``.
-Replace (pred (plus (mult (S (S O)) n0) (S O))) with (mult (S (S O)) n0).
-Replace (pred (mult (S (S O)) (plus n0 (S O)))) with (S (mult (S (S O)) n0)).
-Replace (sum_f_R0 [i:nat](cos_term a0 (S i)) (mult (S (S O)) n0)) with ``-(sum_f_R0 (tg_alt Un) (mult (S (S O)) n0))``.
-Replace (sum_f_R0 [i:nat](cos_term a0 (S i)) (S (mult (S (S O)) n0))) with ``-(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) n0)))``.
-Cut ``(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) n0)))<=1-(cos a0)<=(sum_f_R0 (tg_alt Un) (mult (S (S O)) n0))``->`` -(sum_f_R0 (tg_alt Un) (mult (S (S O)) n0)) <= (cos a0)-1 <= -(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) n0)))``.
-Intro; Apply H3.
-Apply alternated_series_ineq.
-Unfold Un_decreasing; Intro; Unfold Un.
-Cut (mult (S (S O)) (S (S n1)))=(S (S (mult (S (S O)) (S n1)))).
-Intro; Rewrite H4; Replace ``(pow a0 (S (S (mult (S (S O)) (S n1)))))`` with ``(pow a0 (mult (S (S O)) (S n1)))*(a0*a0)``.
-Unfold Rdiv; Rewrite Rmult_assoc; Apply Rle_monotony.
-Apply pow_le; Assumption.
-Apply Rle_monotony_contra with ``(INR (fact (S (S (mult (S (S O)) (S n1))))))``.
-Rewrite <- H4; Apply lt_INR_0; Apply neq_O_lt; Red; Intro; Assert H6 := (sym_eq ? ? ? H5); Elim (fact_neq_0 ? H6).
-Rewrite <- H4; Rewrite (Rmult_sym ``(INR (fact (mult (S (S O)) (S (S n1)))))``); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Rewrite H4; Do 2 Rewrite fact_simpl; Do 2 Rewrite mult_INR; Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Do 2 Rewrite S_INR; Rewrite mult_INR; Repeat Rewrite S_INR; Simpl; Replace ``((0+1+1)*((INR n1)+1)+1+1)*((0+1+1)*((INR n1)+1)+1)`` with ``4*(INR n1)*(INR n1)+14*(INR n1)+12``; [Idtac | Ring].
-Apply Rle_trans with ``12``.
-Apply Rle_trans with ``4``.
-Replace ``4`` with ``(Rsqr 2)``; [Idtac | SqRing].
-Replace ``a0*a0`` with (Rsqr a0); [Idtac | Reflexivity].
-Apply Rsqr_incr_1.
-Apply Rle_trans with ``PI/2``.
-Assumption.
-Unfold Rdiv; Apply Rle_monotony_contra with ``2``.
-Sup0.
-Rewrite <- Rmult_assoc; Rewrite Rinv_r_simpl_m.
-Replace ``2*2`` with ``4``; [Apply PI_4 | Ring].
-DiscrR.
-Assumption.
-Left; Sup0.
-Pattern 1 ``4``; Rewrite <- Rplus_Or; Replace ``12`` with ``4+8``; [Apply Rle_compatibility; Left; Sup0 | Ring].
-Rewrite <- (Rplus_sym ``12``); Pattern 1 ``12``; Rewrite <- Rplus_Or; Apply Rle_compatibility.
-Apply ge0_plus_ge0_is_ge0.
-Repeat Apply Rmult_le_pos.
-Left; Sup0.
-Left; Sup0.
-Replace R0 with (INR O); [Apply le_INR; Apply le_O_n | Reflexivity].
-Replace R0 with (INR O); [Apply le_INR; Apply le_O_n | Reflexivity].
-Apply Rmult_le_pos.
-Left; Sup0.
-Replace R0 with (INR O); [Apply le_INR; Apply le_O_n | Reflexivity].
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Simpl; Ring.
-Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Assert H4 := (cv_speed_pow_fact a0); Unfold Un; Unfold Un_cv in H4; Unfold R_dist in H4; Unfold Un_cv; Unfold R_dist; Intros; Elim (H4 eps H5); Intros N H6; Exists N; Intros.
-Apply H6; Unfold ge; Apply le_trans with (mult (2) (S N)).
-Apply le_trans with (mult (2) N).
-Apply le_n_2n.
-Apply mult_le; Apply le_n_Sn.
-Apply mult_le; Apply le_n_S; Assumption.
-Assert X := (exist_cos (Rsqr a0)); Elim X; Intros.
-Cut ``x==(cos a0)``.
-Intro; Rewrite H4 in p; Unfold cos_in in p; Unfold infinit_sum in p; Unfold R_dist in p; Unfold Un_cv; Unfold R_dist; Intros.
-Elim (p ? H5); Intros N H6.
-Exists N; Intros.
-Replace (sum_f_R0 (tg_alt Un) n1) with (Rminus R1 (sum_f_R0 [i:nat]``(cos_n i)*(pow (Rsqr a0) i)`` (S n1))).
-Unfold Rminus; Rewrite Ropp_distr1; Rewrite Ropp_Ropp; Repeat Rewrite Rplus_assoc; Rewrite (Rplus_sym R1); Rewrite (Rplus_sym ``-1``); Repeat Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr1; Rewrite Ropp_Ropp; Unfold Rminus in H6; Apply H6.
-Unfold ge; Apply le_trans with n1.
-Exact H7.
-Apply le_n_Sn.
-Rewrite (decomp_sum [i:nat]``(cos_n i)*(pow (Rsqr a0) i)`` (S n1)).
-Replace (cos_n O) with R1.
-Simpl; Rewrite Rmult_1r; Unfold Rminus; Rewrite Ropp_distr1; Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Ol; Replace (Ropp (sum_f_R0 [i:nat]``(cos_n (S i))*((Rsqr a0)*(pow (Rsqr a0) i))`` n1)) with (Rmult ``-1`` (sum_f_R0 [i:nat]``(cos_n (S i))*((Rsqr a0)*(pow (Rsqr a0) i))`` n1)); [Idtac | Ring]; Rewrite scal_sum; Apply sum_eq; Intros; Unfold cos_n Un tg_alt.
-Replace ``(pow (-1) (S i))`` with ``-(pow (-1) i)``.
-Replace ``(pow a0 (mult (S (S O)) (S i)))`` with ``(Rsqr a0)*(pow (Rsqr a0) i)``.
-Unfold Rdiv; Ring.
-Rewrite pow_Rsqr; Reflexivity.
-Simpl; Ring.
-Unfold cos_n; Unfold Rdiv; Simpl; Rewrite Rinv_R1; Rewrite Rmult_1r; Reflexivity.
-Apply lt_O_Sn.
-Unfold cos; Case (exist_cos (Rsqr a0)); Intros; Unfold cos_in in p; Unfold cos_in in c; EApply unicity_sum.
-Apply p.
-Apply c.
-Intros; Elim H3; Intros; Replace ``(cos a0)-1`` with ``-(1-(cos a0))``; [Idtac | Ring].
-Split; Apply Rle_Ropp1; Assumption.
-Replace ``-(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) n0)))`` with ``-1*(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) n0)))``; [Rewrite scal_sum | Ring].
-Apply sum_eq; Intros; Unfold cos_term Un tg_alt; Replace ``(pow (-1) (S i))`` with ``-1*(pow (-1) i)``.
-Unfold Rdiv; Ring.
-Reflexivity.
-Replace ``-(sum_f_R0 (tg_alt Un) (mult (S (S O)) n0))`` with ``-1*(sum_f_R0 (tg_alt Un) (mult (S (S O)) n0))``; [Rewrite scal_sum | Ring]; Apply sum_eq; Intros; Unfold cos_term Un tg_alt; Replace ``(pow (-1) (S i))`` with ``-1*(pow (-1) i)``.
-Unfold Rdiv; Ring.
-Reflexivity.
-Replace (mult (2) (plus n0 (1))) with (S (S (mult (2) n0))).
-Reflexivity.
-Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Rewrite plus_INR; Repeat Rewrite S_INR; Ring.
-Replace (plus (mult (2) n0) (1)) with (S (mult (2) n0)).
-Reflexivity.
-Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Intro; Elim H2; Intros; Split.
-Apply Rle_anti_compatibility with ``-1``.
-Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Rewrite (Rplus_sym ``-1``); Apply H3.
-Apply Rle_anti_compatibility with ``-1``.
-Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Rewrite (Rplus_sym ``-1``); Apply H4.
-Unfold cos_term; Simpl; Unfold Rdiv; Rewrite Rinv_R1; Ring.
-Replace (mult (2) (plus n0 (1))) with (S (S (mult (2) n0))).
-Apply lt_O_Sn.
-Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Rewrite plus_INR; Repeat Rewrite S_INR; Ring.
-Replace (plus (mult (2) n0) (1)) with (S (mult (2) n0)).
-Apply lt_O_Sn.
-Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Intros; Case (total_order_T R0 a); Intro.
-Elim s; Intro.
-Apply H; [Left; Assumption | Assumption].
-Apply H; [Right; Assumption | Assumption].
-Cut ``0< -a``.
-Intro; Cut (x:R;n:nat) (cos_approx x n)==(cos_approx ``-x`` n).
-Intro; Rewrite H3; Rewrite (H3 a (mult (S (S O)) (plus n (S O)))); Rewrite cos_sym; Apply H.
-Left; Assumption.
-Rewrite <- (Ropp_Ropp ``PI/2``); Apply Rle_Ropp1; Unfold Rdiv; Unfold Rdiv in H0; Rewrite <- Ropp_mul1; Exact H0.
-Intros; Unfold cos_approx; Apply sum_eq; Intros; Unfold cos_term; Do 2 Rewrite pow_Rsqr; Rewrite Rsqr_neg; Unfold Rdiv; Reflexivity.
-Apply Rgt_RO_Ropp; Assumption.
-Qed.
+Lemma cos_bound :
+ forall (a:R) (n:nat),
+ - PI / 2 <= a ->
+ a <= PI / 2 ->
+ cos_approx a (2 * n + 1) <= cos a <= cos_approx a (2 * (n + 1)).
+cut
+ ((forall (a:R) (n:nat),
+ 0 <= a ->
+ a <= PI / 2 ->
+ cos_approx a (2 * n + 1) <= cos a <= cos_approx a (2 * (n + 1))) ->
+ forall (a:R) (n:nat),
+ - PI / 2 <= a ->
+ a <= PI / 2 ->
+ cos_approx a (2 * n + 1) <= cos a <= cos_approx a (2 * (n + 1))).
+intros H a n; apply H.
+intros; unfold cos_approx in |- *.
+rewrite (decomp_sum (cos_term a0) (2 * n0 + 1)).
+rewrite (decomp_sum (cos_term a0) (2 * (n0 + 1))).
+replace (cos_term a0 0) with 1.
+cut
+ (sum_f_R0 (fun i:nat => cos_term a0 (S i)) (pred (2 * n0 + 1)) <= cos a0 - 1 /\
+ cos a0 - 1 <=
+ sum_f_R0 (fun i:nat => cos_term a0 (S i)) (pred (2 * (n0 + 1))) ->
+ 1 + sum_f_R0 (fun i:nat => cos_term a0 (S i)) (pred (2 * n0 + 1)) <= cos a0 /\
+ cos a0 <=
+ 1 + sum_f_R0 (fun i:nat => cos_term a0 (S i)) (pred (2 * (n0 + 1)))).
+intro; apply H2.
+pose (Un := fun n:nat => a0 ^ (2 * S n) / INR (fact (2 * S n))).
+replace (pred (2 * n0 + 1)) with (2 * n0)%nat.
+replace (pred (2 * (n0 + 1))) with (S (2 * n0)).
+replace (sum_f_R0 (fun i:nat => cos_term a0 (S i)) (2 * n0)) with
+ (- sum_f_R0 (tg_alt Un) (2 * n0)).
+replace (sum_f_R0 (fun i:nat => cos_term a0 (S i)) (S (2 * n0))) with
+ (- sum_f_R0 (tg_alt Un) (S (2 * n0))).
+cut
+ (sum_f_R0 (tg_alt Un) (S (2 * n0)) <= 1 - cos a0 <=
+ sum_f_R0 (tg_alt Un) (2 * n0) ->
+ - sum_f_R0 (tg_alt Un) (2 * n0) <= cos a0 - 1 <=
+ - sum_f_R0 (tg_alt Un) (S (2 * n0))).
+intro; apply H3.
+apply alternated_series_ineq.
+unfold Un_decreasing in |- *; intro; unfold Un in |- *.
+cut ((2 * S (S n1))%nat = S (S (2 * S n1))).
+intro; rewrite H4;
+ replace (a0 ^ S (S (2 * S n1))) with (a0 ^ (2 * S n1) * (a0 * a0)).
+unfold Rdiv in |- *; rewrite Rmult_assoc; apply Rmult_le_compat_l.
+apply pow_le; assumption.
+apply Rmult_le_reg_l with (INR (fact (S (S (2 * S n1))))).
+rewrite <- H4; apply lt_INR_0; apply neq_O_lt; red in |- *; intro;
+ assert (H6 := sym_eq H5); elim (fact_neq_0 _ H6).
+rewrite <- H4; rewrite (Rmult_comm (INR (fact (2 * S (S n1)))));
+ rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r; rewrite H4; do 2 rewrite fact_simpl; do 2 rewrite mult_INR;
+ repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym.
+rewrite Rmult_1_r; do 2 rewrite S_INR; rewrite mult_INR; repeat rewrite S_INR;
+ simpl in |- *;
+ replace
+ (((0 + 1 + 1) * (INR n1 + 1) + 1 + 1) * ((0 + 1 + 1) * (INR n1 + 1) + 1))
+ with (4 * INR n1 * INR n1 + 14 * INR n1 + 12); [ idtac | ring ].
+apply Rle_trans with 12.
+apply Rle_trans with 4.
+replace 4 with (Rsqr 2); [ idtac | ring_Rsqr ].
+replace (a0 * a0) with (Rsqr a0); [ idtac | reflexivity ].
+apply Rsqr_incr_1.
+apply Rle_trans with (PI / 2).
+assumption.
+unfold Rdiv in |- *; apply Rmult_le_reg_l with 2.
+prove_sup0.
+rewrite <- Rmult_assoc; rewrite Rinv_r_simpl_m.
+replace 4 with 4; [ apply PI_4 | ring ].
+discrR.
+assumption.
+left; prove_sup0.
+pattern 4 at 1 in |- *; rewrite <- Rplus_0_r; replace 12 with (4 + 8);
+ [ apply Rplus_le_compat_l; left; prove_sup0 | ring ].
+rewrite <- (Rplus_comm 12); pattern 12 at 1 in |- *; rewrite <- Rplus_0_r;
+ apply Rplus_le_compat_l.
+apply Rplus_le_le_0_compat.
+repeat apply Rmult_le_pos.
+left; prove_sup0.
+left; prove_sup0.
+replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ].
+replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ].
+apply Rmult_le_pos.
+left; prove_sup0.
+replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ].
+apply INR_fact_neq_0.
+apply INR_fact_neq_0.
+simpl in |- *; ring.
+apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR;
+ ring.
+assert (H4 := cv_speed_pow_fact a0); unfold Un in |- *; unfold Un_cv in H4;
+ unfold R_dist in H4; unfold Un_cv in |- *; unfold R_dist in |- *;
+ intros; elim (H4 eps H5); intros N H6; exists N; intros.
+apply H6; unfold ge in |- *; apply le_trans with (2 * S N)%nat.
+apply le_trans with (2 * N)%nat.
+apply le_n_2n.
+apply (fun m n p:nat => mult_le_compat_l p n m); apply le_n_Sn.
+apply (fun m n p:nat => mult_le_compat_l p n m); apply le_n_S; assumption.
+assert (X := exist_cos (Rsqr a0)); elim X; intros.
+cut (x = cos a0).
+intro; rewrite H4 in p; unfold cos_in in p; unfold infinit_sum in p;
+ unfold R_dist in p; unfold Un_cv in |- *; unfold R_dist in |- *;
+ intros.
+elim (p _ H5); intros N H6.
+exists N; intros.
+replace (sum_f_R0 (tg_alt Un) n1) with
+ (1 - sum_f_R0 (fun i:nat => cos_n i * Rsqr a0 ^ i) (S n1)).
+unfold Rminus in |- *; rewrite Ropp_plus_distr; rewrite Ropp_involutive;
+ repeat rewrite Rplus_assoc; rewrite (Rplus_comm 1);
+ rewrite (Rplus_comm (-1)); repeat rewrite Rplus_assoc;
+ rewrite Rplus_opp_l; rewrite Rplus_0_r; rewrite <- Rabs_Ropp;
+ rewrite Ropp_plus_distr; rewrite Ropp_involutive;
+ unfold Rminus in H6; apply H6.
+unfold ge in |- *; apply le_trans with n1.
+exact H7.
+apply le_n_Sn.
+rewrite (decomp_sum (fun i:nat => cos_n i * Rsqr a0 ^ i) (S n1)).
+replace (cos_n 0) with 1.
+simpl in |- *; rewrite Rmult_1_r; unfold Rminus in |- *;
+ rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; rewrite Rplus_opp_r;
+ rewrite Rplus_0_l;
+ replace (- sum_f_R0 (fun i:nat => cos_n (S i) * (Rsqr a0 * Rsqr a0 ^ i)) n1)
+ with
+ (-1 * sum_f_R0 (fun i:nat => cos_n (S i) * (Rsqr a0 * Rsqr a0 ^ i)) n1);
+ [ idtac | ring ]; rewrite scal_sum; apply sum_eq;
+ intros; unfold cos_n, Un, tg_alt in |- *.
+replace ((-1) ^ S i) with (- (-1) ^ i).
+replace (a0 ^ (2 * S i)) with (Rsqr a0 * Rsqr a0 ^ i).
+unfold Rdiv in |- *; ring.
+rewrite pow_Rsqr; reflexivity.
+simpl in |- *; ring.
+unfold cos_n in |- *; unfold Rdiv in |- *; simpl in |- *; rewrite Rinv_1;
+ rewrite Rmult_1_r; reflexivity.
+apply lt_O_Sn.
+unfold cos in |- *; case (exist_cos (Rsqr a0)); intros; unfold cos_in in p;
+ unfold cos_in in c; eapply uniqueness_sum.
+apply p.
+apply c.
+intros; elim H3; intros; replace (cos a0 - 1) with (- (1 - cos a0));
+ [ idtac | ring ].
+split; apply Ropp_le_contravar; assumption.
+replace (- sum_f_R0 (tg_alt Un) (S (2 * n0))) with
+ (-1 * sum_f_R0 (tg_alt Un) (S (2 * n0))); [ rewrite scal_sum | ring ].
+apply sum_eq; intros; unfold cos_term, Un, tg_alt in |- *;
+ replace ((-1) ^ S i) with (-1 * (-1) ^ i).
+unfold Rdiv in |- *; ring.
+reflexivity.
+replace (- sum_f_R0 (tg_alt Un) (2 * n0)) with
+ (-1 * sum_f_R0 (tg_alt Un) (2 * n0)); [ rewrite scal_sum | ring ];
+ apply sum_eq; intros; unfold cos_term, Un, tg_alt in |- *;
+ replace ((-1) ^ S i) with (-1 * (-1) ^ i).
+unfold Rdiv in |- *; ring.
+reflexivity.
+replace (2 * (n0 + 1))%nat with (S (S (2 * n0))).
+reflexivity.
+apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; rewrite plus_INR;
+ repeat rewrite S_INR; ring.
+replace (2 * n0 + 1)%nat with (S (2 * n0)).
+reflexivity.
+apply INR_eq; rewrite S_INR; rewrite plus_INR; rewrite mult_INR;
+ repeat rewrite S_INR; ring.
+intro; elim H2; intros; split.
+apply Rplus_le_reg_l with (-1).
+rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l;
+ rewrite (Rplus_comm (-1)); apply H3.
+apply Rplus_le_reg_l with (-1).
+rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l;
+ rewrite (Rplus_comm (-1)); apply H4.
+unfold cos_term in |- *; simpl in |- *; unfold Rdiv in |- *; rewrite Rinv_1;
+ ring.
+replace (2 * (n0 + 1))%nat with (S (S (2 * n0))).
+apply lt_O_Sn.
+apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; rewrite plus_INR;
+ repeat rewrite S_INR; ring.
+replace (2 * n0 + 1)%nat with (S (2 * n0)).
+apply lt_O_Sn.
+apply INR_eq; rewrite S_INR; rewrite plus_INR; rewrite mult_INR;
+ repeat rewrite S_INR; ring.
+intros; case (total_order_T 0 a); intro.
+elim s; intro.
+apply H; [ left; assumption | assumption ].
+apply H; [ right; assumption | assumption ].
+cut (0 < - a).
+intro; cut (forall (x:R) (n:nat), cos_approx x n = cos_approx (- x) n).
+intro; rewrite H3; rewrite (H3 a (2 * (n + 1))%nat); rewrite cos_sym; apply H.
+left; assumption.
+rewrite <- (Ropp_involutive (PI / 2)); apply Ropp_le_contravar;
+ unfold Rdiv in |- *; unfold Rdiv in H0; rewrite <- Ropp_mult_distr_l_reverse;
+ exact H0.
+intros; unfold cos_approx in |- *; apply sum_eq; intros;
+ unfold cos_term in |- *; do 2 rewrite pow_Rsqr; rewrite Rsqr_neg;
+ unfold Rdiv in |- *; reflexivity.
+apply Ropp_0_gt_lt_contravar; assumption.
+Qed. \ No newline at end of file
diff --git a/theories/Reals/Rtrigo_calc.v b/theories/Reals/Rtrigo_calc.v
index 8ede9fc1c..28cb27a58 100644
--- a/theories/Reals/Rtrigo_calc.v
+++ b/theories/Reals/Rtrigo_calc.v
@@ -8,343 +8,427 @@
(*i $Id$ i*)
-Require Rbase.
-Require Rfunctions.
-Require SeqSeries.
-Require Rtrigo.
-Require R_sqrt.
-V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
+Require Import Rbase.
+Require Import Rfunctions.
+Require Import SeqSeries.
+Require Import Rtrigo.
+Require Import R_sqrt.
Open Local Scope R_scope.
-Lemma tan_PI : ``(tan PI)==0``.
-Unfold tan; Rewrite sin_PI; Rewrite cos_PI; Unfold Rdiv; Apply Rmult_Ol.
-Qed.
-
-Lemma sin_3PI2 : ``(sin (3*(PI/2)))==(-1)``.
-Replace ``3*(PI/2)`` with ``PI+(PI/2)``.
-Rewrite sin_plus; Rewrite sin_PI; Rewrite cos_PI; Rewrite sin_PI2; Ring.
-Pattern 1 PI; Rewrite (double_var PI); Ring.
-Qed.
-
-Lemma tan_2PI : ``(tan (2*PI))==0``.
-Unfold tan; Rewrite sin_2PI; Unfold Rdiv; Apply Rmult_Ol.
-Qed.
-
-Lemma sin_cos_PI4 : ``(sin (PI/4)) == (cos (PI/4))``.
-Proof with Trivial.
-Rewrite cos_sin.
-Replace ``PI/2+PI/4`` with ``-(PI/4)+PI``.
-Rewrite neg_sin; Rewrite sin_neg; Ring.
-Cut ``PI==PI/2+PI/2``; [Intro | Apply double_var].
-Pattern 2 3 PI; Rewrite H; Pattern 2 3 PI; Rewrite H.
-Assert H0 : ``2<>0``; [DiscrR | Unfold Rdiv; Rewrite Rinv_Rmult; Try Ring].
-Qed.
-
-Lemma sin_PI3_cos_PI6 : ``(sin (PI/3))==(cos (PI/6))``.
-Proof with Trivial.
-Replace ``PI/6`` with ``(PI/2)-(PI/3)``.
-Rewrite cos_shift.
-Assert H0 : ``6<>0``; [DiscrR | Idtac].
-Assert H1 : ``3<>0``; [DiscrR | Idtac].
-Assert H2 : ``2<>0``; [DiscrR | Idtac].
-Apply r_Rmult_mult with ``6``.
-Rewrite Rminus_distr; Repeat Rewrite (Rmult_sym ``6``).
-Unfold Rdiv; Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite (Rmult_sym ``/3``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym.
-Pattern 2 PI; Rewrite (Rmult_sym PI); Repeat Rewrite Rmult_1r; Repeat Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
-Ring.
-Qed.
-
-Lemma sin_PI6_cos_PI3 : ``(cos (PI/3))==(sin (PI/6))``.
-Proof with Trivial.
-Replace ``PI/6`` with ``(PI/2)-(PI/3)``.
-Rewrite sin_shift.
-Assert H0 : ``6<>0``; [DiscrR | Idtac].
-Assert H1 : ``3<>0``; [DiscrR | Idtac].
-Assert H2 : ``2<>0``; [DiscrR | Idtac].
-Apply r_Rmult_mult with ``6``.
-Rewrite Rminus_distr; Repeat Rewrite (Rmult_sym ``6``).
-Unfold Rdiv; Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite (Rmult_sym ``/3``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym.
-Pattern 2 PI; Rewrite (Rmult_sym PI); Repeat Rewrite Rmult_1r; Repeat Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
-Ring.
-Qed.
-
-Lemma PI6_RGT_0 : ``0<PI/6``.
-Unfold Rdiv; Apply Rmult_lt_pos; [Apply PI_RGT_0 | Apply Rlt_Rinv; Sup0].
-Qed.
-
-Lemma PI6_RLT_PI2 : ``PI/6<PI/2``.
-Unfold Rdiv; Apply Rlt_monotony.
-Apply PI_RGT_0.
-Apply Rinv_lt; Sup.
-Qed.
-
-Lemma sin_PI6 : ``(sin (PI/6))==1/2``.
-Proof with Trivial.
-Assert H : ``2<>0``; [DiscrR | Idtac].
-Apply r_Rmult_mult with ``2*(cos (PI/6))``.
-Replace ``2*(cos (PI/6))*(sin (PI/6))`` with ``2*(sin (PI/6))*(cos (PI/6))``.
-Rewrite <- sin_2a; Replace ``2*(PI/6)`` with ``PI/3``.
-Rewrite sin_PI3_cos_PI6.
-Unfold Rdiv; Rewrite Rmult_1l; Rewrite Rmult_assoc; Pattern 2 ``2``; Rewrite (Rmult_sym ``2``); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Unfold Rdiv; Rewrite Rinv_Rmult.
-Rewrite (Rmult_sym ``/2``); Rewrite (Rmult_sym ``2``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-DiscrR.
-Ring.
-Apply prod_neq_R0.
-Cut ``0<(cos (PI/6))``; [Intro H1; Auto with real | Apply cos_gt_0; [Apply (Rlt_trans ``-(PI/2)`` ``0`` ``PI/6`` _PI2_RLT_0 PI6_RGT_0) | Apply PI6_RLT_PI2]].
-Qed.
-
-Lemma sqrt2_neq_0 : ~``(sqrt 2)==0``.
-Assert Hyp:``0<2``; [Sup0 | Generalize (Rlt_le ``0`` ``2`` Hyp); Intro H1; Red; Intro H2; Generalize (sqrt_eq_0 ``2`` H1 H2); Intro H; Absurd ``2==0``; [ DiscrR | Assumption]].
-Qed.
-
-Lemma R1_sqrt2_neq_0 : ~``1/(sqrt 2)==0``.
-Generalize (Rinv_neq_R0 ``(sqrt 2)`` sqrt2_neq_0); Intro H; Generalize (prod_neq_R0 ``1`` ``(Rinv (sqrt 2))`` R1_neq_R0 H); Intro H0; Assumption.
-Qed.
-
-Lemma sqrt3_2_neq_0 : ~``2*(sqrt 3)==0``.
-Apply prod_neq_R0; [DiscrR | Assert Hyp:``0<3``; [Sup0 | Generalize (Rlt_le ``0`` ``3`` Hyp); Intro H1; Red; Intro H2; Generalize (sqrt_eq_0 ``3`` H1 H2); Intro H; Absurd ``3==0``; [ DiscrR | Assumption]]].
-Qed.
-
-Lemma Rlt_sqrt2_0 : ``0<(sqrt 2)``.
-Assert Hyp:``0<2``; [Sup0 | Generalize (sqrt_positivity ``2`` (Rlt_le ``0`` ``2`` Hyp)); Intro H1; Elim H1; Intro H2; [Assumption | Absurd ``0 == (sqrt 2)``; [Apply not_sym; Apply sqrt2_neq_0 | Assumption]]].
-Qed.
-
-Lemma Rlt_sqrt3_0 : ``0<(sqrt 3)``.
-Cut ~(O=(1)); [Intro H0; Assert Hyp:``0<2``; [Sup0 | Generalize (Rlt_le ``0`` ``2`` Hyp); Intro H1; Assert Hyp2:``0<3``; [Sup0 | Generalize (Rlt_le ``0`` ``3`` Hyp2); Intro H2; Generalize (lt_INR_0 (1) (neq_O_lt (1) H0)); Unfold INR; Intro H3; Generalize (Rlt_compatibility ``2`` ``0`` ``1`` H3); Rewrite Rplus_sym; Rewrite Rplus_Ol; Replace ``2+1`` with ``3``; [Intro H4; Generalize (sqrt_lt_1 ``2`` ``3`` H1 H2 H4); Clear H3; Intro H3; Apply (Rlt_trans ``0`` ``(sqrt 2)`` ``(sqrt 3)`` Rlt_sqrt2_0 H3) | Ring]]] | Discriminate].
-Qed.
-
-Lemma PI4_RGT_0 : ``0<PI/4``.
-Unfold Rdiv; Apply Rmult_lt_pos; [Apply PI_RGT_0 | Apply Rlt_Rinv; Sup0].
-Qed.
-
-Lemma cos_PI4 : ``(cos (PI/4))==1/(sqrt 2)``.
-Proof with Trivial.
-Apply Rsqr_inj.
-Apply cos_ge_0.
-Left; Apply (Rlt_trans ``-(PI/2)`` R0 ``PI/4`` _PI2_RLT_0 PI4_RGT_0).
-Left; Apply PI4_RLT_PI2.
-Left; Apply (Rmult_lt_pos R1 ``(Rinv (sqrt 2))``).
-Sup.
-Apply Rlt_Rinv; Apply Rlt_sqrt2_0.
-Rewrite Rsqr_div.
-Rewrite Rsqr_1; Rewrite Rsqr_sqrt.
-Assert H : ``2<>0``; [DiscrR | Idtac].
-Unfold Rsqr; Pattern 1 ``(cos (PI/4))``; Rewrite <- sin_cos_PI4; Replace ``(sin (PI/4))*(cos (PI/4))`` with ``(1/2)*(2*(sin (PI/4))*(cos (PI/4)))``.
-Rewrite <- sin_2a; Replace ``2*(PI/4)`` with ``PI/2``.
-Rewrite sin_PI2.
-Apply Rmult_1r.
-Unfold Rdiv; Rewrite (Rmult_sym ``2``); Rewrite Rinv_Rmult.
-Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Unfold Rdiv; Rewrite Rmult_1l; Repeat Rewrite <- Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l.
-Left; Sup.
-Apply sqrt2_neq_0.
-Qed.
-
-Lemma sin_PI4 : ``(sin (PI/4))==1/(sqrt 2)``.
-Rewrite sin_cos_PI4; Apply cos_PI4.
-Qed.
-
-Lemma tan_PI4 : ``(tan (PI/4))==1``.
-Unfold tan; Rewrite sin_cos_PI4.
-Unfold Rdiv; Apply Rinv_r.
-Change ``(cos (PI/4))<>0``; Rewrite cos_PI4; Apply R1_sqrt2_neq_0.
-Qed.
-
-Lemma cos3PI4 : ``(cos (3*(PI/4)))==-1/(sqrt 2)``.
-Proof with Trivial.
-Replace ``3*(PI/4)`` with ``(PI/2)-(-(PI/4))``.
-Rewrite cos_shift; Rewrite sin_neg; Rewrite sin_PI4.
-Unfold Rdiv; Rewrite Ropp_mul1.
-Unfold Rminus; Rewrite Ropp_Ropp; Pattern 1 PI; Rewrite double_var; Unfold Rdiv; Rewrite Rmult_Rplus_distrl; Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_Rmult; [Ring | DiscrR | DiscrR].
-Qed.
-
-Lemma sin3PI4 : ``(sin (3*(PI/4)))==1/(sqrt 2)``.
-Proof with Trivial.
-Replace ``3*(PI/4)`` with ``(PI/2)-(-(PI/4))``.
-Rewrite sin_shift; Rewrite cos_neg; Rewrite cos_PI4.
-Unfold Rminus; Rewrite Ropp_Ropp; Pattern 1 PI; Rewrite double_var; Unfold Rdiv; Rewrite Rmult_Rplus_distrl; Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_Rmult; [Ring | DiscrR | DiscrR].
-Qed.
-
-Lemma cos_PI6 : ``(cos (PI/6))==(sqrt 3)/2``.
-Proof with Trivial.
-Apply Rsqr_inj.
-Apply cos_ge_0.
-Left; Apply (Rlt_trans ``-(PI/2)`` R0 ``PI/6`` _PI2_RLT_0 PI6_RGT_0).
-Left; Apply PI6_RLT_PI2.
-Left; Apply (Rmult_lt_pos ``(sqrt 3)`` ``(Rinv 2)``).
-Apply Rlt_sqrt3_0.
-Apply Rlt_Rinv; Sup0.
-Assert H : ``2<>0``; [DiscrR | Idtac].
-Assert H1 : ``4<>0``; [Apply prod_neq_R0 | Idtac].
-Rewrite Rsqr_div.
-Rewrite cos2; Unfold Rsqr; Rewrite sin_PI6; Rewrite sqrt_def.
-Unfold Rdiv; Rewrite Rmult_1l; Apply r_Rmult_mult with ``4``.
-Rewrite Rminus_distr; Rewrite (Rmult_sym ``3``); Repeat Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1l; Rewrite Rmult_1r.
-Rewrite <- (Rmult_sym ``/2``); Repeat Rewrite <- Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l; Rewrite <- Rinv_r_sym.
-Ring.
-Left; Sup0.
-Qed.
-
-Lemma tan_PI6 : ``(tan (PI/6))==1/(sqrt 3)``.
-Unfold tan; Rewrite sin_PI6; Rewrite cos_PI6; Unfold Rdiv; Repeat Rewrite Rmult_1l; Rewrite Rinv_Rmult.
-Rewrite Rinv_Rinv.
-Rewrite (Rmult_sym ``/2``); Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym.
-Apply Rmult_1r.
-DiscrR.
-DiscrR.
-Red; Intro; Assert H1 := Rlt_sqrt3_0; Rewrite H in H1; Elim (Rlt_antirefl ``0`` H1).
-Apply Rinv_neq_R0; DiscrR.
-Qed.
-
-Lemma sin_PI3 : ``(sin (PI/3))==(sqrt 3)/2``.
-Rewrite sin_PI3_cos_PI6; Apply cos_PI6.
-Qed.
-
-Lemma cos_PI3 : ``(cos (PI/3))==1/2``.
-Rewrite sin_PI6_cos_PI3; Apply sin_PI6.
-Qed.
-
-Lemma tan_PI3 : ``(tan (PI/3))==(sqrt 3)``.
-Unfold tan; Rewrite sin_PI3; Rewrite cos_PI3; Unfold Rdiv; Rewrite Rmult_1l; Rewrite Rinv_Rinv.
-Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Apply Rmult_1r.
-DiscrR.
-DiscrR.
-Qed.
-
-Lemma sin_2PI3 : ``(sin (2*(PI/3)))==(sqrt 3)/2``.
-Rewrite double; Rewrite sin_plus; Rewrite sin_PI3; Rewrite cos_PI3; Unfold Rdiv; Repeat Rewrite Rmult_1l; Rewrite (Rmult_sym ``/2``); Repeat Rewrite <- Rmult_assoc; Rewrite double_var; Reflexivity.
-Qed.
-
-Lemma cos_2PI3 : ``(cos (2*(PI/3)))==-1/2``.
-Proof with Trivial.
-Assert H : ``2<>0``; [DiscrR | Idtac].
-Assert H0 : ``4<>0``; [Apply prod_neq_R0 | Idtac].
-Rewrite double; Rewrite cos_plus; Rewrite sin_PI3; Rewrite cos_PI3; Unfold Rdiv; Rewrite Rmult_1l; Apply r_Rmult_mult with ``4``.
-Rewrite Rminus_distr; Repeat Rewrite Rmult_assoc; Rewrite (Rmult_sym ``2``).
-Repeat Rewrite Rmult_assoc; Rewrite <- (Rinv_l_sym).
-Rewrite Rmult_1r; Rewrite <- Rinv_r_sym.
-Pattern 4 ``2``; Rewrite (Rmult_sym ``2``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Rewrite Ropp_mul3; Rewrite Rmult_1r.
-Rewrite (Rmult_sym ``2``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Rewrite (Rmult_sym ``2``); Rewrite (Rmult_sym ``/2``).
-Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Rewrite sqrt_def.
-Ring.
-Left; Sup.
-Qed.
-
-Lemma tan_2PI3 : ``(tan (2*(PI/3)))==-(sqrt 3)``.
-Proof with Trivial.
-Assert H : ``2<>0``; [DiscrR | Idtac].
-Unfold tan; Rewrite sin_2PI3; Rewrite cos_2PI3; Unfold Rdiv; Rewrite Ropp_mul1; Rewrite Rmult_1l; Rewrite <- Ropp_Rinv.
-Rewrite Rinv_Rinv.
-Rewrite Rmult_assoc; Rewrite Ropp_mul3; Rewrite <- Rinv_l_sym.
-Ring.
-Apply Rinv_neq_R0.
-Qed.
-
-Lemma cos_5PI4 : ``(cos (5*(PI/4)))==-1/(sqrt 2)``.
-Proof with Trivial.
-Replace ``5*(PI/4)`` with ``(PI/4)+(PI)``.
-Rewrite neg_cos; Rewrite cos_PI4; Unfold Rdiv; Rewrite Ropp_mul1.
-Pattern 2 PI; Rewrite double_var; Pattern 2 3 PI; Rewrite double_var; Assert H : ``2<>0``; [DiscrR | Unfold Rdiv; Repeat Rewrite Rinv_Rmult; Try Ring].
-Qed.
-
-Lemma sin_5PI4 : ``(sin (5*(PI/4)))==-1/(sqrt 2)``.
-Proof with Trivial.
-Replace ``5*(PI/4)`` with ``(PI/4)+(PI)``.
-Rewrite neg_sin; Rewrite sin_PI4; Unfold Rdiv; Rewrite Ropp_mul1.
-Pattern 2 PI; Rewrite double_var; Pattern 2 3 PI; Rewrite double_var; Assert H : ``2<>0``; [DiscrR | Unfold Rdiv; Repeat Rewrite Rinv_Rmult; Try Ring].
-Qed.
-
-Lemma sin_cos5PI4 : ``(cos (5*(PI/4)))==(sin (5*(PI/4)))``.
-Rewrite cos_5PI4; Rewrite sin_5PI4; Reflexivity.
-Qed.
-
-Lemma Rgt_3PI2_0 : ``0<3*(PI/2)``.
-Apply Rmult_lt_pos; [Sup0 | Unfold Rdiv; Apply Rmult_lt_pos; [Apply PI_RGT_0 | Apply Rlt_Rinv; Sup0]].
-Qed.
-
-Lemma Rgt_2PI_0 : ``0<2*PI``.
-Apply Rmult_lt_pos; [Sup0 | Apply PI_RGT_0].
-Qed.
-
-Lemma Rlt_PI_3PI2 : ``PI<3*(PI/2)``.
-Generalize PI2_RGT_0; Intro H1; Generalize (Rlt_compatibility PI ``0`` ``PI/2`` H1); Replace ``PI+(PI/2)`` with ``3*(PI/2)``.
-Rewrite Rplus_Or; Intro H2; Assumption.
-Pattern 2 PI; Rewrite double_var; Ring.
+Lemma tan_PI : tan PI = 0.
+unfold tan in |- *; rewrite sin_PI; rewrite cos_PI; unfold Rdiv in |- *;
+ apply Rmult_0_l.
+Qed.
+
+Lemma sin_3PI2 : sin (3 * (PI / 2)) = -1.
+replace (3 * (PI / 2)) with (PI + PI / 2).
+rewrite sin_plus; rewrite sin_PI; rewrite cos_PI; rewrite sin_PI2; ring.
+pattern PI at 1 in |- *; rewrite (double_var PI); ring.
+Qed.
+
+Lemma tan_2PI : tan (2 * PI) = 0.
+unfold tan in |- *; rewrite sin_2PI; unfold Rdiv in |- *; apply Rmult_0_l.
+Qed.
+
+Lemma sin_cos_PI4 : sin (PI / 4) = cos (PI / 4).
+Proof with trivial.
+rewrite cos_sin...
+replace (PI / 2 + PI / 4) with (- (PI / 4) + PI)...
+rewrite neg_sin; rewrite sin_neg; ring...
+cut (PI = PI / 2 + PI / 2); [ intro | apply double_var ]...
+pattern PI at 2 3 in |- *; rewrite H; pattern PI at 2 3 in |- *; rewrite H...
+assert (H0 : 2 <> 0);
+ [ discrR | unfold Rdiv in |- *; rewrite Rinv_mult_distr; try ring ]...
+Qed.
+
+Lemma sin_PI3_cos_PI6 : sin (PI / 3) = cos (PI / 6).
+Proof with trivial.
+replace (PI / 6) with (PI / 2 - PI / 3)...
+rewrite cos_shift...
+assert (H0 : 6 <> 0); [ discrR | idtac ]...
+assert (H1 : 3 <> 0); [ discrR | idtac ]...
+assert (H2 : 2 <> 0); [ discrR | idtac ]...
+apply Rmult_eq_reg_l with 6...
+rewrite Rmult_minus_distr_l; repeat rewrite (Rmult_comm 6)...
+unfold Rdiv in |- *; repeat rewrite Rmult_assoc...
+rewrite <- Rinv_l_sym...
+rewrite (Rmult_comm (/ 3)); repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym...
+pattern PI at 2 in |- *; rewrite (Rmult_comm PI); repeat rewrite Rmult_1_r;
+ repeat rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym...
+ring...
+Qed.
+
+Lemma sin_PI6_cos_PI3 : cos (PI / 3) = sin (PI / 6).
+Proof with trivial.
+replace (PI / 6) with (PI / 2 - PI / 3)...
+rewrite sin_shift...
+assert (H0 : 6 <> 0); [ discrR | idtac ]...
+assert (H1 : 3 <> 0); [ discrR | idtac ]...
+assert (H2 : 2 <> 0); [ discrR | idtac ]...
+apply Rmult_eq_reg_l with 6...
+rewrite Rmult_minus_distr_l; repeat rewrite (Rmult_comm 6)...
+unfold Rdiv in |- *; repeat rewrite Rmult_assoc...
+rewrite <- Rinv_l_sym...
+rewrite (Rmult_comm (/ 3)); repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym...
+pattern PI at 2 in |- *; rewrite (Rmult_comm PI); repeat rewrite Rmult_1_r;
+ repeat rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym...
+ring...
+Qed.
+
+Lemma PI6_RGT_0 : 0 < PI / 6.
+unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ apply PI_RGT_0 | apply Rinv_0_lt_compat; prove_sup0 ].
+Qed.
+
+Lemma PI6_RLT_PI2 : PI / 6 < PI / 2.
+unfold Rdiv in |- *; apply Rmult_lt_compat_l.
+apply PI_RGT_0.
+apply Rinv_lt_contravar; prove_sup.
+Qed.
+
+Lemma sin_PI6 : sin (PI / 6) = 1 / 2.
+Proof with trivial.
+assert (H : 2 <> 0); [ discrR | idtac ]...
+apply Rmult_eq_reg_l with (2 * cos (PI / 6))...
+replace (2 * cos (PI / 6) * sin (PI / 6)) with
+ (2 * sin (PI / 6) * cos (PI / 6))...
+rewrite <- sin_2a; replace (2 * (PI / 6)) with (PI / 3)...
+rewrite sin_PI3_cos_PI6...
+unfold Rdiv in |- *; rewrite Rmult_1_l; rewrite Rmult_assoc;
+ pattern 2 at 2 in |- *; rewrite (Rmult_comm 2); rewrite Rmult_assoc;
+ rewrite <- Rinv_l_sym...
+rewrite Rmult_1_r...
+unfold Rdiv in |- *; rewrite Rinv_mult_distr...
+rewrite (Rmult_comm (/ 2)); rewrite (Rmult_comm 2);
+ repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym...
+rewrite Rmult_1_r...
+discrR...
+ring...
+apply prod_neq_R0...
+cut (0 < cos (PI / 6));
+ [ intro H1; auto with real
+ | apply cos_gt_0;
+ [ apply (Rlt_trans (- (PI / 2)) 0 (PI / 6) _PI2_RLT_0 PI6_RGT_0)
+ | apply PI6_RLT_PI2 ] ]...
+Qed.
+
+Lemma sqrt2_neq_0 : sqrt 2 <> 0.
+assert (Hyp : 0 < 2);
+ [ prove_sup0
+ | generalize (Rlt_le 0 2 Hyp); intro H1; red in |- *; intro H2;
+ generalize (sqrt_eq_0 2 H1 H2); intro H; absurd (2 = 0);
+ [ discrR | assumption ] ].
+Qed.
+
+Lemma R1_sqrt2_neq_0 : 1 / sqrt 2 <> 0.
+generalize (Rinv_neq_0_compat (sqrt 2) sqrt2_neq_0); intro H;
+ generalize (prod_neq_R0 1 (/ sqrt 2) R1_neq_R0 H);
+ intro H0; assumption.
+Qed.
+
+Lemma sqrt3_2_neq_0 : 2 * sqrt 3 <> 0.
+apply prod_neq_R0;
+ [ discrR
+ | assert (Hyp : 0 < 3);
+ [ prove_sup0
+ | generalize (Rlt_le 0 3 Hyp); intro H1; red in |- *; intro H2;
+ generalize (sqrt_eq_0 3 H1 H2); intro H; absurd (3 = 0);
+ [ discrR | assumption ] ] ].
+Qed.
+
+Lemma Rlt_sqrt2_0 : 0 < sqrt 2.
+assert (Hyp : 0 < 2);
+ [ prove_sup0
+ | generalize (sqrt_positivity 2 (Rlt_le 0 2 Hyp)); intro H1; elim H1;
+ intro H2;
+ [ assumption
+ | absurd (0 = sqrt 2);
+ [ apply (sym_not_eq (A:=R)); apply sqrt2_neq_0 | assumption ] ] ].
+Qed.
+
+Lemma Rlt_sqrt3_0 : 0 < sqrt 3.
+cut (0%nat <> 1%nat);
+ [ intro H0; assert (Hyp : 0 < 2);
+ [ prove_sup0
+ | generalize (Rlt_le 0 2 Hyp); intro H1; assert (Hyp2 : 0 < 3);
+ [ prove_sup0
+ | generalize (Rlt_le 0 3 Hyp2); intro H2;
+ generalize (lt_INR_0 1 (neq_O_lt 1 H0));
+ unfold INR in |- *; intro H3;
+ generalize (Rplus_lt_compat_l 2 0 1 H3);
+ rewrite Rplus_comm; rewrite Rplus_0_l; replace (2 + 1) with 3;
+ [ intro H4; generalize (sqrt_lt_1 2 3 H1 H2 H4); clear H3; intro H3;
+ apply (Rlt_trans 0 (sqrt 2) (sqrt 3) Rlt_sqrt2_0 H3)
+ | ring ] ] ]
+ | discriminate ].
+Qed.
+
+Lemma PI4_RGT_0 : 0 < PI / 4.
+unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ apply PI_RGT_0 | apply Rinv_0_lt_compat; prove_sup0 ].
+Qed.
+
+Lemma cos_PI4 : cos (PI / 4) = 1 / sqrt 2.
+Proof with trivial.
+apply Rsqr_inj...
+apply cos_ge_0...
+left; apply (Rlt_trans (- (PI / 2)) 0 (PI / 4) _PI2_RLT_0 PI4_RGT_0)...
+left; apply PI4_RLT_PI2...
+left; apply (Rmult_lt_0_compat 1 (/ sqrt 2))...
+prove_sup...
+apply Rinv_0_lt_compat; apply Rlt_sqrt2_0...
+rewrite Rsqr_div...
+rewrite Rsqr_1; rewrite Rsqr_sqrt...
+assert (H : 2 <> 0); [ discrR | idtac ]...
+unfold Rsqr in |- *; pattern (cos (PI / 4)) at 1 in |- *;
+ rewrite <- sin_cos_PI4;
+ replace (sin (PI / 4) * cos (PI / 4)) with
+ (1 / 2 * (2 * sin (PI / 4) * cos (PI / 4)))...
+rewrite <- sin_2a; replace (2 * (PI / 4)) with (PI / 2)...
+rewrite sin_PI2...
+apply Rmult_1_r...
+unfold Rdiv in |- *; rewrite (Rmult_comm 2); rewrite Rinv_mult_distr...
+repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym...
+rewrite Rmult_1_r...
+unfold Rdiv in |- *; rewrite Rmult_1_l; repeat rewrite <- Rmult_assoc...
+rewrite <- Rinv_l_sym...
+rewrite Rmult_1_l...
+left; prove_sup...
+apply sqrt2_neq_0...
+Qed.
+
+Lemma sin_PI4 : sin (PI / 4) = 1 / sqrt 2.
+rewrite sin_cos_PI4; apply cos_PI4.
+Qed.
+
+Lemma tan_PI4 : tan (PI / 4) = 1.
+unfold tan in |- *; rewrite sin_cos_PI4.
+unfold Rdiv in |- *; apply Rinv_r.
+change (cos (PI / 4) <> 0) in |- *; rewrite cos_PI4; apply R1_sqrt2_neq_0.
+Qed.
+
+Lemma cos3PI4 : cos (3 * (PI / 4)) = -1 / sqrt 2.
+Proof with trivial.
+replace (3 * (PI / 4)) with (PI / 2 - - (PI / 4))...
+rewrite cos_shift; rewrite sin_neg; rewrite sin_PI4...
+unfold Rdiv in |- *; rewrite Ropp_mult_distr_l_reverse...
+unfold Rminus in |- *; rewrite Ropp_involutive; pattern PI at 1 in |- *;
+ rewrite double_var; unfold Rdiv in |- *; rewrite Rmult_plus_distr_r;
+ repeat rewrite Rmult_assoc; rewrite <- Rinv_mult_distr;
+ [ ring | discrR | discrR ]...
+Qed.
+
+Lemma sin3PI4 : sin (3 * (PI / 4)) = 1 / sqrt 2.
+Proof with trivial.
+replace (3 * (PI / 4)) with (PI / 2 - - (PI / 4))...
+rewrite sin_shift; rewrite cos_neg; rewrite cos_PI4...
+unfold Rminus in |- *; rewrite Ropp_involutive; pattern PI at 1 in |- *;
+ rewrite double_var; unfold Rdiv in |- *; rewrite Rmult_plus_distr_r;
+ repeat rewrite Rmult_assoc; rewrite <- Rinv_mult_distr;
+ [ ring | discrR | discrR ]...
+Qed.
+
+Lemma cos_PI6 : cos (PI / 6) = sqrt 3 / 2.
+Proof with trivial.
+apply Rsqr_inj...
+apply cos_ge_0...
+left; apply (Rlt_trans (- (PI / 2)) 0 (PI / 6) _PI2_RLT_0 PI6_RGT_0)...
+left; apply PI6_RLT_PI2...
+left; apply (Rmult_lt_0_compat (sqrt 3) (/ 2))...
+apply Rlt_sqrt3_0...
+apply Rinv_0_lt_compat; prove_sup0...
+assert (H : 2 <> 0); [ discrR | idtac ]...
+assert (H1 : 4 <> 0); [ apply prod_neq_R0 | idtac ]...
+rewrite Rsqr_div...
+rewrite cos2; unfold Rsqr in |- *; rewrite sin_PI6; rewrite sqrt_def...
+unfold Rdiv in |- *; rewrite Rmult_1_l; apply Rmult_eq_reg_l with 4...
+rewrite Rmult_minus_distr_l; rewrite (Rmult_comm 3);
+ repeat rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym...
+rewrite Rmult_1_l; rewrite Rmult_1_r...
+rewrite <- (Rmult_comm (/ 2)); repeat rewrite <- Rmult_assoc...
+rewrite <- Rinv_l_sym...
+rewrite Rmult_1_l; rewrite <- Rinv_r_sym...
+ring...
+left; prove_sup0...
+Qed.
+
+Lemma tan_PI6 : tan (PI / 6) = 1 / sqrt 3.
+unfold tan in |- *; rewrite sin_PI6; rewrite cos_PI6; unfold Rdiv in |- *;
+ repeat rewrite Rmult_1_l; rewrite Rinv_mult_distr.
+rewrite Rinv_involutive.
+rewrite (Rmult_comm (/ 2)); rewrite Rmult_assoc; rewrite <- Rinv_r_sym.
+apply Rmult_1_r.
+discrR.
+discrR.
+red in |- *; intro; assert (H1 := Rlt_sqrt3_0); rewrite H in H1;
+ elim (Rlt_irrefl 0 H1).
+apply Rinv_neq_0_compat; discrR.
+Qed.
+
+Lemma sin_PI3 : sin (PI / 3) = sqrt 3 / 2.
+rewrite sin_PI3_cos_PI6; apply cos_PI6.
+Qed.
+
+Lemma cos_PI3 : cos (PI / 3) = 1 / 2.
+rewrite sin_PI6_cos_PI3; apply sin_PI6.
+Qed.
+
+Lemma tan_PI3 : tan (PI / 3) = sqrt 3.
+unfold tan in |- *; rewrite sin_PI3; rewrite cos_PI3; unfold Rdiv in |- *;
+ rewrite Rmult_1_l; rewrite Rinv_involutive.
+rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+apply Rmult_1_r.
+discrR.
+discrR.
+Qed.
+
+Lemma sin_2PI3 : sin (2 * (PI / 3)) = sqrt 3 / 2.
+rewrite double; rewrite sin_plus; rewrite sin_PI3; rewrite cos_PI3;
+ unfold Rdiv in |- *; repeat rewrite Rmult_1_l; rewrite (Rmult_comm (/ 2));
+ repeat rewrite <- Rmult_assoc; rewrite double_var;
+ reflexivity.
+Qed.
+
+Lemma cos_2PI3 : cos (2 * (PI / 3)) = -1 / 2.
+Proof with trivial.
+assert (H : 2 <> 0); [ discrR | idtac ]...
+assert (H0 : 4 <> 0); [ apply prod_neq_R0 | idtac ]...
+rewrite double; rewrite cos_plus; rewrite sin_PI3; rewrite cos_PI3;
+ unfold Rdiv in |- *; rewrite Rmult_1_l; apply Rmult_eq_reg_l with 4...
+rewrite Rmult_minus_distr_l; repeat rewrite Rmult_assoc;
+ rewrite (Rmult_comm 2)...
+repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym...
+rewrite Rmult_1_r; rewrite <- Rinv_r_sym...
+pattern 2 at 4 in |- *; rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc;
+ rewrite <- Rinv_l_sym...
+rewrite Rmult_1_r; rewrite Ropp_mult_distr_r_reverse; rewrite Rmult_1_r...
+rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym...
+rewrite Rmult_1_r; rewrite (Rmult_comm 2); rewrite (Rmult_comm (/ 2))...
+repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym...
+rewrite Rmult_1_r; rewrite sqrt_def...
+ring...
+left; prove_sup...
+Qed.
+
+Lemma tan_2PI3 : tan (2 * (PI / 3)) = - sqrt 3.
+Proof with trivial.
+assert (H : 2 <> 0); [ discrR | idtac ]...
+unfold tan in |- *; rewrite sin_2PI3; rewrite cos_2PI3; unfold Rdiv in |- *;
+ rewrite Ropp_mult_distr_l_reverse; rewrite Rmult_1_l;
+ rewrite <- Ropp_inv_permute...
+rewrite Rinv_involutive...
+rewrite Rmult_assoc; rewrite Ropp_mult_distr_r_reverse; rewrite <- Rinv_l_sym...
+ring...
+apply Rinv_neq_0_compat...
+Qed.
+
+Lemma cos_5PI4 : cos (5 * (PI / 4)) = -1 / sqrt 2.
+Proof with trivial.
+replace (5 * (PI / 4)) with (PI / 4 + PI)...
+rewrite neg_cos; rewrite cos_PI4; unfold Rdiv in |- *;
+ rewrite Ropp_mult_distr_l_reverse...
+pattern PI at 2 in |- *; rewrite double_var; pattern PI at 2 3 in |- *;
+ rewrite double_var; assert (H : 2 <> 0);
+ [ discrR | unfold Rdiv in |- *; repeat rewrite Rinv_mult_distr; try ring ]...
+Qed.
+
+Lemma sin_5PI4 : sin (5 * (PI / 4)) = -1 / sqrt 2.
+Proof with trivial.
+replace (5 * (PI / 4)) with (PI / 4 + PI)...
+rewrite neg_sin; rewrite sin_PI4; unfold Rdiv in |- *;
+ rewrite Ropp_mult_distr_l_reverse...
+pattern PI at 2 in |- *; rewrite double_var; pattern PI at 2 3 in |- *;
+ rewrite double_var; assert (H : 2 <> 0);
+ [ discrR | unfold Rdiv in |- *; repeat rewrite Rinv_mult_distr; try ring ]...
+Qed.
+
+Lemma sin_cos5PI4 : cos (5 * (PI / 4)) = sin (5 * (PI / 4)).
+rewrite cos_5PI4; rewrite sin_5PI4; reflexivity.
+Qed.
+
+Lemma Rgt_3PI2_0 : 0 < 3 * (PI / 2).
+apply Rmult_lt_0_compat;
+ [ prove_sup0
+ | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ apply PI_RGT_0 | apply Rinv_0_lt_compat; prove_sup0 ] ].
+Qed.
+
+Lemma Rgt_2PI_0 : 0 < 2 * PI.
+apply Rmult_lt_0_compat; [ prove_sup0 | apply PI_RGT_0 ].
+Qed.
+
+Lemma Rlt_PI_3PI2 : PI < 3 * (PI / 2).
+generalize PI2_RGT_0; intro H1;
+ generalize (Rplus_lt_compat_l PI 0 (PI / 2) H1);
+ replace (PI + PI / 2) with (3 * (PI / 2)).
+rewrite Rplus_0_r; intro H2; assumption.
+pattern PI at 2 in |- *; rewrite double_var; ring.
Qed.
-Lemma Rlt_3PI2_2PI : ``3*(PI/2)<2*PI``.
-Generalize PI2_RGT_0; Intro H1; Generalize (Rlt_compatibility ``3*(PI/2)`` ``0`` ``PI/2`` H1); Replace ``3*(PI/2)+(PI/2)`` with ``2*PI``.
-Rewrite Rplus_Or; Intro H2; Assumption.
-Rewrite double; Pattern 1 2 PI; Rewrite double_var; Ring.
+Lemma Rlt_3PI2_2PI : 3 * (PI / 2) < 2 * PI.
+generalize PI2_RGT_0; intro H1;
+ generalize (Rplus_lt_compat_l (3 * (PI / 2)) 0 (PI / 2) H1);
+ replace (3 * (PI / 2) + PI / 2) with (2 * PI).
+rewrite Rplus_0_r; intro H2; assumption.
+rewrite double; pattern PI at 1 2 in |- *; rewrite double_var; ring.
Qed.
(***************************************************************)
(* Radian -> Degree | Degree -> Radian *)
(***************************************************************)
-Definition plat : R := ``180``.
-Definition toRad [x:R] : R := ``x*PI*/plat``.
-Definition toDeg [x:R] : R := ``x*plat*/PI``.
+Definition plat : R := 180.
+Definition toRad (x:R) : R := x * PI * / plat.
+Definition toDeg (x:R) : R := x * plat * / PI.
-Lemma rad_deg : (x:R) (toRad (toDeg x))==x.
-Intro; Unfold toRad toDeg; Replace ``x*plat*/PI*PI*/plat`` with ``x*(plat*/plat)*(PI*/PI)``; [Idtac | Ring].
-Repeat Rewrite <- Rinv_r_sym.
-Ring.
-Apply PI_neq0.
-Unfold plat; DiscrR.
+Lemma rad_deg : forall x:R, toRad (toDeg x) = x.
+intro; unfold toRad, toDeg in |- *;
+ replace (x * plat * / PI * PI * / plat) with
+ (x * (plat * / plat) * (PI * / PI)); [ idtac | ring ].
+repeat rewrite <- Rinv_r_sym.
+ring.
+apply PI_neq0.
+unfold plat in |- *; discrR.
Qed.
-Lemma toRad_inj : (x,y:R) (toRad x)==(toRad y) -> x==y.
-Intros; Unfold toRad in H; Apply r_Rmult_mult with PI.
-Rewrite <- (Rmult_sym x); Rewrite <- (Rmult_sym y).
-Apply r_Rmult_mult with ``/plat``.
-Rewrite <- (Rmult_sym ``x*PI``); Rewrite <- (Rmult_sym ``y*PI``); Assumption.
-Apply Rinv_neq_R0; Unfold plat; DiscrR.
-Apply PI_neq0.
+Lemma toRad_inj : forall x y:R, toRad x = toRad y -> x = y.
+intros; unfold toRad in H; apply Rmult_eq_reg_l with PI.
+rewrite <- (Rmult_comm x); rewrite <- (Rmult_comm y).
+apply Rmult_eq_reg_l with (/ plat).
+rewrite <- (Rmult_comm (x * PI)); rewrite <- (Rmult_comm (y * PI));
+ assumption.
+apply Rinv_neq_0_compat; unfold plat in |- *; discrR.
+apply PI_neq0.
Qed.
-Lemma deg_rad : (x:R) (toDeg (toRad x))==x.
-Intro x; Apply toRad_inj; Rewrite -> (rad_deg (toRad x)); Reflexivity.
+Lemma deg_rad : forall x:R, toDeg (toRad x) = x.
+intro x; apply toRad_inj; rewrite (rad_deg (toRad x)); reflexivity.
Qed.
-Definition sind [x:R] : R := (sin (toRad x)).
-Definition cosd [x:R] : R := (cos (toRad x)).
-Definition tand [x:R] : R := (tan (toRad x)).
+Definition sind (x:R) : R := sin (toRad x).
+Definition cosd (x:R) : R := cos (toRad x).
+Definition tand (x:R) : R := tan (toRad x).
-Lemma Rsqr_sin_cos_d_one : (x:R) ``(Rsqr (sind x))+(Rsqr (cosd x))==1``.
-Intro x; Unfold sind; Unfold cosd; Apply sin2_cos2.
+Lemma Rsqr_sin_cos_d_one : forall x:R, Rsqr (sind x) + Rsqr (cosd x) = 1.
+intro x; unfold sind in |- *; unfold cosd in |- *; apply sin2_cos2.
Qed.
(***************************************************)
(* Other properties *)
(***************************************************)
-Lemma sin_lb_ge_0 : (a:R) ``0<=a``->``a<=PI/2``->``0<=(sin_lb a)``.
-Intros; Case (total_order R0 a); Intro.
-Left; Apply sin_lb_gt_0; Assumption.
-Elim H1; Intro.
-Rewrite <- H2; Unfold sin_lb; Unfold sin_approx; Unfold sum_f_R0; Unfold sin_term; Repeat Rewrite pow_ne_zero.
-Unfold Rdiv; Repeat Rewrite Rmult_Ol; Repeat Rewrite Rmult_Or; Repeat Rewrite Rplus_Or; Right; Reflexivity.
-Discriminate.
-Discriminate.
-Discriminate.
-Discriminate.
-Elim (Rlt_antirefl ``0`` (Rle_lt_trans ``0`` a ``0`` H H2)).
-Qed.
+Lemma sin_lb_ge_0 : forall a:R, 0 <= a -> a <= PI / 2 -> 0 <= sin_lb a.
+intros; case (Rtotal_order 0 a); intro.
+left; apply sin_lb_gt_0; assumption.
+elim H1; intro.
+rewrite <- H2; unfold sin_lb in |- *; unfold sin_approx in |- *;
+ unfold sum_f_R0 in |- *; unfold sin_term in |- *;
+ repeat rewrite pow_ne_zero.
+unfold Rdiv in |- *; repeat rewrite Rmult_0_l; repeat rewrite Rmult_0_r;
+ repeat rewrite Rplus_0_r; right; reflexivity.
+discriminate.
+discriminate.
+discriminate.
+discriminate.
+elim (Rlt_irrefl 0 (Rle_lt_trans 0 a 0 H H2)).
+Qed. \ No newline at end of file
diff --git a/theories/Reals/Rtrigo_def.v b/theories/Reals/Rtrigo_def.v
index 82c63a7b2..f18e9188e 100644
--- a/theories/Reals/Rtrigo_def.v
+++ b/theories/Reals/Rtrigo_def.v
@@ -8,350 +8,405 @@
(*i $Id$ i*)
-Require Rbase.
-Require Rfunctions.
-Require SeqSeries.
-Require Rtrigo_fun.
-Require Max.
-V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
+Require Import Rbase.
+Require Import Rfunctions.
+Require Import SeqSeries.
+Require Import Rtrigo_fun.
+Require Import Max.
Open Local Scope R_scope.
(*****************************)
(* Definition of exponential *)
(*****************************)
-Definition exp_in:R->R->Prop := [x,l:R](infinit_sum [i:nat]``/(INR (fact i))*(pow x i)`` l).
+Definition exp_in (x l:R) : Prop :=
+ infinit_sum (fun i:nat => / INR (fact i) * x ^ i) l.
-Lemma exp_cof_no_R0 : (n:nat) ``/(INR (fact n))<>0``.
-Intro.
-Apply Rinv_neq_R0.
-Apply INR_fact_neq_0.
+Lemma exp_cof_no_R0 : forall n:nat, / INR (fact n) <> 0.
+intro.
+apply Rinv_neq_0_compat.
+apply INR_fact_neq_0.
Qed.
-Lemma exist_exp : (x:R)(SigT R [l:R](exp_in x l)).
-Intro; Generalize (Alembert_C3 [n:nat](Rinv (INR (fact n))) x exp_cof_no_R0 Alembert_exp).
-Unfold Pser exp_in.
-Trivial.
+Lemma exist_exp : forall x:R, sigT (fun l:R => exp_in x l).
+intro;
+ generalize
+ (Alembert_C3 (fun n:nat => / INR (fact n)) x exp_cof_no_R0 Alembert_exp).
+unfold Pser, exp_in in |- *.
+trivial.
Defined.
-Definition exp : R -> R := [x:R](projT1 ? ? (exist_exp x)).
+Definition exp (x:R) : R := projT1 (exist_exp x).
-Lemma pow_i : (i:nat) (lt O i) -> (pow R0 i)==R0.
-Intros; Apply pow_ne_zero.
-Red; Intro; Rewrite H0 in H; Elim (lt_n_n ? H).
+Lemma pow_i : forall i:nat, (0 < i)%nat -> 0 ^ i = 0.
+intros; apply pow_ne_zero.
+red in |- *; intro; rewrite H0 in H; elim (lt_irrefl _ H).
Qed.
(*i Calculus of $e^0$ *)
-Lemma exist_exp0 : (SigT R [l:R](exp_in R0 l)).
-Apply Specif.existT with R1.
-Unfold exp_in; Unfold infinit_sum; Intros.
-Exists O.
-Intros; Replace (sum_f_R0 ([i:nat]``/(INR (fact i))*(pow R0 i)``) n) with R1.
-Unfold R_dist; Replace ``1-1`` with R0; [Rewrite Rabsolu_R0; Assumption | Ring].
-Induction n.
-Simpl; Rewrite Rinv_R1; Ring.
-Rewrite tech5.
-Rewrite <- Hrecn.
-Simpl.
-Ring.
-Unfold ge; Apply le_O_n.
+Lemma exist_exp0 : sigT (fun l:R => exp_in 0 l).
+apply existT with 1.
+unfold exp_in in |- *; unfold infinit_sum in |- *; intros.
+exists 0%nat.
+intros; replace (sum_f_R0 (fun i:nat => / INR (fact i) * 0 ^ i) n) with 1.
+unfold R_dist in |- *; replace (1 - 1) with 0;
+ [ rewrite Rabs_R0; assumption | ring ].
+induction n as [| n Hrecn].
+simpl in |- *; rewrite Rinv_1; ring.
+rewrite tech5.
+rewrite <- Hrecn.
+simpl in |- *.
+ring.
+unfold ge in |- *; apply le_O_n.
Defined.
-Lemma exp_0 : ``(exp 0)==1``.
-Cut (exp_in R0 (exp R0)).
-Cut (exp_in R0 R1).
-Unfold exp_in; Intros; EApply unicity_sum.
-Apply H0.
-Apply H.
-Exact (projT2 ? ? exist_exp0).
-Exact (projT2 ? ? (exist_exp R0)).
+Lemma exp_0 : exp 0 = 1.
+cut (exp_in 0 (exp 0)).
+cut (exp_in 0 1).
+unfold exp_in in |- *; intros; eapply uniqueness_sum.
+apply H0.
+apply H.
+exact (projT2 exist_exp0).
+exact (projT2 (exist_exp 0)).
Qed.
(**************************************)
(* Definition of hyperbolic functions *)
(**************************************)
-Definition cosh : R->R := [x:R]``((exp x)+(exp (-x)))/2``.
-Definition sinh : R->R := [x:R]``((exp x)-(exp (-x)))/2``.
-Definition tanh : R->R := [x:R]``(sinh x)/(cosh x)``.
+Definition cosh (x:R) : R := (exp x + exp (- x)) / 2.
+Definition sinh (x:R) : R := (exp x - exp (- x)) / 2.
+Definition tanh (x:R) : R := sinh x / cosh x.
-Lemma cosh_0 : ``(cosh 0)==1``.
-Unfold cosh; Rewrite Ropp_O; Rewrite exp_0.
-Unfold Rdiv; Rewrite <- Rinv_r_sym; [Reflexivity | DiscrR].
+Lemma cosh_0 : cosh 0 = 1.
+unfold cosh in |- *; rewrite Ropp_0; rewrite exp_0.
+unfold Rdiv in |- *; rewrite <- Rinv_r_sym; [ reflexivity | discrR ].
Qed.
-Lemma sinh_0 : ``(sinh 0)==0``.
-Unfold sinh; Rewrite Ropp_O; Rewrite exp_0.
-Unfold Rminus Rdiv; Rewrite Rplus_Ropp_r; Apply Rmult_Ol.
+Lemma sinh_0 : sinh 0 = 0.
+unfold sinh in |- *; rewrite Ropp_0; rewrite exp_0.
+unfold Rminus, Rdiv in |- *; rewrite Rplus_opp_r; apply Rmult_0_l.
Qed.
-Definition cos_n [n:nat] : R := ``(pow (-1) n)/(INR (fact (mult (S (S O)) n)))``.
-
-Lemma simpl_cos_n : (n:nat) (Rdiv (cos_n (S n)) (cos_n n))==(Ropp (Rinv (INR (mult (mult (2) (S n)) (plus (mult (2) n) (1)))))).
-Intro; Unfold cos_n; Replace (S n) with (plus n (1)); [Idtac | Ring].
-Rewrite pow_add; Unfold Rdiv; Rewrite Rinv_Rmult.
-Rewrite Rinv_Rinv.
-Replace ``(pow ( -1) n)*(pow ( -1) (S O))*/(INR (fact (mult (S (S O)) (plus n (S O)))))*(/(pow ( -1) n)*(INR (fact (mult (S (S O)) n))))`` with ``((pow ( -1) n)*/(pow ( -1) n))*/(INR (fact (mult (S (S O)) (plus n (S O)))))*(INR (fact (mult (S (S O)) n)))*(pow (-1) (S O))``; [Idtac | Ring].
-Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1l; Unfold pow; Rewrite Rmult_1r.
-Replace (mult (S (S O)) (plus n (S O))) with (S (S (mult (S (S O)) n))); [Idtac | Ring].
-Do 2 Rewrite fact_simpl; Do 2 Rewrite mult_INR; Repeat Rewrite Rinv_Rmult; Try (Apply not_O_INR; Discriminate).
-Rewrite <- (Rmult_sym ``-1``).
-Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Replace (S (mult (S (S O)) n)) with (plus (mult (S (S O)) n) (S O)); [Idtac | Ring].
-Rewrite mult_INR; Rewrite Rinv_Rmult.
-Ring.
-Apply not_O_INR; Discriminate.
-Replace (plus (mult (S (S O)) n) (S O)) with (S (mult (S (S O)) n)); [Apply not_O_INR; Discriminate | Ring].
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply prod_neq_R0; [Apply not_O_INR; Discriminate | Apply INR_fact_neq_0].
-Apply pow_nonzero; DiscrR.
-Apply INR_fact_neq_0.
-Apply pow_nonzero; DiscrR.
-Apply Rinv_neq_R0; Apply INR_fact_neq_0.
+Definition cos_n (n:nat) : R := (-1) ^ n / INR (fact (2 * n)).
+
+Lemma simpl_cos_n :
+ forall n:nat, cos_n (S n) / cos_n n = - / INR (2 * S n * (2 * n + 1)).
+intro; unfold cos_n in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ].
+rewrite pow_add; unfold Rdiv in |- *; rewrite Rinv_mult_distr.
+rewrite Rinv_involutive.
+replace
+ ((-1) ^ n * (-1) ^ 1 * / INR (fact (2 * (n + 1))) *
+ (/ (-1) ^ n * INR (fact (2 * n)))) with
+ ((-1) ^ n * / (-1) ^ n * / INR (fact (2 * (n + 1))) * INR (fact (2 * n)) *
+ (-1) ^ 1); [ idtac | ring ].
+rewrite <- Rinv_r_sym.
+rewrite Rmult_1_l; unfold pow in |- *; rewrite Rmult_1_r.
+replace (2 * (n + 1))%nat with (S (S (2 * n))); [ idtac | ring ].
+do 2 rewrite fact_simpl; do 2 rewrite mult_INR;
+ repeat rewrite Rinv_mult_distr; try (apply not_O_INR; discriminate).
+rewrite <- (Rmult_comm (-1)).
+repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r.
+replace (S (2 * n)) with (2 * n + 1)%nat; [ idtac | ring ].
+rewrite mult_INR; rewrite Rinv_mult_distr.
+ring.
+apply not_O_INR; discriminate.
+replace (2 * n + 1)%nat with (S (2 * n));
+ [ apply not_O_INR; discriminate | ring ].
+apply INR_fact_neq_0.
+apply INR_fact_neq_0.
+apply prod_neq_R0; [ apply not_O_INR; discriminate | apply INR_fact_neq_0 ].
+apply pow_nonzero; discrR.
+apply INR_fact_neq_0.
+apply pow_nonzero; discrR.
+apply Rinv_neq_0_compat; apply INR_fact_neq_0.
Qed.
-Lemma archimed_cor1 : (eps:R) ``0<eps`` -> (EX N : nat | ``/(INR N) < eps``/\(lt O N)).
-Intros; Cut ``/eps < (IZR (up (/eps)))``.
-Intro; Cut `0<=(up (Rinv eps))`.
-Intro; Assert H2 := (IZN ? H1); Elim H2; Intros; Exists (max x (1)).
-Split.
-Cut ``0<(IZR (INZ x))``.
-Intro; Rewrite INR_IZR_INZ; Apply Rle_lt_trans with ``/(IZR (INZ x))``.
-Apply Rle_monotony_contra with (IZR (INZ x)).
-Assumption.
-Rewrite <- Rinv_r_sym; [Idtac | Red; Intro; Rewrite H5 in H4; Elim (Rlt_antirefl ? H4)].
-Apply Rle_monotony_contra with (IZR (INZ (max x (1)))).
-Apply Rlt_le_trans with (IZR (INZ x)).
-Assumption.
-Repeat Rewrite <- INR_IZR_INZ; Apply le_INR; Apply le_max_l.
-Rewrite Rmult_1r; Rewrite (Rmult_sym (IZR (INZ (max x (S O))))); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Repeat Rewrite <- INR_IZR_INZ; Apply le_INR; Apply le_max_l.
-Rewrite <- INR_IZR_INZ; Apply not_O_INR.
-Red; Intro;Assert H6 := (le_max_r x (1)); Cut (lt O (1)); [Intro | Apply lt_O_Sn]; Assert H8 := (lt_le_trans ? ? ? H7 H6); Rewrite H5 in H8; Elim (lt_n_n ? H8).
-Pattern 1 eps; Rewrite <- Rinv_Rinv.
-Apply Rinv_lt.
-Apply Rmult_lt_pos; [Apply Rlt_Rinv; Assumption | Assumption].
-Rewrite H3 in H0; Assumption.
-Red; Intro; Rewrite H5 in H; Elim (Rlt_antirefl ? H).
-Apply Rlt_trans with ``/eps``.
-Apply Rlt_Rinv; Assumption.
-Rewrite H3 in H0; Assumption.
-Apply lt_le_trans with (1); [Apply lt_O_Sn | Apply le_max_r].
-Apply le_IZR; Replace (IZR `0`) with R0; [Idtac | Reflexivity]; Left; Apply Rlt_trans with ``/eps``; [Apply Rlt_Rinv; Assumption | Assumption].
-Assert H0 := (archimed ``/eps``).
-Elim H0; Intros; Assumption.
+Lemma archimed_cor1 :
+ forall eps:R, 0 < eps -> exists N : nat | / INR N < eps /\ (0 < N)%nat.
+intros; cut (/ eps < IZR (up (/ eps))).
+intro; cut (0 <= up (/ eps))%Z.
+intro; assert (H2 := IZN _ H1); elim H2; intros; exists (max x 1).
+split.
+cut (0 < IZR (Z_of_nat x)).
+intro; rewrite INR_IZR_INZ; apply Rle_lt_trans with (/ IZR (Z_of_nat x)).
+apply Rmult_le_reg_l with (IZR (Z_of_nat x)).
+assumption.
+rewrite <- Rinv_r_sym;
+ [ idtac | red in |- *; intro; rewrite H5 in H4; elim (Rlt_irrefl _ H4) ].
+apply Rmult_le_reg_l with (IZR (Z_of_nat (max x 1))).
+apply Rlt_le_trans with (IZR (Z_of_nat x)).
+assumption.
+repeat rewrite <- INR_IZR_INZ; apply le_INR; apply le_max_l.
+rewrite Rmult_1_r; rewrite (Rmult_comm (IZR (Z_of_nat (max x 1))));
+ rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r; repeat rewrite <- INR_IZR_INZ; apply le_INR;
+ apply le_max_l.
+rewrite <- INR_IZR_INZ; apply not_O_INR.
+red in |- *; intro; assert (H6 := le_max_r x 1); cut (0 < 1)%nat;
+ [ intro | apply lt_O_Sn ]; assert (H8 := lt_le_trans _ _ _ H7 H6);
+ rewrite H5 in H8; elim (lt_irrefl _ H8).
+pattern eps at 1 in |- *; rewrite <- Rinv_involutive.
+apply Rinv_lt_contravar.
+apply Rmult_lt_0_compat; [ apply Rinv_0_lt_compat; assumption | assumption ].
+rewrite H3 in H0; assumption.
+red in |- *; intro; rewrite H5 in H; elim (Rlt_irrefl _ H).
+apply Rlt_trans with (/ eps).
+apply Rinv_0_lt_compat; assumption.
+rewrite H3 in H0; assumption.
+apply lt_le_trans with 1%nat; [ apply lt_O_Sn | apply le_max_r ].
+apply le_IZR; replace (IZR 0) with 0; [ idtac | reflexivity ]; left;
+ apply Rlt_trans with (/ eps);
+ [ apply Rinv_0_lt_compat; assumption | assumption ].
+assert (H0 := archimed (/ eps)).
+elim H0; intros; assumption.
Qed.
-Lemma Alembert_cos : (Un_cv [n:nat]``(Rabsolu (cos_n (S n))/(cos_n n))`` R0).
-Unfold Un_cv; Intros.
-Assert H0 := (archimed_cor1 eps H).
-Elim H0; Intros; Exists x.
-Intros; Rewrite simpl_cos_n; Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_Rabsolu; Rewrite Rabsolu_Ropp; Rewrite Rabsolu_right.
-Rewrite mult_INR; Rewrite Rinv_Rmult.
-Cut ``/(INR (mult (S (S O)) (S n)))<1``.
-Intro; Cut ``/(INR (plus (mult (S (S O)) n) (S O)))<eps``.
-Intro; Rewrite <- (Rmult_1l eps).
-Apply Rmult_lt; Try Assumption.
-Change ``0</(INR (plus (mult (S (S O)) n) (S O)))``; Apply Rlt_Rinv; Apply lt_INR_0.
-Replace (plus (mult (2) n) (1)) with (S (mult (2) n)); [Apply lt_O_Sn | Ring].
-Apply Rlt_R0_R1.
-Cut (lt x (plus (mult (2) n) (1))).
-Intro; Assert H5 := (lt_INR ? ? H4).
-Apply Rlt_trans with ``/(INR x)``.
-Apply Rinv_lt.
-Apply Rmult_lt_pos.
-Apply lt_INR_0.
-Elim H1; Intros; Assumption.
-Apply lt_INR_0; Replace (plus (mult (2) n) (1)) with (S (mult (2) n)); [Apply lt_O_Sn | Ring].
-Assumption.
-Elim H1; Intros; Assumption.
-Apply lt_le_trans with (S n).
-Unfold ge in H2; Apply le_lt_n_Sm; Assumption.
-Replace (plus (mult (2) n) (1)) with (S (mult (2) n)); [Idtac | Ring].
-Apply le_n_S; Apply le_n_2n.
-Apply Rlt_monotony_contra with (INR (mult (S (S O)) (S n))).
-Apply lt_INR_0; Replace (mult (2) (S n)) with (S (S (mult (2) n))).
-Apply lt_O_Sn.
-Replace (S n) with (plus n (1)); [Idtac | Ring].
-Ring.
-Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Replace R1 with (INR (1)); [Apply lt_INR | Reflexivity].
-Replace (mult (2) (S n)) with (S (S (mult (2) n))).
-Apply lt_n_S; Apply lt_O_Sn.
-Replace (S n) with (plus n (1)); [Ring | Ring].
-Apply not_O_INR; Discriminate.
-Apply not_O_INR; Discriminate.
-Replace (plus (mult (S (S O)) n) (S O)) with (S (mult (2) n)); [Apply not_O_INR; Discriminate | Ring].
-Apply Rle_sym1; Left; Apply Rlt_Rinv.
-Apply lt_INR_0.
-Replace (mult (mult (2) (S n)) (plus (mult (2) n) (1))) with (S (S (plus (mult (4) (mult n n)) (mult (6) n)))).
-Apply lt_O_Sn.
-Apply INR_eq.
-Repeat Rewrite S_INR; Rewrite plus_INR; Repeat Rewrite mult_INR; Rewrite plus_INR; Rewrite mult_INR; Repeat Rewrite S_INR; Replace (INR O) with R0; [Ring | Reflexivity].
+Lemma Alembert_cos : Un_cv (fun n:nat => Rabs (cos_n (S n) / cos_n n)) 0.
+unfold Un_cv in |- *; intros.
+assert (H0 := archimed_cor1 eps H).
+elim H0; intros; exists x.
+intros; rewrite simpl_cos_n; unfold R_dist in |- *; unfold Rminus in |- *;
+ rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_Rabsolu;
+ rewrite Rabs_Ropp; rewrite Rabs_right.
+rewrite mult_INR; rewrite Rinv_mult_distr.
+cut (/ INR (2 * S n) < 1).
+intro; cut (/ INR (2 * n + 1) < eps).
+intro; rewrite <- (Rmult_1_l eps).
+apply Rmult_gt_0_lt_compat; try assumption.
+change (0 < / INR (2 * n + 1)) in |- *; apply Rinv_0_lt_compat;
+ apply lt_INR_0.
+replace (2 * n + 1)%nat with (S (2 * n)); [ apply lt_O_Sn | ring ].
+apply Rlt_0_1.
+cut (x < 2 * n + 1)%nat.
+intro; assert (H5 := lt_INR _ _ H4).
+apply Rlt_trans with (/ INR x).
+apply Rinv_lt_contravar.
+apply Rmult_lt_0_compat.
+apply lt_INR_0.
+elim H1; intros; assumption.
+apply lt_INR_0; replace (2 * n + 1)%nat with (S (2 * n));
+ [ apply lt_O_Sn | ring ].
+assumption.
+elim H1; intros; assumption.
+apply lt_le_trans with (S n).
+unfold ge in H2; apply le_lt_n_Sm; assumption.
+replace (2 * n + 1)%nat with (S (2 * n)); [ idtac | ring ].
+apply le_n_S; apply le_n_2n.
+apply Rmult_lt_reg_l with (INR (2 * S n)).
+apply lt_INR_0; replace (2 * S n)%nat with (S (S (2 * n))).
+apply lt_O_Sn.
+replace (S n) with (n + 1)%nat; [ idtac | ring ].
+ring.
+rewrite <- Rinv_r_sym.
+rewrite Rmult_1_r; replace 1 with (INR 1); [ apply lt_INR | reflexivity ].
+replace (2 * S n)%nat with (S (S (2 * n))).
+apply lt_n_S; apply lt_O_Sn.
+replace (S n) with (n + 1)%nat; [ ring | ring ].
+apply not_O_INR; discriminate.
+apply not_O_INR; discriminate.
+replace (2 * n + 1)%nat with (S (2 * n));
+ [ apply not_O_INR; discriminate | ring ].
+apply Rle_ge; left; apply Rinv_0_lt_compat.
+apply lt_INR_0.
+replace (2 * S n * (2 * n + 1))%nat with (S (S (4 * (n * n) + 6 * n))).
+apply lt_O_Sn.
+apply INR_eq.
+repeat rewrite S_INR; rewrite plus_INR; repeat rewrite mult_INR;
+ rewrite plus_INR; rewrite mult_INR; repeat rewrite S_INR;
+ replace (INR 0) with 0; [ ring | reflexivity ].
Qed.
-Lemma cosn_no_R0 : (n:nat)``(cos_n n)<>0``.
-Intro; Unfold cos_n; Unfold Rdiv; Apply prod_neq_R0.
-Apply pow_nonzero; DiscrR.
-Apply Rinv_neq_R0.
-Apply INR_fact_neq_0.
+Lemma cosn_no_R0 : forall n:nat, cos_n n <> 0.
+intro; unfold cos_n in |- *; unfold Rdiv in |- *; apply prod_neq_R0.
+apply pow_nonzero; discrR.
+apply Rinv_neq_0_compat.
+apply INR_fact_neq_0.
Qed.
(**********)
-Definition cos_in:R->R->Prop := [x,l:R](infinit_sum [i:nat]``(cos_n i)*(pow x i)`` l).
+Definition cos_in (x l:R) : Prop :=
+ infinit_sum (fun i:nat => cos_n i * x ^ i) l.
(**********)
-Lemma exist_cos : (x:R)(SigT R [l:R](cos_in x l)).
-Intro; Generalize (Alembert_C3 cos_n x cosn_no_R0 Alembert_cos).
-Unfold Pser cos_in; Trivial.
+Lemma exist_cos : forall x:R, sigT (fun l:R => cos_in x l).
+intro; generalize (Alembert_C3 cos_n x cosn_no_R0 Alembert_cos).
+unfold Pser, cos_in in |- *; trivial.
Qed.
(* Definition of cosinus *)
(*************************)
-Definition cos : R -> R := [x:R](Cases (exist_cos (Rsqr x)) of (Specif.existT a b) => a end).
-
-
-Definition sin_n [n:nat] : R := ``(pow (-1) n)/(INR (fact (plus (mult (S (S O)) n) (S O))))``.
-
-Lemma simpl_sin_n : (n:nat) (Rdiv (sin_n (S n)) (sin_n n))==(Ropp (Rinv (INR (mult (plus (mult (2) (S n)) (1)) (mult (2) (S n)))))).
-Intro; Unfold sin_n; Replace (S n) with (plus n (1)); [Idtac | Ring].
-Rewrite pow_add; Unfold Rdiv; Rewrite Rinv_Rmult.
-Rewrite Rinv_Rinv.
-Replace ``(pow ( -1) n)*(pow ( -1) (S O))*/(INR (fact (plus (mult (S (S O)) (plus n (S O))) (S O))))*(/(pow ( -1) n)*(INR (fact (plus (mult (S (S O)) n) (S O)))))`` with ``((pow ( -1) n)*/(pow ( -1) n))*/(INR (fact (plus (mult (S (S O)) (plus n (S O))) (S O))))*(INR (fact (plus (mult (S (S O)) n) (S O))))*(pow (-1) (S O))``; [Idtac | Ring].
-Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1l; Unfold pow; Rewrite Rmult_1r; Replace (plus (mult (S (S O)) (plus n (S O))) (S O)) with (S (S (plus (mult (S (S O)) n) (S O)))).
-Do 2 Rewrite fact_simpl; Do 2 Rewrite mult_INR; Repeat Rewrite Rinv_Rmult.
-Rewrite <- (Rmult_sym ``-1``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Replace (S (plus (mult (S (S O)) n) (S O))) with (mult (S (S O)) (plus n (S O))).
-Repeat Rewrite mult_INR; Repeat Rewrite Rinv_Rmult.
-Ring.
-Apply not_O_INR; Discriminate.
-Replace (plus n (S O)) with (S n); [Apply not_O_INR; Discriminate | Ring].
-Apply not_O_INR; Discriminate.
-Apply prod_neq_R0.
-Apply not_O_INR; Discriminate.
-Replace (plus n (S O)) with (S n); [Apply not_O_INR; Discriminate | Ring].
-Apply not_O_INR; Discriminate.
-Replace (plus n (S O)) with (S n); [Apply not_O_INR; Discriminate | Ring].
-Rewrite mult_plus_distr_r; Cut (n:nat) (S n)=(plus n (1)).
-Intros; Rewrite (H (plus (mult (2) n) (1))).
-Ring.
-Intros; Ring.
-Apply INR_fact_neq_0.
-Apply not_O_INR; Discriminate.
-Apply INR_fact_neq_0.
-Apply not_O_INR; Discriminate.
-Apply prod_neq_R0; [Apply not_O_INR; Discriminate | Apply INR_fact_neq_0].
-Cut (n:nat) (S (S n))=(plus n (2)); [Intros; Rewrite (H (plus (mult (2) n) (1))); Ring | Intros; Ring].
-Apply pow_nonzero; DiscrR.
-Apply INR_fact_neq_0.
-Apply pow_nonzero; DiscrR.
-Apply Rinv_neq_R0; Apply INR_fact_neq_0.
+Definition cos (x:R) : R :=
+ match exist_cos (Rsqr x) with
+ | existT a b => a
+ end.
+
+
+Definition sin_n (n:nat) : R := (-1) ^ n / INR (fact (2 * n + 1)).
+
+Lemma simpl_sin_n :
+ forall n:nat, sin_n (S n) / sin_n n = - / INR ((2 * S n + 1) * (2 * S n)).
+intro; unfold sin_n in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ].
+rewrite pow_add; unfold Rdiv in |- *; rewrite Rinv_mult_distr.
+rewrite Rinv_involutive.
+replace
+ ((-1) ^ n * (-1) ^ 1 * / INR (fact (2 * (n + 1) + 1)) *
+ (/ (-1) ^ n * INR (fact (2 * n + 1)))) with
+ ((-1) ^ n * / (-1) ^ n * / INR (fact (2 * (n + 1) + 1)) *
+ INR (fact (2 * n + 1)) * (-1) ^ 1); [ idtac | ring ].
+rewrite <- Rinv_r_sym.
+rewrite Rmult_1_l; unfold pow in |- *; rewrite Rmult_1_r;
+ replace (2 * (n + 1) + 1)%nat with (S (S (2 * n + 1))).
+do 2 rewrite fact_simpl; do 2 rewrite mult_INR;
+ repeat rewrite Rinv_mult_distr.
+rewrite <- (Rmult_comm (-1)); repeat rewrite Rmult_assoc;
+ rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r; replace (S (2 * n + 1)) with (2 * (n + 1))%nat.
+repeat rewrite mult_INR; repeat rewrite Rinv_mult_distr.
+ring.
+apply not_O_INR; discriminate.
+replace (n + 1)%nat with (S n); [ apply not_O_INR; discriminate | ring ].
+apply not_O_INR; discriminate.
+apply prod_neq_R0.
+apply not_O_INR; discriminate.
+replace (n + 1)%nat with (S n); [ apply not_O_INR; discriminate | ring ].
+apply not_O_INR; discriminate.
+replace (n + 1)%nat with (S n); [ apply not_O_INR; discriminate | ring ].
+rewrite mult_plus_distr_l; cut (forall n:nat, S n = (n + 1)%nat).
+intros; rewrite (H (2 * n + 1)%nat).
+ring.
+intros; ring.
+apply INR_fact_neq_0.
+apply not_O_INR; discriminate.
+apply INR_fact_neq_0.
+apply not_O_INR; discriminate.
+apply prod_neq_R0; [ apply not_O_INR; discriminate | apply INR_fact_neq_0 ].
+cut (forall n:nat, S (S n) = (n + 2)%nat);
+ [ intros; rewrite (H (2 * n + 1)%nat); ring | intros; ring ].
+apply pow_nonzero; discrR.
+apply INR_fact_neq_0.
+apply pow_nonzero; discrR.
+apply Rinv_neq_0_compat; apply INR_fact_neq_0.
Qed.
-Lemma Alembert_sin : (Un_cv [n:nat]``(Rabsolu (sin_n (S n))/(sin_n n))`` R0).
-Unfold Un_cv; Intros; Assert H0 := (archimed_cor1 eps H).
-Elim H0; Intros; Exists x.
-Intros; Rewrite simpl_sin_n; Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_Rabsolu; Rewrite Rabsolu_Ropp; Rewrite Rabsolu_right.
-Rewrite mult_INR; Rewrite Rinv_Rmult.
-Cut ``/(INR (mult (S (S O)) (S n)))<1``.
-Intro; Cut ``/(INR (plus (mult (S (S O)) (S n)) (S O)))<eps``.
-Intro; Rewrite <- (Rmult_1l eps); Rewrite (Rmult_sym ``/(INR (plus (mult (S (S O)) (S n)) (S O)))``); Apply Rmult_lt; Try Assumption.
-Change ``0</(INR (plus (mult (S (S O)) (S n)) (S O)))``; Apply Rlt_Rinv; Apply lt_INR_0; Replace (plus (mult (2) (S n)) (1)) with (S (mult (2) (S n))); [Apply lt_O_Sn | Ring].
-Apply Rlt_R0_R1.
-Cut (lt x (plus (mult (2) (S n)) (1))).
-Intro; Assert H5 := (lt_INR ? ? H4); Apply Rlt_trans with ``/(INR x)``.
-Apply Rinv_lt.
-Apply Rmult_lt_pos.
-Apply lt_INR_0; Elim H1; Intros; Assumption.
-Apply lt_INR_0; Replace (plus (mult (2) (S n)) (1)) with (S (mult (2) (S n))); [Apply lt_O_Sn | Ring].
-Assumption.
-Elim H1; Intros; Assumption.
-Apply lt_le_trans with (S n).
-Unfold ge in H2; Apply le_lt_n_Sm; Assumption.
-Replace (plus (mult (2) (S n)) (1)) with (S (mult (2) (S n))); [Idtac | Ring].
-Apply le_S; Apply le_n_2n.
-Apply Rlt_monotony_contra with (INR (mult (S (S O)) (S n))).
-Apply lt_INR_0; Replace (mult (2) (S n)) with (S (S (mult (2) n))); [Apply lt_O_Sn | Replace (S n) with (plus n (1)); [Idtac | Ring]; Ring].
-Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Replace R1 with (INR (1)); [Apply lt_INR | Reflexivity].
-Replace (mult (2) (S n)) with (S (S (mult (2) n))).
-Apply lt_n_S; Apply lt_O_Sn.
-Replace (S n) with (plus n (1)); [Ring | Ring].
-Apply not_O_INR; Discriminate.
-Apply not_O_INR; Discriminate.
-Apply not_O_INR; Discriminate.
-Left; Change ``0</(INR (mult (plus (mult (S (S O)) (S n)) (S O)) (mult (S (S O)) (S n))))``; Apply Rlt_Rinv.
-Apply lt_INR_0.
-Replace (mult (plus (mult (2) (S n)) (1)) (mult (2) (S n))) with (S (S (S (S (S (S (plus (mult (4) (mult n n)) (mult (10) n)))))))).
-Apply lt_O_Sn.
-Apply INR_eq; Repeat Rewrite S_INR; Rewrite plus_INR; Repeat Rewrite mult_INR; Rewrite plus_INR; Rewrite mult_INR; Repeat Rewrite S_INR; Replace (INR O) with R0; [Ring | Reflexivity].
+Lemma Alembert_sin : Un_cv (fun n:nat => Rabs (sin_n (S n) / sin_n n)) 0.
+unfold Un_cv in |- *; intros; assert (H0 := archimed_cor1 eps H).
+elim H0; intros; exists x.
+intros; rewrite simpl_sin_n; unfold R_dist in |- *; unfold Rminus in |- *;
+ rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_Rabsolu;
+ rewrite Rabs_Ropp; rewrite Rabs_right.
+rewrite mult_INR; rewrite Rinv_mult_distr.
+cut (/ INR (2 * S n) < 1).
+intro; cut (/ INR (2 * S n + 1) < eps).
+intro; rewrite <- (Rmult_1_l eps); rewrite (Rmult_comm (/ INR (2 * S n + 1)));
+ apply Rmult_gt_0_lt_compat; try assumption.
+change (0 < / INR (2 * S n + 1)) in |- *; apply Rinv_0_lt_compat;
+ apply lt_INR_0; replace (2 * S n + 1)%nat with (S (2 * S n));
+ [ apply lt_O_Sn | ring ].
+apply Rlt_0_1.
+cut (x < 2 * S n + 1)%nat.
+intro; assert (H5 := lt_INR _ _ H4); apply Rlt_trans with (/ INR x).
+apply Rinv_lt_contravar.
+apply Rmult_lt_0_compat.
+apply lt_INR_0; elim H1; intros; assumption.
+apply lt_INR_0; replace (2 * S n + 1)%nat with (S (2 * S n));
+ [ apply lt_O_Sn | ring ].
+assumption.
+elim H1; intros; assumption.
+apply lt_le_trans with (S n).
+unfold ge in H2; apply le_lt_n_Sm; assumption.
+replace (2 * S n + 1)%nat with (S (2 * S n)); [ idtac | ring ].
+apply le_S; apply le_n_2n.
+apply Rmult_lt_reg_l with (INR (2 * S n)).
+apply lt_INR_0; replace (2 * S n)%nat with (S (S (2 * n)));
+ [ apply lt_O_Sn | replace (S n) with (n + 1)%nat; [ idtac | ring ]; ring ].
+rewrite <- Rinv_r_sym.
+rewrite Rmult_1_r; replace 1 with (INR 1); [ apply lt_INR | reflexivity ].
+replace (2 * S n)%nat with (S (S (2 * n))).
+apply lt_n_S; apply lt_O_Sn.
+replace (S n) with (n + 1)%nat; [ ring | ring ].
+apply not_O_INR; discriminate.
+apply not_O_INR; discriminate.
+apply not_O_INR; discriminate.
+left; change (0 < / INR ((2 * S n + 1) * (2 * S n))) in |- *;
+ apply Rinv_0_lt_compat.
+apply lt_INR_0.
+replace ((2 * S n + 1) * (2 * S n))%nat with
+ (S (S (S (S (S (S (4 * (n * n) + 10 * n))))))).
+apply lt_O_Sn.
+apply INR_eq; repeat rewrite S_INR; rewrite plus_INR; repeat rewrite mult_INR;
+ rewrite plus_INR; rewrite mult_INR; repeat rewrite S_INR;
+ replace (INR 0) with 0; [ ring | reflexivity ].
Qed.
-Lemma sin_no_R0 : (n:nat)``(sin_n n)<>0``.
-Intro; Unfold sin_n; Unfold Rdiv; Apply prod_neq_R0.
-Apply pow_nonzero; DiscrR.
-Apply Rinv_neq_R0; Apply INR_fact_neq_0.
+Lemma sin_no_R0 : forall n:nat, sin_n n <> 0.
+intro; unfold sin_n in |- *; unfold Rdiv in |- *; apply prod_neq_R0.
+apply pow_nonzero; discrR.
+apply Rinv_neq_0_compat; apply INR_fact_neq_0.
Qed.
(**********)
-Definition sin_in:R->R->Prop := [x,l:R](infinit_sum [i:nat]``(sin_n i)*(pow x i)`` l).
+Definition sin_in (x l:R) : Prop :=
+ infinit_sum (fun i:nat => sin_n i * x ^ i) l.
(**********)
-Lemma exist_sin : (x:R)(SigT R [l:R](sin_in x l)).
-Intro; Generalize (Alembert_C3 sin_n x sin_no_R0 Alembert_sin).
-Unfold Pser sin_n; Trivial.
+Lemma exist_sin : forall x:R, sigT (fun l:R => sin_in x l).
+intro; generalize (Alembert_C3 sin_n x sin_no_R0 Alembert_sin).
+unfold Pser, sin_n in |- *; trivial.
Qed.
(***********************)
(* Definition of sinus *)
-Definition sin : R -> R := [x:R](Cases (exist_sin (Rsqr x)) of (Specif.existT a b) => ``x*a`` end).
+Definition sin (x:R) : R :=
+ match exist_sin (Rsqr x) with
+ | existT a b => x * a
+ end.
(*********************************************)
(* PROPERTIES *)
(*********************************************)
-Lemma cos_sym : (x:R) ``(cos x)==(cos (-x))``.
-Intros; Unfold cos; Replace ``(Rsqr (-x))`` with (Rsqr x).
-Reflexivity.
-Apply Rsqr_neg.
+Lemma cos_sym : forall x:R, cos x = cos (- x).
+intros; unfold cos in |- *; replace (Rsqr (- x)) with (Rsqr x).
+reflexivity.
+apply Rsqr_neg.
Qed.
-Lemma sin_antisym : (x:R)``(sin (-x))==-(sin x)``.
-Intro; Unfold sin; Replace ``(Rsqr (-x))`` with (Rsqr x); [Idtac | Apply Rsqr_neg].
-Case (exist_sin (Rsqr x)); Intros; Ring.
+Lemma sin_antisym : forall x:R, sin (- x) = - sin x.
+intro; unfold sin in |- *; replace (Rsqr (- x)) with (Rsqr x);
+ [ idtac | apply Rsqr_neg ].
+case (exist_sin (Rsqr x)); intros; ring.
Qed.
-Lemma sin_0 : ``(sin 0)==0``.
-Unfold sin; Case (exist_sin (Rsqr R0)).
-Intros; Ring.
+Lemma sin_0 : sin 0 = 0.
+unfold sin in |- *; case (exist_sin (Rsqr 0)).
+intros; ring.
Qed.
-Lemma exist_cos0 : (SigT R [l:R](cos_in R0 l)).
-Apply Specif.existT with R1.
-Unfold cos_in; Unfold infinit_sum; Intros; Exists O.
-Intros.
-Unfold R_dist.
-Induction n.
-Unfold cos_n; Simpl.
-Unfold Rdiv; Rewrite Rinv_R1.
-Do 2 Rewrite Rmult_1r.
-Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption.
-Rewrite tech5.
-Replace ``(cos_n (S n))*(pow 0 (S n))`` with R0.
-Rewrite Rplus_Or.
-Apply Hrecn; Unfold ge; Apply le_O_n.
-Simpl; Ring.
+Lemma exist_cos0 : sigT (fun l:R => cos_in 0 l).
+apply existT with 1.
+unfold cos_in in |- *; unfold infinit_sum in |- *; intros; exists 0%nat.
+intros.
+unfold R_dist in |- *.
+induction n as [| n Hrecn].
+unfold cos_n in |- *; simpl in |- *.
+unfold Rdiv in |- *; rewrite Rinv_1.
+do 2 rewrite Rmult_1_r.
+unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption.
+rewrite tech5.
+replace (cos_n (S n) * 0 ^ S n) with 0.
+rewrite Rplus_0_r.
+apply Hrecn; unfold ge in |- *; apply le_O_n.
+simpl in |- *; ring.
Defined.
(* Calculus of (cos 0) *)
-Lemma cos_0 : ``(cos 0)==1``.
-Cut (cos_in R0 (cos R0)).
-Cut (cos_in R0 R1).
-Unfold cos_in; Intros; EApply unicity_sum.
-Apply H0.
-Apply H.
-Exact (projT2 ? ? exist_cos0).
-Assert H := (projT2 ? ? (exist_cos (Rsqr R0))); Unfold cos; Pattern 1 R0; Replace R0 with (Rsqr R0); [Exact H | Apply Rsqr_O].
-Qed.
+Lemma cos_0 : cos 0 = 1.
+cut (cos_in 0 (cos 0)).
+cut (cos_in 0 1).
+unfold cos_in in |- *; intros; eapply uniqueness_sum.
+apply H0.
+apply H.
+exact (projT2 exist_cos0).
+assert (H := projT2 (exist_cos (Rsqr 0))); unfold cos in |- *;
+ pattern 0 at 1 in |- *; replace 0 with (Rsqr 0); [ exact H | apply Rsqr_0 ].
+Qed. \ No newline at end of file
diff --git a/theories/Reals/Rtrigo_fun.v b/theories/Reals/Rtrigo_fun.v
index 33c3f6a5f..6470dd581 100644
--- a/theories/Reals/Rtrigo_fun.v
+++ b/theories/Reals/Rtrigo_fun.v
@@ -8,10 +8,9 @@
(*i $Id$ i*)
-Require Rbase.
-Require Rfunctions.
-Require SeqSeries.
-V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
+Require Import Rbase.
+Require Import Rfunctions.
+Require Import SeqSeries.
Open Local Scope R_scope.
(*****************************************************************)
@@ -24,95 +23,87 @@ Open Local Scope R_scope.
(*****************************************************************)
(*********)
-Lemma Alembert_exp:(Un_cv
- [n:nat](Rabsolu (Rmult (Rinv (INR (fact (S n))))
- (Rinv (Rinv (INR (fact n)))))) R0).
-Unfold Un_cv;Intros;Elim (total_order_Rgt eps R1);Intro.
-Split with O;Intros;Rewrite (simpl_fact n);Unfold R_dist;
- Rewrite (minus_R0 (Rabsolu (Rinv (INR (S n)))));
- Rewrite (Rabsolu_Rabsolu (Rinv (INR (S n))));
- Cut (Rgt (Rinv (INR (S n))) R0).
-Intro; Rewrite (Rabsolu_pos_eq (Rinv (INR (S n)))).
-Cut (Rlt (Rminus (Rinv eps) R1) R0).
-Intro;Generalize (Rlt_le_trans (Rminus (Rinv eps) R1) R0 (INR n) H2
- (pos_INR n));Clear H2;Intro;
- Unfold Rminus in H2;Generalize (Rlt_compatibility R1
- (Rplus (Rinv eps) (Ropp R1)) (INR n) H2);
- Replace (Rplus R1 (Rplus (Rinv eps) (Ropp R1))) with (Rinv eps);
- [Clear H2;Intro|Ring].
-Rewrite (Rplus_sym R1 (INR n)) in H2;Rewrite <-(S_INR n) in H2;
- Generalize (Rmult_gt (Rinv (INR (S n))) eps H1 H);Intro;
- Unfold Rgt in H3;
- Generalize (Rlt_monotony (Rmult (Rinv (INR (S n))) eps) (Rinv eps)
- (INR (S n)) H3 H2);Intro;
- Rewrite (Rmult_assoc (Rinv (INR (S n))) eps (Rinv eps)) in H4;
- Rewrite (Rinv_r eps (imp_not_Req eps R0
- (or_intror (Rlt eps R0) (Rgt eps R0) H)))
- in H4;Rewrite (let (H1,H2)=(Rmult_ne (Rinv (INR (S n)))) in H1)
- in H4;Rewrite (Rmult_sym (Rinv (INR (S n)))) in H4;
- Rewrite (Rmult_assoc eps (Rinv (INR (S n))) (INR (S n))) in H4;
- Rewrite (Rinv_l (INR (S n)) (not_O_INR (S n)
- (sym_not_equal nat O (S n) (O_S n)))) in H4;
- Rewrite (let (H1,H2)=(Rmult_ne eps) in H1) in H4;Assumption.
-Apply Rlt_minus;Unfold Rgt in a;Rewrite <- Rinv_R1;
- Apply (Rinv_lt R1 eps);Auto;
- Rewrite (let (H1,H2)=(Rmult_ne eps) in H2);Unfold Rgt in H;Assumption.
-Unfold Rgt in H1;Apply Rlt_le;Assumption.
-Unfold Rgt;Apply Rlt_Rinv; Apply lt_INR_0;Apply lt_O_Sn.
+Lemma Alembert_exp :
+ Un_cv (fun n:nat => Rabs (/ INR (fact (S n)) * / / INR (fact n))) 0.
+unfold Un_cv in |- *; intros; elim (Rgt_dec eps 1); intro.
+split with 0%nat; intros; rewrite (simpl_fact n); unfold R_dist in |- *;
+ rewrite (Rminus_0_r (Rabs (/ INR (S n))));
+ rewrite (Rabs_Rabsolu (/ INR (S n))); cut (/ INR (S n) > 0).
+intro; rewrite (Rabs_pos_eq (/ INR (S n))).
+cut (/ eps - 1 < 0).
+intro; generalize (Rlt_le_trans (/ eps - 1) 0 (INR n) H2 (pos_INR n));
+ clear H2; intro; unfold Rminus in H2;
+ generalize (Rplus_lt_compat_l 1 (/ eps + -1) (INR n) H2);
+ replace (1 + (/ eps + -1)) with (/ eps); [ clear H2; intro | ring ].
+rewrite (Rplus_comm 1 (INR n)) in H2; rewrite <- (S_INR n) in H2;
+ generalize (Rmult_gt_0_compat (/ INR (S n)) eps H1 H);
+ intro; unfold Rgt in H3;
+ generalize (Rmult_lt_compat_l (/ INR (S n) * eps) (/ eps) (INR (S n)) H3 H2);
+ intro; rewrite (Rmult_assoc (/ INR (S n)) eps (/ eps)) in H4;
+ rewrite (Rinv_r eps (Rlt_dichotomy_converse eps 0 (or_intror (eps < 0) H)))
+ in H4; rewrite (let (H1, H2) := Rmult_ne (/ INR (S n)) in H1) in H4;
+ rewrite (Rmult_comm (/ INR (S n))) in H4;
+ rewrite (Rmult_assoc eps (/ INR (S n)) (INR (S n))) in H4;
+ rewrite (Rinv_l (INR (S n)) (not_O_INR (S n) (sym_not_equal (O_S n)))) in H4;
+ rewrite (let (H1, H2) := Rmult_ne eps in H1) in H4;
+ assumption.
+apply Rlt_minus; unfold Rgt in a; rewrite <- Rinv_1;
+ apply (Rinv_lt_contravar 1 eps); auto;
+ rewrite (let (H1, H2) := Rmult_ne eps in H2); unfold Rgt in H;
+ assumption.
+unfold Rgt in H1; apply Rlt_le; assumption.
+unfold Rgt in |- *; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn.
(**)
-Cut `0<=(up (Rminus (Rinv eps) R1))`.
-Intro;Elim (IZN (up (Rminus (Rinv eps) R1)) H0);Intros;
- Split with x;Intros;Rewrite (simpl_fact n);Unfold R_dist;
- Rewrite (minus_R0 (Rabsolu (Rinv (INR (S n)))));
- Rewrite (Rabsolu_Rabsolu (Rinv (INR (S n))));
- Cut (Rgt (Rinv (INR (S n))) R0).
-Intro; Rewrite (Rabsolu_pos_eq (Rinv (INR (S n)))).
-Cut (Rlt (Rminus (Rinv eps) R1) (INR x)).
-Intro;Generalize (Rlt_le_trans (Rminus (Rinv eps) R1) (INR x) (INR n)
- H4 (le_INR x n ([n,m:nat; H:(ge m n)]H x n H2)));
- Clear H4;Intro;Unfold Rminus in H4;Generalize (Rlt_compatibility R1
- (Rplus (Rinv eps) (Ropp R1)) (INR n) H4);
- Replace (Rplus R1 (Rplus (Rinv eps) (Ropp R1))) with (Rinv eps);
- [Clear H4;Intro|Ring].
-Rewrite (Rplus_sym R1 (INR n)) in H4;Rewrite <-(S_INR n) in H4;
- Generalize (Rmult_gt (Rinv (INR (S n))) eps H3 H);Intro;
- Unfold Rgt in H5;
- Generalize (Rlt_monotony (Rmult (Rinv (INR (S n))) eps) (Rinv eps)
- (INR (S n)) H5 H4);Intro;
- Rewrite (Rmult_assoc (Rinv (INR (S n))) eps (Rinv eps)) in H6;
- Rewrite (Rinv_r eps (imp_not_Req eps R0
- (or_intror (Rlt eps R0) (Rgt eps R0) H)))
- in H6;Rewrite (let (H1,H2)=(Rmult_ne (Rinv (INR (S n)))) in H1)
- in H6;Rewrite (Rmult_sym (Rinv (INR (S n)))) in H6;
- Rewrite (Rmult_assoc eps (Rinv (INR (S n))) (INR (S n))) in H6;
- Rewrite (Rinv_l (INR (S n)) (not_O_INR (S n)
- (sym_not_equal nat O (S n) (O_S n)))) in H6;
- Rewrite (let (H1,H2)=(Rmult_ne eps) in H1) in H6;Assumption.
-Cut (IZR (up (Rminus (Rinv eps) R1)))==(IZR (INZ x));
- [Intro|Rewrite H1;Trivial].
-Elim (archimed (Rminus (Rinv eps) R1));Intros;Clear H6;
- Unfold Rgt in H5;Rewrite H4 in H5;Rewrite INR_IZR_INZ;Assumption.
-Unfold Rgt in H1;Apply Rlt_le;Assumption.
-Unfold Rgt;Apply Rlt_Rinv; Apply lt_INR_0;Apply lt_O_Sn.
-Apply (le_O_IZR (up (Rminus (Rinv eps) R1)));
- Apply (Rle_trans R0 (Rminus (Rinv eps) R1)
- (IZR (up (Rminus (Rinv eps) R1)))).
-Generalize (Rgt_not_le eps R1 b);Clear b;Unfold Rle;Intro;Elim H0;
- Clear H0;Intro.
-Left;Unfold Rgt in H;
- Generalize (Rlt_monotony (Rinv eps) eps R1 (Rlt_Rinv eps H) H0);
- Rewrite (Rinv_l eps (sym_not_eqT R R0 eps
- (imp_not_Req R0 eps (or_introl (Rlt R0 eps) (Rgt R0 eps) H))));
- Rewrite (let (H1,H2)=(Rmult_ne (Rinv eps)) in H1);Intro;
- Fold (Rgt (Rminus (Rinv eps) R1) R0);Apply Rgt_minus;Unfold Rgt;
- Assumption.
-Right;Rewrite H0;Rewrite Rinv_R1;Apply sym_eqT;Apply eq_Rminus;Auto.
-Elim (archimed (Rminus (Rinv eps) R1));Intros;Clear H1;
- Unfold Rgt in H0;Apply Rlt_le;Assumption.
+cut (0 <= up (/ eps - 1))%Z.
+intro; elim (IZN (up (/ eps - 1)) H0); intros; split with x; intros;
+ rewrite (simpl_fact n); unfold R_dist in |- *;
+ rewrite (Rminus_0_r (Rabs (/ INR (S n))));
+ rewrite (Rabs_Rabsolu (/ INR (S n))); cut (/ INR (S n) > 0).
+intro; rewrite (Rabs_pos_eq (/ INR (S n))).
+cut (/ eps - 1 < INR x).
+intro;
+ generalize
+ (Rlt_le_trans (/ eps - 1) (INR x) (INR n) H4
+ (le_INR x n ((fun (n m:nat) (H:(m >= n)%nat) => H) x n H2)));
+ clear H4; intro; unfold Rminus in H4;
+ generalize (Rplus_lt_compat_l 1 (/ eps + -1) (INR n) H4);
+ replace (1 + (/ eps + -1)) with (/ eps); [ clear H4; intro | ring ].
+rewrite (Rplus_comm 1 (INR n)) in H4; rewrite <- (S_INR n) in H4;
+ generalize (Rmult_gt_0_compat (/ INR (S n)) eps H3 H);
+ intro; unfold Rgt in H5;
+ generalize (Rmult_lt_compat_l (/ INR (S n) * eps) (/ eps) (INR (S n)) H5 H4);
+ intro; rewrite (Rmult_assoc (/ INR (S n)) eps (/ eps)) in H6;
+ rewrite (Rinv_r eps (Rlt_dichotomy_converse eps 0 (or_intror (eps < 0) H)))
+ in H6; rewrite (let (H1, H2) := Rmult_ne (/ INR (S n)) in H1) in H6;
+ rewrite (Rmult_comm (/ INR (S n))) in H6;
+ rewrite (Rmult_assoc eps (/ INR (S n)) (INR (S n))) in H6;
+ rewrite (Rinv_l (INR (S n)) (not_O_INR (S n) (sym_not_equal (O_S n)))) in H6;
+ rewrite (let (H1, H2) := Rmult_ne eps in H1) in H6;
+ assumption.
+cut (IZR (up (/ eps - 1)) = IZR (Z_of_nat x));
+ [ intro | rewrite H1; trivial ].
+elim (archimed (/ eps - 1)); intros; clear H6; unfold Rgt in H5;
+ rewrite H4 in H5; rewrite INR_IZR_INZ; assumption.
+unfold Rgt in H1; apply Rlt_le; assumption.
+unfold Rgt in |- *; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn.
+apply (le_O_IZR (up (/ eps - 1)));
+ apply (Rle_trans 0 (/ eps - 1) (IZR (up (/ eps - 1)))).
+generalize (Rnot_gt_le eps 1 b); clear b; unfold Rle in |- *; intro; elim H0;
+ clear H0; intro.
+left; unfold Rgt in H;
+ generalize (Rmult_lt_compat_l (/ eps) eps 1 (Rinv_0_lt_compat eps H) H0);
+ rewrite
+ (Rinv_l eps
+ (sym_not_eq (Rlt_dichotomy_converse 0 eps (or_introl (0 > eps) H))))
+ ; rewrite (let (H1, H2) := Rmult_ne (/ eps) in H1);
+ intro; fold (/ eps - 1 > 0) in |- *; apply Rgt_minus;
+ unfold Rgt in |- *; assumption.
+right; rewrite H0; rewrite Rinv_1; apply sym_eq; apply Rminus_diag_eq; auto.
+elim (archimed (/ eps - 1)); intros; clear H1; unfold Rgt in H0; apply Rlt_le;
+ assumption.
Qed.
-
diff --git a/theories/Reals/Rtrigo_reg.v b/theories/Reals/Rtrigo_reg.v
index 1155a05a0..ca0eb33dc 100644
--- a/theories/Reals/Rtrigo_reg.v
+++ b/theories/Reals/Rtrigo_reg.v
@@ -8,490 +8,601 @@
(*i $Id$ i*)
-Require Rbase.
-Require Rfunctions.
-Require SeqSeries.
-Require Rtrigo.
-Require Ranalysis1.
-Require PSeries_reg.
-V7only [Import nat_scope. Import Z_scope. Import R_scope.].
+Require Import Rbase.
+Require Import Rfunctions.
+Require Import SeqSeries.
+Require Import Rtrigo.
+Require Import Ranalysis1.
+Require Import PSeries_reg.
Open Local Scope nat_scope.
Open Local Scope R_scope.
-Lemma CVN_R_cos : (fn:nat->R->R) (fn == [N:nat][x:R]``(pow (-1) N)/(INR (fact (mult (S (S O)) N)))*(pow x (mult (S (S O)) N))``) -> (CVN_R fn).
-Unfold CVN_R; Intros.
-Cut (r::R)<>``0``.
-Intro hyp_r; Unfold CVN_r.
-Apply Specif.existT with [n:nat]``/(INR (fact (mult (S (S O)) n)))*(pow r (mult (S (S O)) n))``.
-Cut (SigT ? [l:R](Un_cv [n:nat](sum_f_R0 [k:nat](Rabsolu ``/(INR (fact (mult (S (S O)) k)))*(pow r (mult (S (S O)) k))``) n) l)).
-Intro; Elim X; Intros.
-Apply existTT with x.
-Split.
-Apply p.
-Intros; Rewrite H; Unfold Rdiv; Do 2 Rewrite Rabsolu_mult.
-Rewrite pow_1_abs; Rewrite Rmult_1l.
-Cut ``0</(INR (fact (mult (S (S O)) n)))``.
-Intro; Rewrite (Rabsolu_right ? (Rle_sym1 ? ? (Rlt_le ? ? H1))).
-Apply Rle_monotony.
-Left; Apply H1.
-Rewrite <- Pow_Rabsolu; Apply pow_maj_Rabs.
-Rewrite Rabsolu_Rabsolu.
-Unfold Boule in H0; Rewrite minus_R0 in H0.
-Left; Apply H0.
-Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Apply Alembert_C2.
-Intro; Apply Rabsolu_no_R0.
-Apply prod_neq_R0.
-Apply Rinv_neq_R0.
-Apply INR_fact_neq_0.
-Apply pow_nonzero; Assumption.
-Assert H0 := Alembert_cos.
-Unfold cos_n in H0; Unfold Un_cv in H0; Unfold Un_cv; Intros.
-Cut ``0<eps/(Rsqr r)``.
-Intro; Elim (H0 ? H2); Intros N0 H3.
-Exists N0; Intros.
-Unfold R_dist; Assert H5 := (H3 ? H4).
-Unfold R_dist in H5; Replace ``(Rabsolu ((Rabsolu (/(INR (fact (mult (S (S O)) (S n))))*(pow r (mult (S (S O)) (S n)))))/(Rabsolu (/(INR (fact (mult (S (S O)) n)))*(pow r (mult (S (S O)) n))))))`` with ``(Rsqr r)*(Rabsolu ((pow ( -1) (S n))/(INR (fact (mult (S (S O)) (S n))))/((pow ( -1) n)/(INR (fact (mult (S (S O)) n))))))``.
-Apply Rlt_monotony_contra with ``/(Rsqr r)``.
-Apply Rlt_Rinv; Apply Rsqr_pos_lt; Assumption.
-Pattern 1 ``/(Rsqr r)``; Replace ``/(Rsqr r)`` with ``(Rabsolu (/(Rsqr r)))``.
-Rewrite <- Rabsolu_mult; Rewrite Rminus_distr; Rewrite Rmult_Or; Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l; Rewrite <- (Rmult_sym eps); Apply H5.
-Unfold Rsqr; Apply prod_neq_R0; Assumption.
-Rewrite Rabsolu_Rinv.
-Rewrite Rabsolu_right.
-Reflexivity.
-Apply Rle_sym1; Apply pos_Rsqr.
-Unfold Rsqr; Apply prod_neq_R0; Assumption.
-Rewrite (Rmult_sym (Rsqr r)); Unfold Rdiv; Repeat Rewrite Rabsolu_mult; Rewrite Rabsolu_Rabsolu; Rewrite pow_1_abs; Rewrite Rmult_1l; Repeat Rewrite Rmult_assoc; Apply Rmult_mult_r.
-Rewrite Rabsolu_Rinv.
-Rewrite Rabsolu_mult; Rewrite (pow_1_abs n); Rewrite Rmult_1l; Rewrite <- Rabsolu_Rinv.
-Rewrite Rinv_Rinv.
-Rewrite Rinv_Rmult.
-Rewrite Rabsolu_Rinv.
-Rewrite Rinv_Rinv.
-Rewrite (Rmult_sym ``(Rabsolu (Rabsolu (pow r (mult (S (S O)) (S n)))))``); Rewrite Rabsolu_mult; Rewrite Rabsolu_Rabsolu; Rewrite Rmult_assoc; Apply Rmult_mult_r.
-Rewrite Rabsolu_Rinv.
-Do 2 Rewrite Rabsolu_Rabsolu; Repeat Rewrite Rabsolu_right.
-Replace ``(pow r (mult (S (S O)) (S n)))`` with ``(pow r (mult (S (S O)) n))*r*r``.
-Repeat Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
-Unfold Rsqr; Ring.
-Apply pow_nonzero; Assumption.
-Replace (mult (2) (S n)) with (S (S (mult (2) n))).
-Simpl; Ring.
-Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Apply Rle_sym1; Apply pow_le; Left; Apply (cond_pos r).
-Apply Rle_sym1; Apply pow_le; Left; Apply (cond_pos r).
-Apply Rabsolu_no_R0; Apply pow_nonzero; Assumption.
-Apply Rabsolu_no_R0; Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply Rabsolu_no_R0; Apply Rinv_neq_R0; Apply INR_fact_neq_0.
-Apply Rabsolu_no_R0; Apply pow_nonzero; Assumption.
-Apply INR_fact_neq_0.
-Apply Rinv_neq_R0; Apply INR_fact_neq_0.
-Apply prod_neq_R0.
-Apply pow_nonzero; DiscrR.
-Apply Rinv_neq_R0; Apply INR_fact_neq_0.
-Unfold Rdiv; Apply Rmult_lt_pos.
-Apply H1.
-Apply Rlt_Rinv; Apply Rsqr_pos_lt; Assumption.
-Assert H0 := (cond_pos r); Red; Intro; Rewrite H1 in H0; Elim (Rlt_antirefl ? H0).
+Lemma CVN_R_cos :
+ forall fn:nat -> R -> R,
+ fn = (fun (N:nat) (x:R) => (-1) ^ N / INR (fact (2 * N)) * x ^ (2 * N)) ->
+ CVN_R fn.
+unfold CVN_R in |- *; intros.
+cut ((r:R) <> 0).
+intro hyp_r; unfold CVN_r in |- *.
+apply existT with (fun n:nat => / INR (fact (2 * n)) * r ^ (2 * n)).
+cut
+ (sigT
+ (fun l:R =>
+ Un_cv
+ (fun n:nat =>
+ sum_f_R0 (fun k:nat => Rabs (/ INR (fact (2 * k)) * r ^ (2 * k)))
+ n) l)).
+intro; elim X; intros.
+apply existT with x.
+split.
+apply p.
+intros; rewrite H; unfold Rdiv in |- *; do 2 rewrite Rabs_mult.
+rewrite pow_1_abs; rewrite Rmult_1_l.
+cut (0 < / INR (fact (2 * n))).
+intro; rewrite (Rabs_right _ (Rle_ge _ _ (Rlt_le _ _ H1))).
+apply Rmult_le_compat_l.
+left; apply H1.
+rewrite <- RPow_abs; apply pow_maj_Rabs.
+rewrite Rabs_Rabsolu.
+unfold Boule in H0; rewrite Rminus_0_r in H0.
+left; apply H0.
+apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+apply Alembert_C2.
+intro; apply Rabs_no_R0.
+apply prod_neq_R0.
+apply Rinv_neq_0_compat.
+apply INR_fact_neq_0.
+apply pow_nonzero; assumption.
+assert (H0 := Alembert_cos).
+unfold cos_n in H0; unfold Un_cv in H0; unfold Un_cv in |- *; intros.
+cut (0 < eps / Rsqr r).
+intro; elim (H0 _ H2); intros N0 H3.
+exists N0; intros.
+unfold R_dist in |- *; assert (H5 := H3 _ H4).
+unfold R_dist in H5;
+ replace
+ (Rabs
+ (Rabs (/ INR (fact (2 * S n)) * r ^ (2 * S n)) /
+ Rabs (/ INR (fact (2 * n)) * r ^ (2 * n)))) with
+ (Rsqr r *
+ Rabs ((-1) ^ S n / INR (fact (2 * S n)) / ((-1) ^ n / INR (fact (2 * n))))).
+apply Rmult_lt_reg_l with (/ Rsqr r).
+apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption.
+pattern (/ Rsqr r) at 1 in |- *; replace (/ Rsqr r) with (Rabs (/ Rsqr r)).
+rewrite <- Rabs_mult; rewrite Rmult_minus_distr_l; rewrite Rmult_0_r;
+ rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
+rewrite Rmult_1_l; rewrite <- (Rmult_comm eps); apply H5.
+unfold Rsqr in |- *; apply prod_neq_R0; assumption.
+rewrite Rabs_Rinv.
+rewrite Rabs_right.
+reflexivity.
+apply Rle_ge; apply Rle_0_sqr.
+unfold Rsqr in |- *; apply prod_neq_R0; assumption.
+rewrite (Rmult_comm (Rsqr r)); unfold Rdiv in |- *; repeat rewrite Rabs_mult;
+ rewrite Rabs_Rabsolu; rewrite pow_1_abs; rewrite Rmult_1_l;
+ repeat rewrite Rmult_assoc; apply Rmult_eq_compat_l.
+rewrite Rabs_Rinv.
+rewrite Rabs_mult; rewrite (pow_1_abs n); rewrite Rmult_1_l;
+ rewrite <- Rabs_Rinv.
+rewrite Rinv_involutive.
+rewrite Rinv_mult_distr.
+rewrite Rabs_Rinv.
+rewrite Rinv_involutive.
+rewrite (Rmult_comm (Rabs (Rabs (r ^ (2 * S n))))); rewrite Rabs_mult;
+ rewrite Rabs_Rabsolu; rewrite Rmult_assoc; apply Rmult_eq_compat_l.
+rewrite Rabs_Rinv.
+do 2 rewrite Rabs_Rabsolu; repeat rewrite Rabs_right.
+replace (r ^ (2 * S n)) with (r ^ (2 * n) * r * r).
+repeat rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
+unfold Rsqr in |- *; ring.
+apply pow_nonzero; assumption.
+replace (2 * S n)%nat with (S (S (2 * n))).
+simpl in |- *; ring.
+apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR;
+ ring.
+apply Rle_ge; apply pow_le; left; apply (cond_pos r).
+apply Rle_ge; apply pow_le; left; apply (cond_pos r).
+apply Rabs_no_R0; apply pow_nonzero; assumption.
+apply Rabs_no_R0; apply INR_fact_neq_0.
+apply INR_fact_neq_0.
+apply Rabs_no_R0; apply Rinv_neq_0_compat; apply INR_fact_neq_0.
+apply Rabs_no_R0; apply pow_nonzero; assumption.
+apply INR_fact_neq_0.
+apply Rinv_neq_0_compat; apply INR_fact_neq_0.
+apply prod_neq_R0.
+apply pow_nonzero; discrR.
+apply Rinv_neq_0_compat; apply INR_fact_neq_0.
+unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+apply H1.
+apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption.
+assert (H0 := cond_pos r); red in |- *; intro; rewrite H1 in H0;
+ elim (Rlt_irrefl _ H0).
Qed.
(**********)
-Lemma continuity_cos : (continuity cos).
-Pose fn := [N:nat][x:R]``(pow (-1) N)/(INR (fact (mult (S (S O)) N)))*(pow x (mult (S (S O)) N))``.
-Cut (CVN_R fn).
-Intro; Cut (x:R)(sigTT ? [l:R](Un_cv [N:nat](SP fn N x) l)).
-Intro cv; Cut ((n:nat)(continuity (fn n))).
-Intro; Cut (x:R)(cos x)==(SFL fn cv x).
-Intro; Cut (continuity (SFL fn cv))->(continuity cos).
-Intro; Apply H1.
-Apply SFL_continuity; Assumption.
-Unfold continuity; Unfold continuity_pt; Unfold continue_in; Unfold limit1_in; Unfold limit_in; Simpl; Unfold R_dist; Intros.
-Elim (H1 x ? H2); Intros.
-Exists x0; Intros.
-Elim H3; Intros.
-Split.
-Apply H4.
-Intros; Rewrite (H0 x); Rewrite (H0 x1); Apply H5; Apply H6.
-Intro; Unfold cos SFL.
-Case (cv x); Case (exist_cos (Rsqr x)); Intros.
-Symmetry; EApply UL_sequence.
-Apply u.
-Unfold cos_in in c; Unfold infinit_sum in c; Unfold Un_cv; Intros.
-Elim (c ? H0); Intros N0 H1.
-Exists N0; Intros.
-Unfold R_dist in H1; Unfold R_dist SP.
-Replace (sum_f_R0 [k:nat](fn k x) n) with (sum_f_R0 [i:nat]``(cos_n i)*(pow (Rsqr x) i)`` n).
-Apply H1; Assumption.
-Apply sum_eq; Intros.
-Unfold cos_n fn; Apply Rmult_mult_r.
-Unfold Rsqr; Rewrite pow_sqr; Reflexivity.
-Intro; Unfold fn; Replace [x:R]``(pow ( -1) n)/(INR (fact (mult (S (S O)) n)))*(pow x (mult (S (S O)) n))`` with (mult_fct (fct_cte ``(pow ( -1) n)/(INR (fact (mult (S (S O)) n)))``) (pow_fct (mult (S (S O)) n))); [Idtac | Reflexivity].
-Apply continuity_mult.
-Apply derivable_continuous; Apply derivable_const.
-Apply derivable_continuous; Apply (derivable_pow (mult (2) n)).
-Apply CVN_R_CVS; Apply X.
-Apply CVN_R_cos; Unfold fn; Reflexivity.
+Lemma continuity_cos : continuity cos.
+pose (fn := fun (N:nat) (x:R) => (-1) ^ N / INR (fact (2 * N)) * x ^ (2 * N)).
+cut (CVN_R fn).
+intro; cut (forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l)).
+intro cv; cut (forall n:nat, continuity (fn n)).
+intro; cut (forall x:R, cos x = SFL fn cv x).
+intro; cut (continuity (SFL fn cv) -> continuity cos).
+intro; apply H1.
+apply SFL_continuity; assumption.
+unfold continuity in |- *; unfold continuity_pt in |- *;
+ unfold continue_in in |- *; unfold limit1_in in |- *;
+ unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *;
+ intros.
+elim (H1 x _ H2); intros.
+exists x0; intros.
+elim H3; intros.
+split.
+apply H4.
+intros; rewrite (H0 x); rewrite (H0 x1); apply H5; apply H6.
+intro; unfold cos, SFL in |- *.
+case (cv x); case (exist_cos (Rsqr x)); intros.
+symmetry in |- *; eapply UL_sequence.
+apply u.
+unfold cos_in in c; unfold infinit_sum in c; unfold Un_cv in |- *; intros.
+elim (c _ H0); intros N0 H1.
+exists N0; intros.
+unfold R_dist in H1; unfold R_dist, SP in |- *.
+replace (sum_f_R0 (fun k:nat => fn k x) n) with
+ (sum_f_R0 (fun i:nat => cos_n i * Rsqr x ^ i) n).
+apply H1; assumption.
+apply sum_eq; intros.
+unfold cos_n, fn in |- *; apply Rmult_eq_compat_l.
+unfold Rsqr in |- *; rewrite pow_sqr; reflexivity.
+intro; unfold fn in |- *;
+ replace (fun x:R => (-1) ^ n / INR (fact (2 * n)) * x ^ (2 * n)) with
+ (fct_cte ((-1) ^ n / INR (fact (2 * n))) * pow_fct (2 * n))%F;
+ [ idtac | reflexivity ].
+apply continuity_mult.
+apply derivable_continuous; apply derivable_const.
+apply derivable_continuous; apply (derivable_pow (2 * n)).
+apply CVN_R_CVS; apply X.
+apply CVN_R_cos; unfold fn in |- *; reflexivity.
Qed.
(**********)
-Lemma continuity_sin : (continuity sin).
-Unfold continuity; Intro.
-Assert H0 := (continuity_cos ``PI/2-x``).
-Unfold continuity_pt in H0; Unfold continue_in in H0; Unfold limit1_in in H0; Unfold limit_in in H0; Simpl in H0; Unfold R_dist in H0; Unfold continuity_pt; Unfold continue_in; Unfold limit1_in; Unfold limit_in; Simpl; Unfold R_dist; Intros.
-Elim (H0 ? H); Intros.
-Exists x0; Intros.
-Elim H1; Intros.
-Split.
-Assumption.
-Intros; Rewrite <- (cos_shift x); Rewrite <- (cos_shift x1); Apply H3.
-Elim H4; Intros.
-Split.
-Unfold D_x no_cond; Split.
-Trivial.
-Red; Intro; Unfold D_x no_cond in H5; Elim H5; Intros _ H8; Elim H8; Rewrite <- (Ropp_Ropp x); Rewrite <- (Ropp_Ropp x1); Apply eq_Ropp; Apply r_Rplus_plus with ``PI/2``; Apply H7.
-Replace ``PI/2-x1-(PI/2-x)`` with ``x-x1``; [Idtac | Ring]; Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr3; Apply H6.
+Lemma continuity_sin : continuity sin.
+unfold continuity in |- *; intro.
+assert (H0 := continuity_cos (PI / 2 - x)).
+unfold continuity_pt in H0; unfold continue_in in H0; unfold limit1_in in H0;
+ unfold limit_in in H0; simpl in H0; unfold R_dist in H0;
+ unfold continuity_pt in |- *; unfold continue_in in |- *;
+ unfold limit1_in in |- *; unfold limit_in in |- *;
+ simpl in |- *; unfold R_dist in |- *; intros.
+elim (H0 _ H); intros.
+exists x0; intros.
+elim H1; intros.
+split.
+assumption.
+intros; rewrite <- (cos_shift x); rewrite <- (cos_shift x1); apply H3.
+elim H4; intros.
+split.
+unfold D_x, no_cond in |- *; split.
+trivial.
+red in |- *; intro; unfold D_x, no_cond in H5; elim H5; intros _ H8; elim H8;
+ rewrite <- (Ropp_involutive x); rewrite <- (Ropp_involutive x1);
+ apply Ropp_eq_compat; apply Rplus_eq_reg_l with (PI / 2);
+ apply H7.
+replace (PI / 2 - x1 - (PI / 2 - x)) with (x - x1); [ idtac | ring ];
+ rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr'; apply H6.
Qed.
-Lemma CVN_R_sin : (fn:nat->R->R) (fn == [N:nat][x:R]``(pow ( -1) N)/(INR (fact (plus (mult (S (S O)) N) (S O))))*(pow x (mult (S (S O)) N))``) -> (CVN_R fn).
-Unfold CVN_R; Unfold CVN_r; Intros fn H r.
-Apply Specif.existT with [n:nat]``/(INR (fact (plus (mult (S (S O)) n) (S O))))*(pow r (mult (S (S O)) n))``.
-Cut (SigT ? [l:R](Un_cv [n:nat](sum_f_R0 [k:nat](Rabsolu ``/(INR (fact (plus (mult (S (S O)) k) (S O))))*(pow r (mult (S (S O)) k))``) n) l)).
-Intro; Elim X; Intros.
-Apply existTT with x.
-Split.
-Apply p.
-Intros; Rewrite H; Unfold Rdiv; Do 2 Rewrite Rabsolu_mult; Rewrite pow_1_abs; Rewrite Rmult_1l.
-Cut ``0</(INR (fact (plus (mult (S (S O)) n) (S O))))``.
-Intro; Rewrite (Rabsolu_right ? (Rle_sym1 ? ? (Rlt_le ? ? H1))).
-Apply Rle_monotony.
-Left; Apply H1.
-Rewrite <- Pow_Rabsolu; Apply pow_maj_Rabs.
-Rewrite Rabsolu_Rabsolu; Unfold Boule in H0; Rewrite minus_R0 in H0; Left; Apply H0.
-Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Cut (r::R)<>``0``.
-Intro; Apply Alembert_C2.
-Intro; Apply Rabsolu_no_R0.
-Apply prod_neq_R0.
-Apply Rinv_neq_R0; Apply INR_fact_neq_0.
-Apply pow_nonzero; Assumption.
-Assert H1 := Alembert_sin.
-Unfold sin_n in H1; Unfold Un_cv in H1; Unfold Un_cv; Intros.
-Cut ``0<eps/(Rsqr r)``.
-Intro; Elim (H1 ? H3); Intros N0 H4.
-Exists N0; Intros.
-Unfold R_dist; Assert H6 := (H4 ? H5).
-Unfold R_dist in H5; Replace ``(Rabsolu ((Rabsolu (/(INR (fact (plus (mult (S (S O)) (S n)) (S O))))*(pow r (mult (S (S O)) (S n)))))/(Rabsolu (/(INR (fact (plus (mult (S (S O)) n) (S O))))*(pow r (mult (S (S O)) n))))))`` with ``(Rsqr r)*(Rabsolu ((pow ( -1) (S n))/(INR (fact (plus (mult (S (S O)) (S n)) (S O))))/((pow ( -1) n)/(INR (fact (plus (mult (S (S O)) n) (S O)))))))``.
-Apply Rlt_monotony_contra with ``/(Rsqr r)``.
-Apply Rlt_Rinv; Apply Rsqr_pos_lt; Assumption.
-Pattern 1 ``/(Rsqr r)``; Rewrite <- (Rabsolu_right ``/(Rsqr r)``).
-Rewrite <- Rabsolu_mult.
-Rewrite Rminus_distr.
-Rewrite Rmult_Or; Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l; Rewrite <- (Rmult_sym eps).
-Apply H6.
-Unfold Rsqr; Apply prod_neq_R0; Assumption.
-Apply Rle_sym1; Left; Apply Rlt_Rinv; Apply Rsqr_pos_lt; Assumption.
-Unfold Rdiv; Rewrite (Rmult_sym (Rsqr r)); Repeat Rewrite Rabsolu_mult; Rewrite Rabsolu_Rabsolu; Rewrite pow_1_abs.
-Rewrite Rmult_1l.
-Repeat Rewrite Rmult_assoc; Apply Rmult_mult_r.
-Rewrite Rinv_Rmult.
-Rewrite Rinv_Rinv.
-Rewrite Rabsolu_mult.
-Rewrite Rabsolu_Rinv.
-Rewrite pow_1_abs; Rewrite Rinv_R1; Rewrite Rmult_1l.
-Rewrite Rinv_Rmult.
-Rewrite <- Rabsolu_Rinv.
-Rewrite Rinv_Rinv.
-Rewrite Rabsolu_mult.
-Do 2 Rewrite Rabsolu_Rabsolu.
-Rewrite (Rmult_sym ``(Rabsolu (pow r (mult (S (S O)) (S n))))``).
-Rewrite Rmult_assoc; Apply Rmult_mult_r.
-Rewrite Rabsolu_Rinv.
-Rewrite Rabsolu_Rabsolu.
-Repeat Rewrite Rabsolu_right.
-Replace ``(pow r (mult (S (S O)) (S n)))`` with ``(pow r (mult (S (S O)) n))*r*r``.
-Do 2 Rewrite <- Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Unfold Rsqr; Ring.
-Apply pow_nonzero; Assumption.
-Replace (mult (2) (S n)) with (S (S (mult (2) n))).
-Simpl; Ring.
-Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Apply Rle_sym1; Apply pow_le; Left; Apply (cond_pos r).
-Apply Rle_sym1; Apply pow_le; Left; Apply (cond_pos r).
-Apply Rabsolu_no_R0; Apply pow_nonzero; Assumption.
-Apply INR_fact_neq_0.
-Apply Rinv_neq_R0; Apply INR_fact_neq_0.
-Apply Rabsolu_no_R0; Apply Rinv_neq_R0; Apply INR_fact_neq_0.
-Apply Rabsolu_no_R0; Apply pow_nonzero; Assumption.
-Apply pow_nonzero; DiscrR.
-Apply INR_fact_neq_0.
-Apply pow_nonzero; DiscrR.
-Apply Rinv_neq_R0; Apply INR_fact_neq_0.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Apply Rsqr_pos_lt; Assumption].
-Assert H0 := (cond_pos r); Red; Intro; Rewrite H1 in H0; Elim (Rlt_antirefl ? H0).
+Lemma CVN_R_sin :
+ forall fn:nat -> R -> R,
+ fn =
+ (fun (N:nat) (x:R) => (-1) ^ N / INR (fact (2 * N + 1)) * x ^ (2 * N)) ->
+ CVN_R fn.
+unfold CVN_R in |- *; unfold CVN_r in |- *; intros fn H r.
+apply existT with (fun n:nat => / INR (fact (2 * n + 1)) * r ^ (2 * n)).
+cut
+ (sigT
+ (fun l:R =>
+ Un_cv
+ (fun n:nat =>
+ sum_f_R0
+ (fun k:nat => Rabs (/ INR (fact (2 * k + 1)) * r ^ (2 * k))) n)
+ l)).
+intro; elim X; intros.
+apply existT with x.
+split.
+apply p.
+intros; rewrite H; unfold Rdiv in |- *; do 2 rewrite Rabs_mult;
+ rewrite pow_1_abs; rewrite Rmult_1_l.
+cut (0 < / INR (fact (2 * n + 1))).
+intro; rewrite (Rabs_right _ (Rle_ge _ _ (Rlt_le _ _ H1))).
+apply Rmult_le_compat_l.
+left; apply H1.
+rewrite <- RPow_abs; apply pow_maj_Rabs.
+rewrite Rabs_Rabsolu; unfold Boule in H0; rewrite Rminus_0_r in H0; left;
+ apply H0.
+apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+cut ((r:R) <> 0).
+intro; apply Alembert_C2.
+intro; apply Rabs_no_R0.
+apply prod_neq_R0.
+apply Rinv_neq_0_compat; apply INR_fact_neq_0.
+apply pow_nonzero; assumption.
+assert (H1 := Alembert_sin).
+unfold sin_n in H1; unfold Un_cv in H1; unfold Un_cv in |- *; intros.
+cut (0 < eps / Rsqr r).
+intro; elim (H1 _ H3); intros N0 H4.
+exists N0; intros.
+unfold R_dist in |- *; assert (H6 := H4 _ H5).
+unfold R_dist in H5;
+ replace
+ (Rabs
+ (Rabs (/ INR (fact (2 * S n + 1)) * r ^ (2 * S n)) /
+ Rabs (/ INR (fact (2 * n + 1)) * r ^ (2 * n)))) with
+ (Rsqr r *
+ Rabs
+ ((-1) ^ S n / INR (fact (2 * S n + 1)) /
+ ((-1) ^ n / INR (fact (2 * n + 1))))).
+apply Rmult_lt_reg_l with (/ Rsqr r).
+apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption.
+pattern (/ Rsqr r) at 1 in |- *; rewrite <- (Rabs_right (/ Rsqr r)).
+rewrite <- Rabs_mult.
+rewrite Rmult_minus_distr_l.
+rewrite Rmult_0_r; rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
+rewrite Rmult_1_l; rewrite <- (Rmult_comm eps).
+apply H6.
+unfold Rsqr in |- *; apply prod_neq_R0; assumption.
+apply Rle_ge; left; apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption.
+unfold Rdiv in |- *; rewrite (Rmult_comm (Rsqr r)); repeat rewrite Rabs_mult;
+ rewrite Rabs_Rabsolu; rewrite pow_1_abs.
+rewrite Rmult_1_l.
+repeat rewrite Rmult_assoc; apply Rmult_eq_compat_l.
+rewrite Rinv_mult_distr.
+rewrite Rinv_involutive.
+rewrite Rabs_mult.
+rewrite Rabs_Rinv.
+rewrite pow_1_abs; rewrite Rinv_1; rewrite Rmult_1_l.
+rewrite Rinv_mult_distr.
+rewrite <- Rabs_Rinv.
+rewrite Rinv_involutive.
+rewrite Rabs_mult.
+do 2 rewrite Rabs_Rabsolu.
+rewrite (Rmult_comm (Rabs (r ^ (2 * S n)))).
+rewrite Rmult_assoc; apply Rmult_eq_compat_l.
+rewrite Rabs_Rinv.
+rewrite Rabs_Rabsolu.
+repeat rewrite Rabs_right.
+replace (r ^ (2 * S n)) with (r ^ (2 * n) * r * r).
+do 2 rewrite <- Rmult_assoc.
+rewrite <- Rinv_l_sym.
+unfold Rsqr in |- *; ring.
+apply pow_nonzero; assumption.
+replace (2 * S n)%nat with (S (S (2 * n))).
+simpl in |- *; ring.
+apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR;
+ ring.
+apply Rle_ge; apply pow_le; left; apply (cond_pos r).
+apply Rle_ge; apply pow_le; left; apply (cond_pos r).
+apply Rabs_no_R0; apply pow_nonzero; assumption.
+apply INR_fact_neq_0.
+apply Rinv_neq_0_compat; apply INR_fact_neq_0.
+apply Rabs_no_R0; apply Rinv_neq_0_compat; apply INR_fact_neq_0.
+apply Rabs_no_R0; apply pow_nonzero; assumption.
+apply pow_nonzero; discrR.
+apply INR_fact_neq_0.
+apply pow_nonzero; discrR.
+apply Rinv_neq_0_compat; apply INR_fact_neq_0.
+unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ assumption | apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption ].
+assert (H0 := cond_pos r); red in |- *; intro; rewrite H1 in H0;
+ elim (Rlt_irrefl _ H0).
Qed.
(* (sin h)/h -> 1 when h -> 0 *)
-Lemma derivable_pt_lim_sin_0 : (derivable_pt_lim sin R0 R1).
-Unfold derivable_pt_lim; Intros.
-Pose fn := [N:nat][x:R]``(pow ( -1) N)/(INR (fact (plus (mult (S (S O)) N) (S O))))*(pow x (mult (S (S O)) N))``.
-Cut (CVN_R fn).
-Intro; Cut (x:R)(sigTT ? [l:R](Un_cv [N:nat](SP fn N x) l)).
-Intro cv.
-Pose r := (mkposreal ? Rlt_R0_R1).
-Cut (CVN_r fn r).
-Intro; Cut ((n:nat; y:R)(Boule ``0`` r y)->(continuity_pt (fn n) y)).
-Intro; Cut (Boule R0 r R0).
-Intro; Assert H2 := (SFL_continuity_pt ? cv ? X0 H0 ? H1).
-Unfold continuity_pt in H2; Unfold continue_in in H2; Unfold limit1_in in H2; Unfold limit_in in H2; Simpl in H2; Unfold R_dist in H2.
-Elim (H2 ? H); Intros alp H3.
-Elim H3; Intros.
-Exists (mkposreal ? H4).
-Simpl; Intros.
-Rewrite sin_0; Rewrite Rplus_Ol; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or.
-Cut ``(Rabsolu ((SFL fn cv h)-(SFL fn cv 0))) < eps``.
-Intro; Cut (SFL fn cv R0)==R1.
-Intro; Cut (SFL fn cv h)==``(sin h)/h``.
-Intro; Rewrite H9 in H8; Rewrite H10 in H8.
-Apply H8.
-Unfold SFL sin.
-Case (cv h); Intros.
-Case (exist_sin (Rsqr h)); Intros.
-Unfold Rdiv; Rewrite (Rinv_r_simpl_m h x0 H6).
-EApply UL_sequence.
-Apply u.
-Unfold sin_in in s; Unfold sin_n infinit_sum in s; Unfold SP fn Un_cv; Intros.
-Elim (s ? H10); Intros N0 H11.
-Exists N0; Intros.
-Unfold R_dist; Unfold R_dist in H11.
-Replace (sum_f_R0 [k:nat]``(pow ( -1) k)/(INR (fact (plus (mult (S (S O)) k) (S O))))*(pow h (mult (S (S O)) k))`` n) with (sum_f_R0 [i:nat]``(pow ( -1) i)/(INR (fact (plus (mult (S (S O)) i) (S O))))*(pow (Rsqr h) i)`` n).
-Apply H11; Assumption.
-Apply sum_eq; Intros; Apply Rmult_mult_r; Unfold Rsqr; Rewrite pow_sqr; Reflexivity.
-Unfold SFL sin.
-Case (cv R0); Intros.
-EApply UL_sequence.
-Apply u.
-Unfold SP fn; Unfold Un_cv; Intros; Exists (S O); Intros.
-Unfold R_dist; Replace (sum_f_R0 [k:nat]``(pow ( -1) k)/(INR (fact (plus (mult (S (S O)) k) (S O))))*(pow 0 (mult (S (S O)) k))`` n) with R1.
-Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption.
-Rewrite decomp_sum.
-Simpl; Rewrite Rmult_1r; Unfold Rdiv; Rewrite Rinv_R1; Rewrite Rmult_1r; Pattern 1 R1; Rewrite <- Rplus_Or; Apply Rplus_plus_r.
-Symmetry; Apply sum_eq_R0; Intros.
-Rewrite Rmult_Ol; Rewrite Rmult_Or; Reflexivity.
-Unfold ge in H10; Apply lt_le_trans with (1); [Apply lt_n_Sn | Apply H10].
-Apply H5.
-Split.
-Unfold D_x no_cond; Split.
-Trivial.
-Apply not_sym; Apply H6.
-Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply H7.
-Unfold Boule; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_R0; Apply (cond_pos r).
-Intros; Unfold fn; Replace [x:R]``(pow ( -1) n)/(INR (fact (plus (mult (S (S O)) n) (S O))))*(pow x (mult (S (S O)) n))`` with (mult_fct (fct_cte ``(pow ( -1) n)/(INR (fact (plus (mult (S (S O)) n) (S O))))``) (pow_fct (mult (S (S O)) n))); [Idtac | Reflexivity].
-Apply continuity_pt_mult.
-Apply derivable_continuous_pt.
-Apply derivable_pt_const.
-Apply derivable_continuous_pt.
-Apply (derivable_pt_pow (mult (2) n) y).
-Apply (X r).
-Apply (CVN_R_CVS ? X).
-Apply CVN_R_sin; Unfold fn; Reflexivity.
+Lemma derivable_pt_lim_sin_0 : derivable_pt_lim sin 0 1.
+unfold derivable_pt_lim in |- *; intros.
+pose
+ (fn := fun (N:nat) (x:R) => (-1) ^ N / INR (fact (2 * N + 1)) * x ^ (2 * N)).
+cut (CVN_R fn).
+intro; cut (forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l)).
+intro cv.
+pose (r := mkposreal _ Rlt_0_1).
+cut (CVN_r fn r).
+intro; cut (forall (n:nat) (y:R), Boule 0 r y -> continuity_pt (fn n) y).
+intro; cut (Boule 0 r 0).
+intro; assert (H2 := SFL_continuity_pt _ cv _ X0 H0 _ H1).
+unfold continuity_pt in H2; unfold continue_in in H2; unfold limit1_in in H2;
+ unfold limit_in in H2; simpl in H2; unfold R_dist in H2.
+elim (H2 _ H); intros alp H3.
+elim H3; intros.
+exists (mkposreal _ H4).
+simpl in |- *; intros.
+rewrite sin_0; rewrite Rplus_0_l; unfold Rminus in |- *; rewrite Ropp_0;
+ rewrite Rplus_0_r.
+cut (Rabs (SFL fn cv h - SFL fn cv 0) < eps).
+intro; cut (SFL fn cv 0 = 1).
+intro; cut (SFL fn cv h = sin h / h).
+intro; rewrite H9 in H8; rewrite H10 in H8.
+apply H8.
+unfold SFL, sin in |- *.
+case (cv h); intros.
+case (exist_sin (Rsqr h)); intros.
+unfold Rdiv in |- *; rewrite (Rinv_r_simpl_m h x0 H6).
+eapply UL_sequence.
+apply u.
+unfold sin_in in s; unfold sin_n, infinit_sum in s;
+ unfold SP, fn, Un_cv in |- *; intros.
+elim (s _ H10); intros N0 H11.
+exists N0; intros.
+unfold R_dist in |- *; unfold R_dist in H11.
+replace
+ (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * h ^ (2 * k)) n)
+ with
+ (sum_f_R0 (fun i:nat => (-1) ^ i / INR (fact (2 * i + 1)) * Rsqr h ^ i) n).
+apply H11; assumption.
+apply sum_eq; intros; apply Rmult_eq_compat_l; unfold Rsqr in |- *;
+ rewrite pow_sqr; reflexivity.
+unfold SFL, sin in |- *.
+case (cv 0); intros.
+eapply UL_sequence.
+apply u.
+unfold SP, fn in |- *; unfold Un_cv in |- *; intros; exists 1%nat; intros.
+unfold R_dist in |- *;
+ replace
+ (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * 0 ^ (2 * k)) n)
+ with 1.
+unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption.
+rewrite decomp_sum.
+simpl in |- *; rewrite Rmult_1_r; unfold Rdiv in |- *; rewrite Rinv_1;
+ rewrite Rmult_1_r; pattern 1 at 1 in |- *; rewrite <- Rplus_0_r;
+ apply Rplus_eq_compat_l.
+symmetry in |- *; apply sum_eq_R0; intros.
+rewrite Rmult_0_l; rewrite Rmult_0_r; reflexivity.
+unfold ge in H10; apply lt_le_trans with 1%nat; [ apply lt_n_Sn | apply H10 ].
+apply H5.
+split.
+unfold D_x, no_cond in |- *; split.
+trivial.
+apply (sym_not_eq (A:=R)); apply H6.
+unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply H7.
+unfold Boule in |- *; unfold Rminus in |- *; rewrite Ropp_0;
+ rewrite Rplus_0_r; rewrite Rabs_R0; apply (cond_pos r).
+intros; unfold fn in |- *;
+ replace (fun x:R => (-1) ^ n / INR (fact (2 * n + 1)) * x ^ (2 * n)) with
+ (fct_cte ((-1) ^ n / INR (fact (2 * n + 1))) * pow_fct (2 * n))%F;
+ [ idtac | reflexivity ].
+apply continuity_pt_mult.
+apply derivable_continuous_pt.
+apply derivable_pt_const.
+apply derivable_continuous_pt.
+apply (derivable_pt_pow (2 * n) y).
+apply (X r).
+apply (CVN_R_CVS _ X).
+apply CVN_R_sin; unfold fn in |- *; reflexivity.
Qed.
(* ((cos h)-1)/h -> 0 when h -> 0 *)
-Lemma derivable_pt_lim_cos_0 : (derivable_pt_lim cos ``0`` ``0``).
-Unfold derivable_pt_lim; Intros.
-Assert H0 := derivable_pt_lim_sin_0.
-Unfold derivable_pt_lim in H0.
-Cut ``0<eps/2``.
-Intro; Elim (H0 ? H1); Intros del H2.
-Cut (continuity_pt sin ``0``).
-Intro; Unfold continuity_pt in H3; Unfold continue_in in H3; Unfold limit1_in in H3; Unfold limit_in in H3; Simpl in H3; Unfold R_dist in H3.
-Cut ``0<eps/2``; [Intro | Assumption].
-Elim (H3 ? H4); Intros del_c H5.
-Cut ``0<(Rmin del del_c)``.
-Intro; Pose delta := (mkposreal ? H6).
-Exists delta; Intros.
-Rewrite Rplus_Ol; Replace ``((cos h)-(cos 0))`` with ``-2*(Rsqr (sin (h/2)))``.
-Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or.
-Unfold Rdiv; Do 2 Rewrite Ropp_mul1.
-Rewrite Rabsolu_Ropp.
-Replace ``2*(Rsqr (sin (h*/2)))*/h`` with ``(sin (h/2))*((sin (h/2))/(h/2)-1)+(sin (h/2))``.
-Apply Rle_lt_trans with ``(Rabsolu ((sin (h/2))*((sin (h/2))/(h/2)-1)))+(Rabsolu ((sin (h/2))))``.
-Apply Rabsolu_triang.
-Rewrite (double_var eps); Apply Rplus_lt.
-Apply Rle_lt_trans with ``(Rabsolu ((sin (h/2))/(h/2)-1))``.
-Rewrite Rabsolu_mult; Rewrite Rmult_sym; Pattern 2 ``(Rabsolu ((sin (h/2))/(h/2)-1))``; Rewrite <- Rmult_1r; Apply Rle_monotony.
-Apply Rabsolu_pos.
-Assert H9 := (SIN_bound ``h/2``).
-Unfold Rabsolu; Case (case_Rabsolu ``(sin (h/2))``); Intro.
-Pattern 3 R1; Rewrite <- (Ropp_Ropp ``1``).
-Apply Rle_Ropp1.
-Elim H9; Intros; Assumption.
-Elim H9; Intros; Assumption.
-Cut ``(Rabsolu (h/2))<del``.
-Intro; Cut ``h/2<>0``.
-Intro; Assert H11 := (H2 ? H10 H9).
-Rewrite Rplus_Ol in H11; Rewrite sin_0 in H11.
-Rewrite minus_R0 in H11; Apply H11.
-Unfold Rdiv; Apply prod_neq_R0.
-Apply H7.
-Apply Rinv_neq_R0; DiscrR.
-Apply Rlt_trans with ``del/2``.
-Unfold Rdiv; Rewrite Rabsolu_mult.
-Rewrite (Rabsolu_right ``/2``).
-Do 2 Rewrite <- (Rmult_sym ``/2``); Apply Rlt_monotony.
-Apply Rlt_Rinv; Sup0.
-Apply Rlt_le_trans with (pos delta).
-Apply H8.
-Unfold delta; Simpl; Apply Rmin_l.
-Apply Rle_sym1; Left; Apply Rlt_Rinv; Sup0.
-Rewrite <- (Rplus_Or ``del/2``); Pattern 1 del; Rewrite (double_var del); Apply Rlt_compatibility; Unfold Rdiv; Apply Rmult_lt_pos.
-Apply (cond_pos del).
-Apply Rlt_Rinv; Sup0.
-Elim H5; Intros; Assert H11 := (H10 ``h/2``).
-Rewrite sin_0 in H11; Do 2 Rewrite minus_R0 in H11.
-Apply H11.
-Split.
-Unfold D_x no_cond; Split.
-Trivial.
-Apply not_sym; Unfold Rdiv; Apply prod_neq_R0.
-Apply H7.
-Apply Rinv_neq_R0; DiscrR.
-Apply Rlt_trans with ``del_c/2``.
-Unfold Rdiv; Rewrite Rabsolu_mult.
-Rewrite (Rabsolu_right ``/2``).
-Do 2 Rewrite <- (Rmult_sym ``/2``).
-Apply Rlt_monotony.
-Apply Rlt_Rinv; Sup0.
-Apply Rlt_le_trans with (pos delta).
-Apply H8.
-Unfold delta; Simpl; Apply Rmin_r.
-Apply Rle_sym1; Left; Apply Rlt_Rinv; Sup0.
-Rewrite <- (Rplus_Or ``del_c/2``); Pattern 2 del_c; Rewrite (double_var del_c); Apply Rlt_compatibility.
-Unfold Rdiv; Apply Rmult_lt_pos.
-Apply H9.
-Apply Rlt_Rinv; Sup0.
-Rewrite Rminus_distr; Rewrite Rmult_1r; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Rewrite (Rmult_sym ``2``); Unfold Rdiv Rsqr.
-Repeat Rewrite Rmult_assoc.
-Repeat Apply Rmult_mult_r.
-Rewrite Rinv_Rmult.
-Rewrite Rinv_Rinv.
-Apply Rmult_sym.
-DiscrR.
-Apply H7.
-Apply Rinv_neq_R0; DiscrR.
-Pattern 2 h; Replace h with ``2*(h/2)``.
-Rewrite (cos_2a_sin ``h/2``).
-Rewrite cos_0; Unfold Rsqr; Ring.
-Unfold Rdiv; Rewrite <- Rmult_assoc; Apply Rinv_r_simpl_m.
-DiscrR.
-Unfold Rmin; Case (total_order_Rle del del_c); Intro.
-Apply (cond_pos del).
-Elim H5; Intros; Assumption.
-Apply continuity_sin.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
+Lemma derivable_pt_lim_cos_0 : derivable_pt_lim cos 0 0.
+unfold derivable_pt_lim in |- *; intros.
+assert (H0 := derivable_pt_lim_sin_0).
+unfold derivable_pt_lim in H0.
+cut (0 < eps / 2).
+intro; elim (H0 _ H1); intros del H2.
+cut (continuity_pt sin 0).
+intro; unfold continuity_pt in H3; unfold continue_in in H3;
+ unfold limit1_in in H3; unfold limit_in in H3; simpl in H3;
+ unfold R_dist in H3.
+cut (0 < eps / 2); [ intro | assumption ].
+elim (H3 _ H4); intros del_c H5.
+cut (0 < Rmin del del_c).
+intro; pose (delta := mkposreal _ H6).
+exists delta; intros.
+rewrite Rplus_0_l; replace (cos h - cos 0) with (-2 * Rsqr (sin (h / 2))).
+unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r.
+unfold Rdiv in |- *; do 2 rewrite Ropp_mult_distr_l_reverse.
+rewrite Rabs_Ropp.
+replace (2 * Rsqr (sin (h * / 2)) * / h) with
+ (sin (h / 2) * (sin (h / 2) / (h / 2) - 1) + sin (h / 2)).
+apply Rle_lt_trans with
+ (Rabs (sin (h / 2) * (sin (h / 2) / (h / 2) - 1)) + Rabs (sin (h / 2))).
+apply Rabs_triang.
+rewrite (double_var eps); apply Rplus_lt_compat.
+apply Rle_lt_trans with (Rabs (sin (h / 2) / (h / 2) - 1)).
+rewrite Rabs_mult; rewrite Rmult_comm;
+ pattern (Rabs (sin (h / 2) / (h / 2) - 1)) at 2 in |- *;
+ rewrite <- Rmult_1_r; apply Rmult_le_compat_l.
+apply Rabs_pos.
+assert (H9 := SIN_bound (h / 2)).
+unfold Rabs in |- *; case (Rcase_abs (sin (h / 2))); intro.
+pattern 1 at 3 in |- *; rewrite <- (Ropp_involutive 1).
+apply Ropp_le_contravar.
+elim H9; intros; assumption.
+elim H9; intros; assumption.
+cut (Rabs (h / 2) < del).
+intro; cut (h / 2 <> 0).
+intro; assert (H11 := H2 _ H10 H9).
+rewrite Rplus_0_l in H11; rewrite sin_0 in H11.
+rewrite Rminus_0_r in H11; apply H11.
+unfold Rdiv in |- *; apply prod_neq_R0.
+apply H7.
+apply Rinv_neq_0_compat; discrR.
+apply Rlt_trans with (del / 2).
+unfold Rdiv in |- *; rewrite Rabs_mult.
+rewrite (Rabs_right (/ 2)).
+do 2 rewrite <- (Rmult_comm (/ 2)); apply Rmult_lt_compat_l.
+apply Rinv_0_lt_compat; prove_sup0.
+apply Rlt_le_trans with (pos delta).
+apply H8.
+unfold delta in |- *; simpl in |- *; apply Rmin_l.
+apply Rle_ge; left; apply Rinv_0_lt_compat; prove_sup0.
+rewrite <- (Rplus_0_r (del / 2)); pattern del at 1 in |- *;
+ rewrite (double_var del); apply Rplus_lt_compat_l;
+ unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+apply (cond_pos del).
+apply Rinv_0_lt_compat; prove_sup0.
+elim H5; intros; assert (H11 := H10 (h / 2)).
+rewrite sin_0 in H11; do 2 rewrite Rminus_0_r in H11.
+apply H11.
+split.
+unfold D_x, no_cond in |- *; split.
+trivial.
+apply (sym_not_eq (A:=R)); unfold Rdiv in |- *; apply prod_neq_R0.
+apply H7.
+apply Rinv_neq_0_compat; discrR.
+apply Rlt_trans with (del_c / 2).
+unfold Rdiv in |- *; rewrite Rabs_mult.
+rewrite (Rabs_right (/ 2)).
+do 2 rewrite <- (Rmult_comm (/ 2)).
+apply Rmult_lt_compat_l.
+apply Rinv_0_lt_compat; prove_sup0.
+apply Rlt_le_trans with (pos delta).
+apply H8.
+unfold delta in |- *; simpl in |- *; apply Rmin_r.
+apply Rle_ge; left; apply Rinv_0_lt_compat; prove_sup0.
+rewrite <- (Rplus_0_r (del_c / 2)); pattern del_c at 2 in |- *;
+ rewrite (double_var del_c); apply Rplus_lt_compat_l.
+unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+apply H9.
+apply Rinv_0_lt_compat; prove_sup0.
+rewrite Rmult_minus_distr_l; rewrite Rmult_1_r; unfold Rminus in |- *;
+ rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r;
+ rewrite (Rmult_comm 2); unfold Rdiv, Rsqr in |- *.
+repeat rewrite Rmult_assoc.
+repeat apply Rmult_eq_compat_l.
+rewrite Rinv_mult_distr.
+rewrite Rinv_involutive.
+apply Rmult_comm.
+discrR.
+apply H7.
+apply Rinv_neq_0_compat; discrR.
+pattern h at 2 in |- *; replace h with (2 * (h / 2)).
+rewrite (cos_2a_sin (h / 2)).
+rewrite cos_0; unfold Rsqr in |- *; ring.
+unfold Rdiv in |- *; rewrite <- Rmult_assoc; apply Rinv_r_simpl_m.
+discrR.
+unfold Rmin in |- *; case (Rle_dec del del_c); intro.
+apply (cond_pos del).
+elim H5; intros; assumption.
+apply continuity_sin.
+unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
Qed.
(**********)
-Theorem derivable_pt_lim_sin : (x:R)(derivable_pt_lim sin x (cos x)).
-Intro; Assert H0 := derivable_pt_lim_sin_0.
-Assert H := derivable_pt_lim_cos_0.
-Unfold derivable_pt_lim in H0 H.
-Unfold derivable_pt_lim; Intros.
-Cut ``0<eps/2``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Apply H1 | Apply Rlt_Rinv; Sup0]].
-Elim (H0 ? H2); Intros alp1 H3.
-Elim (H ? H2); Intros alp2 H4.
-Pose alp := (Rmin alp1 alp2).
-Cut ``0<alp``.
-Intro; Exists (mkposreal ? H5); Intros.
-Replace ``((sin (x+h))-(sin x))/h-(cos x)`` with ``(sin x)*((cos h)-1)/h+(cos x)*((sin h)/h-1)``.
-Apply Rle_lt_trans with ``(Rabsolu ((sin x)*((cos h)-1)/h))+(Rabsolu ((cos x)*((sin h)/h-1)))``.
-Apply Rabsolu_triang.
-Rewrite (double_var eps); Apply Rplus_lt.
-Apply Rle_lt_trans with ``(Rabsolu ((cos h)-1)/h)``.
-Rewrite Rabsolu_mult; Rewrite Rmult_sym; Pattern 2 ``(Rabsolu (((cos h)-1)/h))``; Rewrite <- Rmult_1r; Apply Rle_monotony.
-Apply Rabsolu_pos.
-Assert H8 := (SIN_bound x); Elim H8; Intros.
-Unfold Rabsolu; Case (case_Rabsolu (sin x)); Intro.
-Rewrite <- (Ropp_Ropp R1).
-Apply Rle_Ropp1; Assumption.
-Assumption.
-Cut ``(Rabsolu h)<alp2``.
-Intro; Assert H9 := (H4 ? H6 H8).
-Rewrite cos_0 in H9; Rewrite Rplus_Ol in H9; Rewrite minus_R0 in H9; Apply H9.
-Apply Rlt_le_trans with alp.
-Apply H7.
-Unfold alp; Apply Rmin_r.
-Apply Rle_lt_trans with ``(Rabsolu ((sin h)/h-1))``.
-Rewrite Rabsolu_mult; Rewrite Rmult_sym; Pattern 2 ``(Rabsolu ((sin h)/h-1))``; Rewrite <- Rmult_1r; Apply Rle_monotony.
-Apply Rabsolu_pos.
-Assert H8 := (COS_bound x); Elim H8; Intros.
-Unfold Rabsolu; Case (case_Rabsolu (cos x)); Intro.
-Rewrite <- (Ropp_Ropp R1); Apply Rle_Ropp1; Assumption.
-Assumption.
-Cut ``(Rabsolu h)<alp1``.
-Intro; Assert H9 := (H3 ? H6 H8).
-Rewrite sin_0 in H9; Rewrite Rplus_Ol in H9; Rewrite minus_R0 in H9; Apply H9.
-Apply Rlt_le_trans with alp.
-Apply H7.
-Unfold alp; Apply Rmin_l.
-Rewrite sin_plus; Unfold Rminus Rdiv; Repeat Rewrite Rmult_Rplus_distrl; Repeat Rewrite Rmult_Rplus_distr; Repeat Rewrite Rmult_assoc; Repeat Rewrite Rplus_assoc; Apply Rplus_plus_r.
-Rewrite (Rplus_sym ``(sin x)*( -1*/h)``); Repeat Rewrite Rplus_assoc; Apply Rplus_plus_r.
-Rewrite Ropp_mul3; Rewrite Ropp_mul1; Rewrite Rmult_1r; Rewrite Rmult_1l; Rewrite Ropp_mul3; Rewrite <- Ropp_mul1; Apply Rplus_sym.
-Unfold alp; Unfold Rmin; Case (total_order_Rle alp1 alp2); Intro.
-Apply (cond_pos alp1).
-Apply (cond_pos alp2).
+Theorem derivable_pt_lim_sin : forall x:R, derivable_pt_lim sin x (cos x).
+intro; assert (H0 := derivable_pt_lim_sin_0).
+assert (H := derivable_pt_lim_cos_0).
+unfold derivable_pt_lim in H0, H.
+unfold derivable_pt_lim in |- *; intros.
+cut (0 < eps / 2);
+ [ intro
+ | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ apply H1 | apply Rinv_0_lt_compat; prove_sup0 ] ].
+elim (H0 _ H2); intros alp1 H3.
+elim (H _ H2); intros alp2 H4.
+pose (alp := Rmin alp1 alp2).
+cut (0 < alp).
+intro; exists (mkposreal _ H5); intros.
+replace ((sin (x + h) - sin x) / h - cos x) with
+ (sin x * ((cos h - 1) / h) + cos x * (sin h / h - 1)).
+apply Rle_lt_trans with
+ (Rabs (sin x * ((cos h - 1) / h)) + Rabs (cos x * (sin h / h - 1))).
+apply Rabs_triang.
+rewrite (double_var eps); apply Rplus_lt_compat.
+apply Rle_lt_trans with (Rabs ((cos h - 1) / h)).
+rewrite Rabs_mult; rewrite Rmult_comm;
+ pattern (Rabs ((cos h - 1) / h)) at 2 in |- *; rewrite <- Rmult_1_r;
+ apply Rmult_le_compat_l.
+apply Rabs_pos.
+assert (H8 := SIN_bound x); elim H8; intros.
+unfold Rabs in |- *; case (Rcase_abs (sin x)); intro.
+rewrite <- (Ropp_involutive 1).
+apply Ropp_le_contravar; assumption.
+assumption.
+cut (Rabs h < alp2).
+intro; assert (H9 := H4 _ H6 H8).
+rewrite cos_0 in H9; rewrite Rplus_0_l in H9; rewrite Rminus_0_r in H9;
+ apply H9.
+apply Rlt_le_trans with alp.
+apply H7.
+unfold alp in |- *; apply Rmin_r.
+apply Rle_lt_trans with (Rabs (sin h / h - 1)).
+rewrite Rabs_mult; rewrite Rmult_comm;
+ pattern (Rabs (sin h / h - 1)) at 2 in |- *; rewrite <- Rmult_1_r;
+ apply Rmult_le_compat_l.
+apply Rabs_pos.
+assert (H8 := COS_bound x); elim H8; intros.
+unfold Rabs in |- *; case (Rcase_abs (cos x)); intro.
+rewrite <- (Ropp_involutive 1); apply Ropp_le_contravar; assumption.
+assumption.
+cut (Rabs h < alp1).
+intro; assert (H9 := H3 _ H6 H8).
+rewrite sin_0 in H9; rewrite Rplus_0_l in H9; rewrite Rminus_0_r in H9;
+ apply H9.
+apply Rlt_le_trans with alp.
+apply H7.
+unfold alp in |- *; apply Rmin_l.
+rewrite sin_plus; unfold Rminus, Rdiv in |- *;
+ repeat rewrite Rmult_plus_distr_r; repeat rewrite Rmult_plus_distr_l;
+ repeat rewrite Rmult_assoc; repeat rewrite Rplus_assoc;
+ apply Rplus_eq_compat_l.
+rewrite (Rplus_comm (sin x * (-1 * / h))); repeat rewrite Rplus_assoc;
+ apply Rplus_eq_compat_l.
+rewrite Ropp_mult_distr_r_reverse; rewrite Ropp_mult_distr_l_reverse;
+ rewrite Rmult_1_r; rewrite Rmult_1_l; rewrite Ropp_mult_distr_r_reverse;
+ rewrite <- Ropp_mult_distr_l_reverse; apply Rplus_comm.
+unfold alp in |- *; unfold Rmin in |- *; case (Rle_dec alp1 alp2); intro.
+apply (cond_pos alp1).
+apply (cond_pos alp2).
Qed.
-Lemma derivable_pt_lim_cos : (x:R) (derivable_pt_lim cos x ``-(sin x)``).
-Intro; Cut (h:R)``(sin (h+PI/2))``==(cos h).
-Intro; Replace ``-(sin x)`` with (Rmult (cos ``x+PI/2``) (Rplus R1 R0)).
-Generalize (derivable_pt_lim_comp (plus_fct id (fct_cte ``PI/2``)) sin); Intros.
-Cut (derivable_pt_lim (plus_fct id (fct_cte ``PI/2``)) x ``1+0``).
-Cut (derivable_pt_lim sin (plus_fct id (fct_cte ``PI/2``) x) ``(cos (x+PI/2))``).
-Intros; Generalize (H0 ? ? ? H2 H1); Replace (comp sin (plus_fct id (fct_cte ``PI/2``))) with [x:R]``(sin (x+PI/2))``; [Idtac | Reflexivity].
-Unfold derivable_pt_lim; Intros.
-Elim (H3 eps H4); Intros.
-Exists x0.
-Intros; Rewrite <- (H ``x+h``); Rewrite <- (H x); Apply H5; Assumption.
-Apply derivable_pt_lim_sin.
-Apply derivable_pt_lim_plus.
-Apply derivable_pt_lim_id.
-Apply derivable_pt_lim_const.
-Rewrite sin_cos; Rewrite <- (Rplus_sym x); Ring.
-Intro; Rewrite cos_sin; Rewrite Rplus_sym; Reflexivity.
+Lemma derivable_pt_lim_cos : forall x:R, derivable_pt_lim cos x (- sin x).
+intro; cut (forall h:R, sin (h + PI / 2) = cos h).
+intro; replace (- sin x) with (cos (x + PI / 2) * (1 + 0)).
+generalize (derivable_pt_lim_comp (id + fct_cte (PI / 2))%F sin); intros.
+cut (derivable_pt_lim (id + fct_cte (PI / 2)) x (1 + 0)).
+cut (derivable_pt_lim sin ((id + fct_cte (PI / 2))%F x) (cos (x + PI / 2))).
+intros; generalize (H0 _ _ _ H2 H1);
+ replace (comp sin (id + fct_cte (PI / 2))%F) with
+ (fun x:R => sin (x + PI / 2)); [ idtac | reflexivity ].
+unfold derivable_pt_lim in |- *; intros.
+elim (H3 eps H4); intros.
+exists x0.
+intros; rewrite <- (H (x + h)); rewrite <- (H x); apply H5; assumption.
+apply derivable_pt_lim_sin.
+apply derivable_pt_lim_plus.
+apply derivable_pt_lim_id.
+apply derivable_pt_lim_const.
+rewrite sin_cos; rewrite <- (Rplus_comm x); ring.
+intro; rewrite cos_sin; rewrite Rplus_comm; reflexivity.
Qed.
-Lemma derivable_pt_sin : (x:R) (derivable_pt sin x).
-Unfold derivable_pt; Intro.
-Apply Specif.existT with (cos x).
-Apply derivable_pt_lim_sin.
+Lemma derivable_pt_sin : forall x:R, derivable_pt sin x.
+unfold derivable_pt in |- *; intro.
+apply existT with (cos x).
+apply derivable_pt_lim_sin.
Qed.
-Lemma derivable_pt_cos : (x:R) (derivable_pt cos x).
-Unfold derivable_pt; Intro.
-Apply Specif.existT with ``-(sin x)``.
-Apply derivable_pt_lim_cos.
+Lemma derivable_pt_cos : forall x:R, derivable_pt cos x.
+unfold derivable_pt in |- *; intro.
+apply existT with (- sin x).
+apply derivable_pt_lim_cos.
Qed.
-Lemma derivable_sin : (derivable sin).
-Unfold derivable; Intro; Apply derivable_pt_sin.
+Lemma derivable_sin : derivable sin.
+unfold derivable in |- *; intro; apply derivable_pt_sin.
Qed.
-Lemma derivable_cos : (derivable cos).
-Unfold derivable; Intro; Apply derivable_pt_cos.
+Lemma derivable_cos : derivable cos.
+unfold derivable in |- *; intro; apply derivable_pt_cos.
Qed.
-Lemma derive_pt_sin : (x:R) ``(derive_pt sin x (derivable_pt_sin ?))==(cos x)``.
-Intros; Apply derive_pt_eq_0.
-Apply derivable_pt_lim_sin.
+Lemma derive_pt_sin :
+ forall x:R, derive_pt sin x (derivable_pt_sin _) = cos x.
+intros; apply derive_pt_eq_0.
+apply derivable_pt_lim_sin.
Qed.
-Lemma derive_pt_cos : (x:R) ``(derive_pt cos x (derivable_pt_cos ?))==-(sin x)``.
-Intros; Apply derive_pt_eq_0.
-Apply derivable_pt_lim_cos.
-Qed.
+Lemma derive_pt_cos :
+ forall x:R, derive_pt cos x (derivable_pt_cos _) = - sin x.
+intros; apply derive_pt_eq_0.
+apply derivable_pt_lim_cos.
+Qed. \ No newline at end of file
diff --git a/theories/Reals/SeqProp.v b/theories/Reals/SeqProp.v
index 7bd6b8a47..1175543b6 100644
--- a/theories/Reals/SeqProp.v
+++ b/theories/Reals/SeqProp.v
@@ -8,1082 +8,1288 @@
(*i $Id$ i*)
-Require Rbase.
-Require Rfunctions.
-Require Rseries.
-Require Classical.
-Require Max.
-V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
+Require Import Rbase.
+Require Import Rfunctions.
+Require Import Rseries.
+Require Import Classical.
+Require Import Max.
Open Local Scope R_scope.
-Definition Un_decreasing [Un:nat->R] : Prop := (n:nat) (Rle (Un (S n)) (Un n)).
-Definition opp_seq [Un:nat->R] : nat->R := [n:nat]``-(Un n)``.
-Definition has_ub [Un:nat->R] : Prop := (bound (EUn Un)).
-Definition has_lb [Un:nat->R] : Prop := (bound (EUn (opp_seq Un))).
+Definition Un_decreasing (Un:nat -> R) : Prop :=
+ forall n:nat, Un (S n) <= Un n.
+Definition opp_seq (Un:nat -> R) (n:nat) : R := - Un n.
+Definition has_ub (Un:nat -> R) : Prop := bound (EUn Un).
+Definition has_lb (Un:nat -> R) : Prop := bound (EUn (opp_seq Un)).
(**********)
-Lemma growing_cv : (Un:nat->R) (Un_growing Un) -> (has_ub Un) -> (sigTT R [l:R](Un_cv Un l)).
-Unfold Un_growing Un_cv;Intros;
- NewDestruct (complet (EUn Un) H0 (EUn_noempty Un)) as [x [H2 H3]].
- Exists x;Intros eps H1.
- Unfold is_upper_bound in H2 H3.
-Assert H5:(n:nat)(Rle (Un n) x).
- Intro n; Apply (H2 (Un n) (Un_in_EUn Un n)).
-Cut (Ex [N:nat] (Rlt (Rminus x eps) (Un N))).
-Intro H6;NewDestruct H6 as [N H6];Exists N.
-Intros n H7;Unfold R_dist;Apply (Rabsolu_def1 (Rminus (Un n) x) eps).
-Unfold Rgt in H1.
- Apply (Rle_lt_trans (Rminus (Un n) x) R0 eps
- (Rle_minus (Un n) x (H5 n)) H1).
-Fold Un_growing in H;Generalize (growing_prop Un n N H H7);Intro H8.
- Generalize (Rlt_le_trans (Rminus x eps) (Un N) (Un n) H6
- (Rle_sym2 (Un N) (Un n) H8));Intro H9;
- Generalize (Rlt_compatibility (Ropp x) (Rminus x eps) (Un n) H9);
- Unfold Rminus;Rewrite <-(Rplus_assoc (Ropp x) x (Ropp eps));
- Rewrite (Rplus_sym (Ropp x) (Un n));Fold (Rminus (Un n) x);
- Rewrite Rplus_Ropp_l;Rewrite (let (H1,H2)=(Rplus_ne (Ropp eps)) in H2);
- Trivial.
-Cut ~((N:nat)(Rle (Un N) (Rminus x eps))).
-Intro H6;Apply (not_all_not_ex nat ([N:nat](Rlt (Rminus x eps) (Un N)))).
- Intro H7; Apply H6; Intro N; Apply Rnot_lt_le; Apply H7.
-Intro H7;Generalize (Un_bound_imp Un (Rminus x eps) H7);Intro H8;
- Unfold is_upper_bound in H8;Generalize (H3 (Rminus x eps) H8);
- Apply Rlt_le_not; Apply tech_Rgt_minus; Exact H1.
+Lemma growing_cv :
+ forall Un:nat -> R,
+ Un_growing Un -> has_ub Un -> sigT (fun l:R => Un_cv Un l).
+unfold Un_growing, Un_cv in |- *; intros;
+ destruct (completeness (EUn Un) H0 (EUn_noempty Un)) as [x [H2 H3]].
+ exists x; intros eps H1.
+ unfold is_upper_bound in H2, H3.
+assert (H5 : forall n:nat, Un n <= x).
+ intro n; apply (H2 (Un n) (Un_in_EUn Un n)).
+cut ( exists N : nat | x - eps < Un N).
+intro H6; destruct H6 as [N H6]; exists N.
+intros n H7; unfold R_dist in |- *; apply (Rabs_def1 (Un n - x) eps).
+unfold Rgt in H1.
+ apply (Rle_lt_trans (Un n - x) 0 eps (Rle_minus (Un n) x (H5 n)) H1).
+fold Un_growing in H; generalize (growing_prop Un n N H H7); intro H8.
+ generalize
+ (Rlt_le_trans (x - eps) (Un N) (Un n) H6 (Rge_le (Un n) (Un N) H8));
+ intro H9; generalize (Rplus_lt_compat_l (- x) (x - eps) (Un n) H9);
+ unfold Rminus in |- *; rewrite <- (Rplus_assoc (- x) x (- eps));
+ rewrite (Rplus_comm (- x) (Un n)); fold (Un n - x) in |- *;
+ rewrite Rplus_opp_l; rewrite (let (H1, H2) := Rplus_ne (- eps) in H2);
+ trivial.
+cut (~ (forall N:nat, Un N <= x - eps)).
+intro H6; apply (not_all_not_ex nat (fun N:nat => x - eps < Un N)).
+ intro H7; apply H6; intro N; apply Rnot_lt_le; apply H7.
+intro H7; generalize (Un_bound_imp Un (x - eps) H7); intro H8;
+ unfold is_upper_bound in H8; generalize (H3 (x - eps) H8);
+ apply Rlt_not_le; apply tech_Rgt_minus; exact H1.
Qed.
-Lemma decreasing_growing : (Un:nat->R) (Un_decreasing Un) -> (Un_growing (opp_seq Un)).
-Intro.
-Unfold Un_growing opp_seq Un_decreasing.
-Intros.
-Apply Rle_Ropp1.
-Apply H.
+Lemma decreasing_growing :
+ forall Un:nat -> R, Un_decreasing Un -> Un_growing (opp_seq Un).
+intro.
+unfold Un_growing, opp_seq, Un_decreasing in |- *.
+intros.
+apply Ropp_le_contravar.
+apply H.
Qed.
-Lemma decreasing_cv : (Un:nat->R) (Un_decreasing Un) -> (has_lb Un) -> (sigTT R [l:R](Un_cv Un l)).
-Intros.
-Cut (sigTT R [l:R](Un_cv (opp_seq Un) l)) -> (sigTT R [l:R](Un_cv Un l)).
-Intro.
-Apply X.
-Apply growing_cv.
-Apply decreasing_growing; Assumption.
-Exact H0.
-Intro.
-Elim X; Intros.
-Apply existTT with ``-x``.
-Unfold Un_cv in p.
-Unfold R_dist in p.
-Unfold opp_seq in p.
-Unfold Un_cv.
-Unfold R_dist.
-Intros.
-Elim (p eps H1); Intros.
-Exists x0; Intros.
-Assert H4 := (H2 n H3).
-Rewrite <- Rabsolu_Ropp.
-Replace ``-((Un n)- -x)`` with ``-(Un n)-x``; [Assumption | Ring].
+Lemma decreasing_cv :
+ forall Un:nat -> R,
+ Un_decreasing Un -> has_lb Un -> sigT (fun l:R => Un_cv Un l).
+intros.
+cut (sigT (fun l:R => Un_cv (opp_seq Un) l) -> sigT (fun l:R => Un_cv Un l)).
+intro.
+apply X.
+apply growing_cv.
+apply decreasing_growing; assumption.
+exact H0.
+intro.
+elim X; intros.
+apply existT with (- x).
+unfold Un_cv in p.
+unfold R_dist in p.
+unfold opp_seq in p.
+unfold Un_cv in |- *.
+unfold R_dist in |- *.
+intros.
+elim (p eps H1); intros.
+exists x0; intros.
+assert (H4 := H2 n H3).
+rewrite <- Rabs_Ropp.
+replace (- (Un n - - x)) with (- Un n - x); [ assumption | ring ].
Qed.
(***********)
-Lemma maj_sup : (Un:nat->R) (has_ub Un) -> (sigTT R [l:R](is_lub (EUn Un) l)).
-Intros.
-Unfold has_ub in H.
-Apply complet.
-Assumption.
-Exists (Un O).
-Unfold EUn.
-Exists O; Reflexivity.
+Lemma maj_sup :
+ forall Un:nat -> R, has_ub Un -> sigT (fun l:R => is_lub (EUn Un) l).
+intros.
+unfold has_ub in H.
+apply completeness.
+assumption.
+exists (Un 0%nat).
+unfold EUn in |- *.
+exists 0%nat; reflexivity.
Qed.
(**********)
-Lemma min_inf : (Un:nat->R) (has_lb Un) -> (sigTT R [l:R](is_lub (EUn (opp_seq Un)) l)).
-Intros; Unfold has_lb in H.
-Apply complet.
-Assumption.
-Exists ``-(Un O)``.
-Exists O.
-Reflexivity.
+Lemma min_inf :
+ forall Un:nat -> R,
+ has_lb Un -> sigT (fun l:R => is_lub (EUn (opp_seq Un)) l).
+intros; unfold has_lb in H.
+apply completeness.
+assumption.
+exists (- Un 0%nat).
+exists 0%nat.
+reflexivity.
Qed.
-Definition majorant [Un:nat->R;pr:(has_ub Un)] : R := Cases (maj_sup Un pr) of (existTT a b) => a end.
+Definition majorant (Un:nat -> R) (pr:has_ub Un) : R :=
+ match maj_sup Un pr with
+ | existT a b => a
+ end.
-Definition minorant [Un:nat->R;pr:(has_lb Un)] : R := Cases (min_inf Un pr) of (existTT a b) => ``-a`` end.
+Definition minorant (Un:nat -> R) (pr:has_lb Un) : R :=
+ match min_inf Un pr with
+ | existT a b => - a
+ end.
-Lemma maj_ss : (Un:nat->R;k:nat) (has_ub Un) -> (has_ub [i:nat](Un (plus k i))).
-Intros.
-Unfold has_ub in H.
-Unfold bound in H.
-Elim H; Intros.
-Unfold is_upper_bound in H0.
-Unfold has_ub.
-Exists x.
-Unfold is_upper_bound.
-Intros.
-Apply H0.
-Elim H1; Intros.
-Exists (plus k x1); Assumption.
+Lemma maj_ss :
+ forall (Un:nat -> R) (k:nat),
+ has_ub Un -> has_ub (fun i:nat => Un (k + i)%nat).
+intros.
+unfold has_ub in H.
+unfold bound in H.
+elim H; intros.
+unfold is_upper_bound in H0.
+unfold has_ub in |- *.
+exists x.
+unfold is_upper_bound in |- *.
+intros.
+apply H0.
+elim H1; intros.
+exists (k + x1)%nat; assumption.
Qed.
-Lemma min_ss : (Un:nat->R;k:nat) (has_lb Un) -> (has_lb [i:nat](Un (plus k i))).
-Intros.
-Unfold has_lb in H.
-Unfold bound in H.
-Elim H; Intros.
-Unfold is_upper_bound in H0.
-Unfold has_lb.
-Exists x.
-Unfold is_upper_bound.
-Intros.
-Apply H0.
-Elim H1; Intros.
-Exists (plus k x1); Assumption.
+Lemma min_ss :
+ forall (Un:nat -> R) (k:nat),
+ has_lb Un -> has_lb (fun i:nat => Un (k + i)%nat).
+intros.
+unfold has_lb in H.
+unfold bound in H.
+elim H; intros.
+unfold is_upper_bound in H0.
+unfold has_lb in |- *.
+exists x.
+unfold is_upper_bound in |- *.
+intros.
+apply H0.
+elim H1; intros.
+exists (k + x1)%nat; assumption.
Qed.
-Definition sequence_majorant [Un:nat->R;pr:(has_ub Un)] : nat -> R := [i:nat](majorant [k:nat](Un (plus i k)) (maj_ss Un i pr)).
+Definition sequence_majorant (Un:nat -> R) (pr:has_ub Un)
+ (i:nat) : R := majorant (fun k:nat => Un (i + k)%nat) (maj_ss Un i pr).
-Definition sequence_minorant [Un:nat->R;pr:(has_lb Un)] : nat -> R := [i:nat](minorant [k:nat](Un (plus i k)) (min_ss Un i pr)).
+Definition sequence_minorant (Un:nat -> R) (pr:has_lb Un)
+ (i:nat) : R := minorant (fun k:nat => Un (i + k)%nat) (min_ss Un i pr).
-Lemma Wn_decreasing : (Un:nat->R;pr:(has_ub Un)) (Un_decreasing (sequence_majorant Un pr)).
-Intros.
-Unfold Un_decreasing.
-Intro.
-Unfold sequence_majorant.
-Assert H := (maj_sup [k:nat](Un (plus (S n) k)) (maj_ss Un (S n) pr)).
-Assert H0 := (maj_sup [k:nat](Un (plus n k)) (maj_ss Un n pr)).
-Elim H; Intros.
-Elim H0; Intros.
-Cut (majorant ([k:nat](Un (plus (S n) k))) (maj_ss Un (S n) pr)) == x; [Intro Maj1; Rewrite Maj1 | Idtac].
-Cut (majorant ([k:nat](Un (plus n k))) (maj_ss Un n pr)) == x0; [Intro Maj2; Rewrite Maj2 | Idtac].
-Unfold is_lub in p.
-Unfold is_lub in p0.
-Elim p; Intros.
-Apply H2.
-Elim p0; Intros.
-Unfold is_upper_bound.
-Intros.
-Unfold is_upper_bound in H3.
-Apply H3.
-Elim H5; Intros.
-Exists (plus (1) x2).
-Replace (plus n (plus (S O) x2)) with (plus (S n) x2).
-Assumption.
-Replace (S n) with (plus (1) n); [Ring | Ring].
-Cut (is_lub (EUn [k:nat](Un (plus n k))) (majorant ([k:nat](Un (plus n k))) (maj_ss Un n pr))).
-Intro.
-Unfold is_lub in p0; Unfold is_lub in H1.
-Elim p0; Intros; Elim H1; Intros.
-Assert H6 := (H5 x0 H2).
-Assert H7 := (H3 (majorant ([k:nat](Un (plus n k))) (maj_ss Un n pr)) H4).
-Apply Rle_antisym; Assumption.
-Unfold majorant.
-Case (maj_sup [k:nat](Un (plus n k)) (maj_ss Un n pr)).
-Trivial.
-Cut (is_lub (EUn [k:nat](Un (plus (S n) k))) (majorant ([k:nat](Un (plus (S n) k))) (maj_ss Un (S n) pr))).
-Intro.
-Unfold is_lub in p; Unfold is_lub in H1.
-Elim p; Intros; Elim H1; Intros.
-Assert H6 := (H5 x H2).
-Assert H7 := (H3 (majorant ([k:nat](Un (plus (S n) k))) (maj_ss Un (S n) pr)) H4).
-Apply Rle_antisym; Assumption.
-Unfold majorant.
-Case (maj_sup [k:nat](Un (plus (S n) k)) (maj_ss Un (S n) pr)).
-Trivial.
+Lemma Wn_decreasing :
+ forall (Un:nat -> R) (pr:has_ub Un), Un_decreasing (sequence_majorant Un pr).
+intros.
+unfold Un_decreasing in |- *.
+intro.
+unfold sequence_majorant in |- *.
+assert (H := maj_sup (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr)).
+assert (H0 := maj_sup (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr)).
+elim H; intros.
+elim H0; intros.
+cut (majorant (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr) = x);
+ [ intro Maj1; rewrite Maj1 | idtac ].
+cut (majorant (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr) = x0);
+ [ intro Maj2; rewrite Maj2 | idtac ].
+unfold is_lub in p.
+unfold is_lub in p0.
+elim p; intros.
+apply H2.
+elim p0; intros.
+unfold is_upper_bound in |- *.
+intros.
+unfold is_upper_bound in H3.
+apply H3.
+elim H5; intros.
+exists (1 + x2)%nat.
+replace (n + (1 + x2))%nat with (S n + x2)%nat.
+assumption.
+replace (S n) with (1 + n)%nat; [ ring | ring ].
+cut
+ (is_lub (EUn (fun k:nat => Un (n + k)%nat))
+ (majorant (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr))).
+intro.
+unfold is_lub in p0; unfold is_lub in H1.
+elim p0; intros; elim H1; intros.
+assert (H6 := H5 x0 H2).
+assert
+ (H7 := H3 (majorant (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr)) H4).
+apply Rle_antisym; assumption.
+unfold majorant in |- *.
+case (maj_sup (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr)).
+trivial.
+cut
+ (is_lub (EUn (fun k:nat => Un (S n + k)%nat))
+ (majorant (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr))).
+intro.
+unfold is_lub in p; unfold is_lub in H1.
+elim p; intros; elim H1; intros.
+assert (H6 := H5 x H2).
+assert
+ (H7 :=
+ H3 (majorant (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr)) H4).
+apply Rle_antisym; assumption.
+unfold majorant in |- *.
+case (maj_sup (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr)).
+trivial.
Qed.
-Lemma Vn_growing : (Un:nat->R;pr:(has_lb Un)) (Un_growing (sequence_minorant Un pr)).
-Intros.
-Unfold Un_growing.
-Intro.
-Unfold sequence_minorant.
-Assert H := (min_inf [k:nat](Un (plus (S n) k)) (min_ss Un (S n) pr)).
-Assert H0 := (min_inf [k:nat](Un (plus n k)) (min_ss Un n pr)).
-Elim H; Intros.
-Elim H0; Intros.
-Cut (minorant ([k:nat](Un (plus (S n) k))) (min_ss Un (S n) pr)) == ``-x``; [Intro Maj1; Rewrite Maj1 | Idtac].
-Cut (minorant ([k:nat](Un (plus n k))) (min_ss Un n pr)) == ``-x0``; [Intro Maj2; Rewrite Maj2 | Idtac].
-Unfold is_lub in p.
-Unfold is_lub in p0.
-Elim p; Intros.
-Apply Rle_Ropp1.
-Apply H2.
-Elim p0; Intros.
-Unfold is_upper_bound.
-Intros.
-Unfold is_upper_bound in H3.
-Apply H3.
-Elim H5; Intros.
-Exists (plus (1) x2).
-Unfold opp_seq in H6.
-Unfold opp_seq.
-Replace (plus n (plus (S O) x2)) with (plus (S n) x2).
-Assumption.
-Replace (S n) with (plus (1) n); [Ring | Ring].
-Cut (is_lub (EUn (opp_seq [k:nat](Un (plus n k)))) (Ropp (minorant ([k:nat](Un (plus n k))) (min_ss Un n pr)))).
-Intro.
-Unfold is_lub in p0; Unfold is_lub in H1.
-Elim p0; Intros; Elim H1; Intros.
-Assert H6 := (H5 x0 H2).
-Assert H7 := (H3 (Ropp (minorant ([k:nat](Un (plus n k))) (min_ss Un n pr))) H4).
-Rewrite <- (Ropp_Ropp (minorant ([k:nat](Un (plus n k))) (min_ss Un n pr))).
-Apply eq_Ropp; Apply Rle_antisym; Assumption.
-Unfold minorant.
-Case (min_inf [k:nat](Un (plus n k)) (min_ss Un n pr)).
-Intro; Rewrite Ropp_Ropp.
-Trivial.
-Cut (is_lub (EUn (opp_seq [k:nat](Un (plus (S n) k)))) (Ropp (minorant ([k:nat](Un (plus (S n) k))) (min_ss Un (S n) pr)))).
-Intro.
-Unfold is_lub in p; Unfold is_lub in H1.
-Elim p; Intros; Elim H1; Intros.
-Assert H6 := (H5 x H2).
-Assert H7 := (H3 (Ropp (minorant ([k:nat](Un (plus (S n) k))) (min_ss Un (S n) pr))) H4).
-Rewrite <- (Ropp_Ropp (minorant ([k:nat](Un (plus (S n) k))) (min_ss Un (S n) pr))).
-Apply eq_Ropp; Apply Rle_antisym; Assumption.
-Unfold minorant.
-Case (min_inf [k:nat](Un (plus (S n) k)) (min_ss Un (S n) pr)).
-Intro; Rewrite Ropp_Ropp.
-Trivial.
+Lemma Vn_growing :
+ forall (Un:nat -> R) (pr:has_lb Un), Un_growing (sequence_minorant Un pr).
+intros.
+unfold Un_growing in |- *.
+intro.
+unfold sequence_minorant in |- *.
+assert (H := min_inf (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr)).
+assert (H0 := min_inf (fun k:nat => Un (n + k)%nat) (min_ss Un n pr)).
+elim H; intros.
+elim H0; intros.
+cut (minorant (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr) = - x);
+ [ intro Maj1; rewrite Maj1 | idtac ].
+cut (minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr) = - x0);
+ [ intro Maj2; rewrite Maj2 | idtac ].
+unfold is_lub in p.
+unfold is_lub in p0.
+elim p; intros.
+apply Ropp_le_contravar.
+apply H2.
+elim p0; intros.
+unfold is_upper_bound in |- *.
+intros.
+unfold is_upper_bound in H3.
+apply H3.
+elim H5; intros.
+exists (1 + x2)%nat.
+unfold opp_seq in H6.
+unfold opp_seq in |- *.
+replace (n + (1 + x2))%nat with (S n + x2)%nat.
+assumption.
+replace (S n) with (1 + n)%nat; [ ring | ring ].
+cut
+ (is_lub (EUn (opp_seq (fun k:nat => Un (n + k)%nat)))
+ (- minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr))).
+intro.
+unfold is_lub in p0; unfold is_lub in H1.
+elim p0; intros; elim H1; intros.
+assert (H6 := H5 x0 H2).
+assert
+ (H7 := H3 (- minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr)) H4).
+rewrite <-
+ (Ropp_involutive (minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr)))
+ .
+apply Ropp_eq_compat; apply Rle_antisym; assumption.
+unfold minorant in |- *.
+case (min_inf (fun k:nat => Un (n + k)%nat) (min_ss Un n pr)).
+intro; rewrite Ropp_involutive.
+trivial.
+cut
+ (is_lub (EUn (opp_seq (fun k:nat => Un (S n + k)%nat)))
+ (- minorant (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr))).
+intro.
+unfold is_lub in p; unfold is_lub in H1.
+elim p; intros; elim H1; intros.
+assert (H6 := H5 x H2).
+assert
+ (H7 :=
+ H3 (- minorant (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr)) H4).
+rewrite <-
+ (Ropp_involutive
+ (minorant (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr)))
+ .
+apply Ropp_eq_compat; apply Rle_antisym; assumption.
+unfold minorant in |- *.
+case (min_inf (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr)).
+intro; rewrite Ropp_involutive.
+trivial.
Qed.
(**********)
-Lemma Vn_Un_Wn_order : (Un:nat->R;pr1:(has_ub Un);pr2:(has_lb Un)) (n:nat) ``((sequence_minorant Un pr2) n)<=(Un n)<=((sequence_majorant Un pr1) n)``.
-Intros.
-Split.
-Unfold sequence_minorant.
-Cut (sigTT R [l:R](is_lub (EUn (opp_seq [i:nat](Un (plus n i)))) l)).
-Intro.
-Elim X; Intros.
-Replace (minorant ([k:nat](Un (plus n k))) (min_ss Un n pr2)) with ``-x``.
-Unfold is_lub in p.
-Elim p; Intros.
-Unfold is_upper_bound in H.
-Rewrite <- (Ropp_Ropp (Un n)).
-Apply Rle_Ropp1.
-Apply H.
-Exists O.
-Unfold opp_seq.
-Replace (plus n O) with n; [Reflexivity | Ring].
-Cut (is_lub (EUn (opp_seq [k:nat](Un (plus n k)))) (Ropp (minorant ([k:nat](Un (plus n k))) (min_ss Un n pr2)))).
-Intro.
-Unfold is_lub in p; Unfold is_lub in H.
-Elim p; Intros; Elim H; Intros.
-Assert H4 := (H3 x H0).
-Assert H5 := (H1 (Ropp (minorant ([k:nat](Un (plus n k))) (min_ss Un n pr2))) H2).
-Rewrite <- (Ropp_Ropp (minorant ([k:nat](Un (plus n k))) (min_ss Un n pr2))).
-Apply eq_Ropp; Apply Rle_antisym; Assumption.
-Unfold minorant.
-Case (min_inf [k:nat](Un (plus n k)) (min_ss Un n pr2)).
-Intro; Rewrite Ropp_Ropp.
-Trivial.
-Apply min_inf.
-Apply min_ss; Assumption.
-Unfold sequence_majorant.
-Cut (sigTT R [l:R](is_lub (EUn [i:nat](Un (plus n i))) l)).
-Intro.
-Elim X; Intros.
-Replace (majorant ([k:nat](Un (plus n k))) (maj_ss Un n pr1)) with ``x``.
-Unfold is_lub in p.
-Elim p; Intros.
-Unfold is_upper_bound in H.
-Apply H.
-Exists O.
-Replace (plus n O) with n; [Reflexivity | Ring].
-Cut (is_lub (EUn [k:nat](Un (plus n k))) (majorant ([k:nat](Un (plus n k))) (maj_ss Un n pr1))).
-Intro.
-Unfold is_lub in p; Unfold is_lub in H.
-Elim p; Intros; Elim H; Intros.
-Assert H4 := (H3 x H0).
-Assert H5 := (H1 (majorant ([k:nat](Un (plus n k))) (maj_ss Un n pr1)) H2).
-Apply Rle_antisym; Assumption.
-Unfold majorant.
-Case (maj_sup [k:nat](Un (plus n k)) (maj_ss Un n pr1)).
-Intro; Trivial.
-Apply maj_sup.
-Apply maj_ss; Assumption.
+Lemma Vn_Un_Wn_order :
+ forall (Un:nat -> R) (pr1:has_ub Un) (pr2:has_lb Un)
+ (n:nat), sequence_minorant Un pr2 n <= Un n <= sequence_majorant Un pr1 n.
+intros.
+split.
+unfold sequence_minorant in |- *.
+cut
+ (sigT (fun l:R => is_lub (EUn (opp_seq (fun i:nat => Un (n + i)%nat))) l)).
+intro.
+elim X; intros.
+replace (minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2)) with (- x).
+unfold is_lub in p.
+elim p; intros.
+unfold is_upper_bound in H.
+rewrite <- (Ropp_involutive (Un n)).
+apply Ropp_le_contravar.
+apply H.
+exists 0%nat.
+unfold opp_seq in |- *.
+replace (n + 0)%nat with n; [ reflexivity | ring ].
+cut
+ (is_lub (EUn (opp_seq (fun k:nat => Un (n + k)%nat)))
+ (- minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2))).
+intro.
+unfold is_lub in p; unfold is_lub in H.
+elim p; intros; elim H; intros.
+assert (H4 := H3 x H0).
+assert
+ (H5 := H1 (- minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2)) H2).
+rewrite <-
+ (Ropp_involutive (minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2)))
+ .
+apply Ropp_eq_compat; apply Rle_antisym; assumption.
+unfold minorant in |- *.
+case (min_inf (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2)).
+intro; rewrite Ropp_involutive.
+trivial.
+apply min_inf.
+apply min_ss; assumption.
+unfold sequence_majorant in |- *.
+cut (sigT (fun l:R => is_lub (EUn (fun i:nat => Un (n + i)%nat)) l)).
+intro.
+elim X; intros.
+replace (majorant (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr1)) with x.
+unfold is_lub in p.
+elim p; intros.
+unfold is_upper_bound in H.
+apply H.
+exists 0%nat.
+replace (n + 0)%nat with n; [ reflexivity | ring ].
+cut
+ (is_lub (EUn (fun k:nat => Un (n + k)%nat))
+ (majorant (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr1))).
+intro.
+unfold is_lub in p; unfold is_lub in H.
+elim p; intros; elim H; intros.
+assert (H4 := H3 x H0).
+assert
+ (H5 := H1 (majorant (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr1)) H2).
+apply Rle_antisym; assumption.
+unfold majorant in |- *.
+case (maj_sup (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr1)).
+intro; trivial.
+apply maj_sup.
+apply maj_ss; assumption.
Qed.
-Lemma min_maj : (Un:nat->R;pr1:(has_ub Un);pr2:(has_lb Un)) (has_ub (sequence_minorant Un pr2)).
-Intros.
-Assert H := (Vn_Un_Wn_order Un pr1 pr2).
-Unfold has_ub.
-Unfold bound.
-Unfold has_ub in pr1.
-Unfold bound in pr1.
-Elim pr1; Intros.
-Exists x.
-Unfold is_upper_bound.
-Intros.
-Unfold is_upper_bound in H0.
-Elim H1; Intros.
-Rewrite H2.
-Apply Rle_trans with (Un x1).
-Assert H3 := (H x1); Elim H3; Intros; Assumption.
-Apply H0.
-Exists x1; Reflexivity.
+Lemma min_maj :
+ forall (Un:nat -> R) (pr1:has_ub Un) (pr2:has_lb Un),
+ has_ub (sequence_minorant Un pr2).
+intros.
+assert (H := Vn_Un_Wn_order Un pr1 pr2).
+unfold has_ub in |- *.
+unfold bound in |- *.
+unfold has_ub in pr1.
+unfold bound in pr1.
+elim pr1; intros.
+exists x.
+unfold is_upper_bound in |- *.
+intros.
+unfold is_upper_bound in H0.
+elim H1; intros.
+rewrite H2.
+apply Rle_trans with (Un x1).
+assert (H3 := H x1); elim H3; intros; assumption.
+apply H0.
+exists x1; reflexivity.
Qed.
-Lemma maj_min : (Un:nat->R;pr1:(has_ub Un);pr2:(has_lb Un)) (has_lb (sequence_majorant Un pr1)).
-Intros.
-Assert H := (Vn_Un_Wn_order Un pr1 pr2).
-Unfold has_lb.
-Unfold bound.
-Unfold has_lb in pr2.
-Unfold bound in pr2.
-Elim pr2; Intros.
-Exists x.
-Unfold is_upper_bound.
-Intros.
-Unfold is_upper_bound in H0.
-Elim H1; Intros.
-Rewrite H2.
-Apply Rle_trans with ((opp_seq Un) x1).
-Assert H3 := (H x1); Elim H3; Intros.
-Unfold opp_seq; Apply Rle_Ropp1.
-Assumption.
-Apply H0.
-Exists x1; Reflexivity.
+Lemma maj_min :
+ forall (Un:nat -> R) (pr1:has_ub Un) (pr2:has_lb Un),
+ has_lb (sequence_majorant Un pr1).
+intros.
+assert (H := Vn_Un_Wn_order Un pr1 pr2).
+unfold has_lb in |- *.
+unfold bound in |- *.
+unfold has_lb in pr2.
+unfold bound in pr2.
+elim pr2; intros.
+exists x.
+unfold is_upper_bound in |- *.
+intros.
+unfold is_upper_bound in H0.
+elim H1; intros.
+rewrite H2.
+apply Rle_trans with (opp_seq Un x1).
+assert (H3 := H x1); elim H3; intros.
+unfold opp_seq in |- *; apply Ropp_le_contravar.
+assumption.
+apply H0.
+exists x1; reflexivity.
Qed.
(**********)
-Lemma cauchy_maj : (Un:nat->R) (Cauchy_crit Un) -> (has_ub Un).
-Intros.
-Unfold has_ub.
-Apply cauchy_bound.
-Assumption.
+Lemma cauchy_maj : forall Un:nat -> R, Cauchy_crit Un -> has_ub Un.
+intros.
+unfold has_ub in |- *.
+apply cauchy_bound.
+assumption.
Qed.
(**********)
-Lemma cauchy_opp : (Un:nat->R) (Cauchy_crit Un) -> (Cauchy_crit (opp_seq Un)).
-Intro.
-Unfold Cauchy_crit.
-Unfold R_dist.
-Intros.
-Elim (H eps H0); Intros.
-Exists x; Intros.
-Unfold opp_seq.
-Rewrite <- Rabsolu_Ropp.
-Replace ``-( -(Un n)- -(Un m))`` with ``(Un n)-(Un m)``; [Apply H1; Assumption | Ring].
+Lemma cauchy_opp :
+ forall Un:nat -> R, Cauchy_crit Un -> Cauchy_crit (opp_seq Un).
+intro.
+unfold Cauchy_crit in |- *.
+unfold R_dist in |- *.
+intros.
+elim (H eps H0); intros.
+exists x; intros.
+unfold opp_seq in |- *.
+rewrite <- Rabs_Ropp.
+replace (- (- Un n - - Un m)) with (Un n - Un m);
+ [ apply H1; assumption | ring ].
Qed.
(**********)
-Lemma cauchy_min : (Un:nat->R) (Cauchy_crit Un) -> (has_lb Un).
-Intros.
-Unfold has_lb.
-Assert H0 := (cauchy_opp ? H).
-Apply cauchy_bound.
-Assumption.
+Lemma cauchy_min : forall Un:nat -> R, Cauchy_crit Un -> has_lb Un.
+intros.
+unfold has_lb in |- *.
+assert (H0 := cauchy_opp _ H).
+apply cauchy_bound.
+assumption.
Qed.
(**********)
-Lemma maj_cv : (Un:nat->R;pr:(Cauchy_crit Un)) (sigTT R [l:R](Un_cv (sequence_majorant Un (cauchy_maj Un pr)) l)).
-Intros.
-Apply decreasing_cv.
-Apply Wn_decreasing.
-Apply maj_min.
-Apply cauchy_min.
-Assumption.
+Lemma maj_cv :
+ forall (Un:nat -> R) (pr:Cauchy_crit Un),
+ sigT (fun l:R => Un_cv (sequence_majorant Un (cauchy_maj Un pr)) l).
+intros.
+apply decreasing_cv.
+apply Wn_decreasing.
+apply maj_min.
+apply cauchy_min.
+assumption.
Qed.
(**********)
-Lemma min_cv : (Un:nat->R;pr:(Cauchy_crit Un)) (sigTT R [l:R](Un_cv (sequence_minorant Un (cauchy_min Un pr)) l)).
-Intros.
-Apply growing_cv.
-Apply Vn_growing.
-Apply min_maj.
-Apply cauchy_maj.
-Assumption.
+Lemma min_cv :
+ forall (Un:nat -> R) (pr:Cauchy_crit Un),
+ sigT (fun l:R => Un_cv (sequence_minorant Un (cauchy_min Un pr)) l).
+intros.
+apply growing_cv.
+apply Vn_growing.
+apply min_maj.
+apply cauchy_maj.
+assumption.
Qed.
-Lemma cond_eq : (x,y:R) ((eps:R)``0<eps``->``(Rabsolu (x-y))<eps``) -> x==y.
-Intros.
-Case (total_order_T x y); Intro.
-Elim s; Intro.
-Cut ``0<y-x``.
-Intro.
-Assert H1 := (H ``y-x`` H0).
-Rewrite <- Rabsolu_Ropp in H1.
-Cut ``-(x-y)==y-x``; [Intro; Rewrite H2 in H1 | Ring].
-Rewrite Rabsolu_right in H1.
-Elim (Rlt_antirefl ? H1).
-Left; Assumption.
-Apply Rlt_anti_compatibility with x.
-Rewrite Rplus_Or; Replace ``x+(y-x)`` with y; [Assumption | Ring].
-Assumption.
-Cut ``0<x-y``.
-Intro.
-Assert H1 := (H ``x-y`` H0).
-Rewrite Rabsolu_right in H1.
-Elim (Rlt_antirefl ? H1).
-Left; Assumption.
-Apply Rlt_anti_compatibility with y.
-Rewrite Rplus_Or; Replace ``y+(x-y)`` with x; [Assumption | Ring].
+Lemma cond_eq :
+ forall x y:R, (forall eps:R, 0 < eps -> Rabs (x - y) < eps) -> x = y.
+intros.
+case (total_order_T x y); intro.
+elim s; intro.
+cut (0 < y - x).
+intro.
+assert (H1 := H (y - x) H0).
+rewrite <- Rabs_Ropp in H1.
+cut (- (x - y) = y - x); [ intro; rewrite H2 in H1 | ring ].
+rewrite Rabs_right in H1.
+elim (Rlt_irrefl _ H1).
+left; assumption.
+apply Rplus_lt_reg_r with x.
+rewrite Rplus_0_r; replace (x + (y - x)) with y; [ assumption | ring ].
+assumption.
+cut (0 < x - y).
+intro.
+assert (H1 := H (x - y) H0).
+rewrite Rabs_right in H1.
+elim (Rlt_irrefl _ H1).
+left; assumption.
+apply Rplus_lt_reg_r with y.
+rewrite Rplus_0_r; replace (y + (x - y)) with x; [ assumption | ring ].
Qed.
-Lemma not_Rlt : (r1,r2:R)~(``r1<r2``)->``r1>=r2``.
-Intros r1 r2 ; Generalize (total_order r1 r2) ; Unfold Rge.
-Tauto.
+Lemma not_Rlt : forall r1 r2:R, ~ r1 < r2 -> r1 >= r2.
+intros r1 r2; generalize (Rtotal_order r1 r2); unfold Rge in |- *.
+tauto.
Qed.
(**********)
-Lemma approx_maj : (Un:nat->R;pr:(has_ub Un)) (eps:R) ``0<eps`` -> (EX k : nat | ``(Rabsolu ((majorant Un pr)-(Un k))) < eps``).
-Intros.
-Pose P := [k:nat]``(Rabsolu ((majorant Un pr)-(Un k))) < eps``.
-Unfold P.
-Cut (EX k:nat | (P k)) -> (EX k:nat | ``(Rabsolu ((majorant Un pr)-(Un k))) < eps``).
-Intros.
-Apply H0.
-Apply not_all_not_ex.
-Red; Intro.
-2:Unfold P; Trivial.
-Unfold P in H1.
-Cut (n:nat)``(Rabsolu ((majorant Un pr)-(Un n))) >= eps``.
-Intro.
-Cut (is_lub (EUn Un) (majorant Un pr)).
-Intro.
-Unfold is_lub in H3.
-Unfold is_upper_bound in H3.
-Elim H3; Intros.
-Cut (n:nat)``eps<=(majorant Un pr)-(Un n)``.
-Intro.
-Cut (n:nat)``(Un n)<=(majorant Un pr)-eps``.
-Intro.
-Cut ((x:R)(EUn Un x)->``x <= (majorant Un pr)-eps``).
-Intro.
-Assert H9 := (H5 ``(majorant Un pr)-eps`` H8).
-Cut ``eps<=0``.
-Intro.
-Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? H H10)).
-Apply Rle_anti_compatibility with ``(majorant Un pr)-eps``.
-Rewrite Rplus_Or.
-Replace ``(majorant Un pr)-eps+eps`` with (majorant Un pr); [Assumption | Ring].
-Intros.
-Unfold EUn in H8.
-Elim H8; Intros.
-Rewrite H9; Apply H7.
-Intro.
-Assert H7 := (H6 n).
-Apply Rle_anti_compatibility with ``eps-(Un n)``.
-Replace ``eps-(Un n)+(Un n)`` with ``eps``.
-Replace ``eps-(Un n)+((majorant Un pr)-eps)`` with ``(majorant Un pr)-(Un n)``.
-Assumption.
-Ring.
-Ring.
-Intro.
-Assert H6 := (H2 n).
-Rewrite Rabsolu_right in H6.
-Apply Rle_sym2.
-Assumption.
-Apply Rle_sym1.
-Apply Rle_anti_compatibility with (Un n).
-Rewrite Rplus_Or; Replace ``(Un n)+((majorant Un pr)-(Un n))`` with (majorant Un pr); [Apply H4 | Ring].
-Exists n; Reflexivity.
-Unfold majorant.
-Case (maj_sup Un pr).
-Trivial.
-Intro.
-Assert H2 := (H1 n).
-Apply not_Rlt; Assumption.
+Lemma approx_maj :
+ forall (Un:nat -> R) (pr:has_ub Un) (eps:R),
+ 0 < eps -> exists k : nat | Rabs (majorant Un pr - Un k) < eps.
+intros.
+pose (P := fun k:nat => Rabs (majorant Un pr - Un k) < eps).
+unfold P in |- *.
+cut
+ (( exists k : nat | P k) ->
+ exists k : nat | Rabs (majorant Un pr - Un k) < eps).
+intros.
+apply H0.
+apply not_all_not_ex.
+red in |- *; intro.
+2: unfold P in |- *; trivial.
+unfold P in H1.
+cut (forall n:nat, Rabs (majorant Un pr - Un n) >= eps).
+intro.
+cut (is_lub (EUn Un) (majorant Un pr)).
+intro.
+unfold is_lub in H3.
+unfold is_upper_bound in H3.
+elim H3; intros.
+cut (forall n:nat, eps <= majorant Un pr - Un n).
+intro.
+cut (forall n:nat, Un n <= majorant Un pr - eps).
+intro.
+cut (forall x:R, EUn Un x -> x <= majorant Un pr - eps).
+intro.
+assert (H9 := H5 (majorant Un pr - eps) H8).
+cut (eps <= 0).
+intro.
+elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H H10)).
+apply Rplus_le_reg_l with (majorant Un pr - eps).
+rewrite Rplus_0_r.
+replace (majorant Un pr - eps + eps) with (majorant Un pr);
+ [ assumption | ring ].
+intros.
+unfold EUn in H8.
+elim H8; intros.
+rewrite H9; apply H7.
+intro.
+assert (H7 := H6 n).
+apply Rplus_le_reg_l with (eps - Un n).
+replace (eps - Un n + Un n) with eps.
+replace (eps - Un n + (majorant Un pr - eps)) with (majorant Un pr - Un n).
+assumption.
+ring.
+ring.
+intro.
+assert (H6 := H2 n).
+rewrite Rabs_right in H6.
+apply Rge_le.
+assumption.
+apply Rle_ge.
+apply Rplus_le_reg_l with (Un n).
+rewrite Rplus_0_r;
+ replace (Un n + (majorant Un pr - Un n)) with (majorant Un pr);
+ [ apply H4 | ring ].
+exists n; reflexivity.
+unfold majorant in |- *.
+case (maj_sup Un pr).
+trivial.
+intro.
+assert (H2 := H1 n).
+apply not_Rlt; assumption.
Qed.
(**********)
-Lemma approx_min : (Un:nat->R;pr:(has_lb Un)) (eps:R) ``0<eps`` -> (EX k :nat | ``(Rabsolu ((minorant Un pr)-(Un k))) < eps``).
-Intros.
-Pose P := [k:nat]``(Rabsolu ((minorant Un pr)-(Un k))) < eps``.
-Unfold P.
-Cut (EX k:nat | (P k)) -> (EX k:nat | ``(Rabsolu ((minorant Un pr)-(Un k))) < eps``).
-Intros.
-Apply H0.
-Apply not_all_not_ex.
-Red; Intro.
-2:Unfold P; Trivial.
-Unfold P in H1.
-Cut (n:nat)``(Rabsolu ((minorant Un pr)-(Un n))) >= eps``.
-Intro.
-Cut (is_lub (EUn (opp_seq Un)) ``-(minorant Un pr)``).
-Intro.
-Unfold is_lub in H3.
-Unfold is_upper_bound in H3.
-Elim H3; Intros.
-Cut (n:nat)``eps<=(Un n)-(minorant Un pr)``.
-Intro.
-Cut (n:nat)``((opp_seq Un) n)<=-(minorant Un pr)-eps``.
-Intro.
-Cut ((x:R)(EUn (opp_seq Un) x)->``x <= -(minorant Un pr)-eps``).
-Intro.
-Assert H9 := (H5 ``-(minorant Un pr)-eps`` H8).
-Cut ``eps<=0``.
-Intro.
-Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? H H10)).
-Apply Rle_anti_compatibility with ``-(minorant Un pr)-eps``.
-Rewrite Rplus_Or.
-Replace ``-(minorant Un pr)-eps+eps`` with ``-(minorant Un pr)``; [Assumption | Ring].
-Intros.
-Unfold EUn in H8.
-Elim H8; Intros.
-Rewrite H9; Apply H7.
-Intro.
-Assert H7 := (H6 n).
-Unfold opp_seq.
-Apply Rle_anti_compatibility with ``eps+(Un n)``.
-Replace ``eps+(Un n)+ -(Un n)`` with ``eps``.
-Replace ``eps+(Un n)+(-(minorant Un pr)-eps)`` with ``(Un n)-(minorant Un pr)``.
-Assumption.
-Ring.
-Ring.
-Intro.
-Assert H6 := (H2 n).
-Rewrite Rabsolu_left1 in H6.
-Apply Rle_sym2.
-Replace ``(Un n)-(minorant Un pr)`` with `` -((minorant Un pr)-(Un n))``; [Assumption | Ring].
-Apply Rle_anti_compatibility with ``-(minorant Un pr)``.
-Rewrite Rplus_Or; Replace ``-(minorant Un pr)+((minorant Un pr)-(Un n))`` with ``-(Un n)``.
-Apply H4.
-Exists n; Reflexivity.
-Ring.
-Unfold minorant.
-Case (min_inf Un pr).
-Intro.
-Rewrite Ropp_Ropp.
-Trivial.
-Intro.
-Assert H2 := (H1 n).
-Apply not_Rlt; Assumption.
+Lemma approx_min :
+ forall (Un:nat -> R) (pr:has_lb Un) (eps:R),
+ 0 < eps -> exists k : nat | Rabs (minorant Un pr - Un k) < eps.
+intros.
+pose (P := fun k:nat => Rabs (minorant Un pr - Un k) < eps).
+unfold P in |- *.
+cut
+ (( exists k : nat | P k) ->
+ exists k : nat | Rabs (minorant Un pr - Un k) < eps).
+intros.
+apply H0.
+apply not_all_not_ex.
+red in |- *; intro.
+2: unfold P in |- *; trivial.
+unfold P in H1.
+cut (forall n:nat, Rabs (minorant Un pr - Un n) >= eps).
+intro.
+cut (is_lub (EUn (opp_seq Un)) (- minorant Un pr)).
+intro.
+unfold is_lub in H3.
+unfold is_upper_bound in H3.
+elim H3; intros.
+cut (forall n:nat, eps <= Un n - minorant Un pr).
+intro.
+cut (forall n:nat, opp_seq Un n <= - minorant Un pr - eps).
+intro.
+cut (forall x:R, EUn (opp_seq Un) x -> x <= - minorant Un pr - eps).
+intro.
+assert (H9 := H5 (- minorant Un pr - eps) H8).
+cut (eps <= 0).
+intro.
+elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H H10)).
+apply Rplus_le_reg_l with (- minorant Un pr - eps).
+rewrite Rplus_0_r.
+replace (- minorant Un pr - eps + eps) with (- minorant Un pr);
+ [ assumption | ring ].
+intros.
+unfold EUn in H8.
+elim H8; intros.
+rewrite H9; apply H7.
+intro.
+assert (H7 := H6 n).
+unfold opp_seq in |- *.
+apply Rplus_le_reg_l with (eps + Un n).
+replace (eps + Un n + - Un n) with eps.
+replace (eps + Un n + (- minorant Un pr - eps)) with (Un n - minorant Un pr).
+assumption.
+ring.
+ring.
+intro.
+assert (H6 := H2 n).
+rewrite Rabs_left1 in H6.
+apply Rge_le.
+replace (Un n - minorant Un pr) with (- (minorant Un pr - Un n));
+ [ assumption | ring ].
+apply Rplus_le_reg_l with (- minorant Un pr).
+rewrite Rplus_0_r;
+ replace (- minorant Un pr + (minorant Un pr - Un n)) with (- Un n).
+apply H4.
+exists n; reflexivity.
+ring.
+unfold minorant in |- *.
+case (min_inf Un pr).
+intro.
+rewrite Ropp_involutive.
+trivial.
+intro.
+assert (H2 := H1 n).
+apply not_Rlt; assumption.
Qed.
(* Unicity of limit for convergent sequences *)
-Lemma UL_sequence : (Un:nat->R;l1,l2:R) (Un_cv Un l1) -> (Un_cv Un l2) -> l1==l2.
-Intros Un l1 l2; Unfold Un_cv; Unfold R_dist; Intros.
-Apply cond_eq.
-Intros; Cut ``0<eps/2``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]].
-Elim (H ``eps/2`` H2); Intros.
-Elim (H0 ``eps/2`` H2); Intros.
-Pose N := (max x x0).
-Apply Rle_lt_trans with ``(Rabsolu (l1 -(Un N)))+(Rabsolu ((Un N)-l2))``.
-Replace ``l1-l2`` with ``(l1-(Un N))+((Un N)-l2)``; [Apply Rabsolu_triang | Ring].
-Rewrite (double_var eps); Apply Rplus_lt.
-Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H3; Unfold ge N; Apply le_max_l.
-Apply H4; Unfold ge N; Apply le_max_r.
+Lemma UL_sequence :
+ forall (Un:nat -> R) (l1 l2:R), Un_cv Un l1 -> Un_cv Un l2 -> l1 = l2.
+intros Un l1 l2; unfold Un_cv in |- *; unfold R_dist in |- *; intros.
+apply cond_eq.
+intros; cut (0 < eps / 2);
+ [ intro
+ | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ].
+elim (H (eps / 2) H2); intros.
+elim (H0 (eps / 2) H2); intros.
+pose (N := max x x0).
+apply Rle_lt_trans with (Rabs (l1 - Un N) + Rabs (Un N - l2)).
+replace (l1 - l2) with (l1 - Un N + (Un N - l2));
+ [ apply Rabs_triang | ring ].
+rewrite (double_var eps); apply Rplus_lt_compat.
+rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H3;
+ unfold ge, N in |- *; apply le_max_l.
+apply H4; unfold ge, N in |- *; apply le_max_r.
Qed.
(**********)
-Lemma CV_plus : (An,Bn:nat->R;l1,l2:R) (Un_cv An l1) -> (Un_cv Bn l2) -> (Un_cv [i:nat]``(An i)+(Bn i)`` ``l1+l2``).
-Unfold Un_cv; Unfold R_dist; Intros.
-Cut ``0<eps/2``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]].
-Elim (H ``eps/2`` H2); Intros.
-Elim (H0 ``eps/2`` H2); Intros.
-Pose N := (max x x0).
-Exists N; Intros.
-Replace ``(An n)+(Bn n)-(l1+l2)`` with ``((An n)-l1)+((Bn n)-l2)``; [Idtac | Ring].
-Apply Rle_lt_trans with ``(Rabsolu ((An n)-l1))+(Rabsolu ((Bn n)-l2))``.
-Apply Rabsolu_triang.
-Rewrite (double_var eps); Apply Rplus_lt.
-Apply H3; Unfold ge; Apply le_trans with N; [Unfold N; Apply le_max_l | Assumption].
-Apply H4; Unfold ge; Apply le_trans with N; [Unfold N; Apply le_max_r | Assumption].
+Lemma CV_plus :
+ forall (An Bn:nat -> R) (l1 l2:R),
+ Un_cv An l1 -> Un_cv Bn l2 -> Un_cv (fun i:nat => An i + Bn i) (l1 + l2).
+unfold Un_cv in |- *; unfold R_dist in |- *; intros.
+cut (0 < eps / 2);
+ [ intro
+ | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ].
+elim (H (eps / 2) H2); intros.
+elim (H0 (eps / 2) H2); intros.
+pose (N := max x x0).
+exists N; intros.
+replace (An n + Bn n - (l1 + l2)) with (An n - l1 + (Bn n - l2));
+ [ idtac | ring ].
+apply Rle_lt_trans with (Rabs (An n - l1) + Rabs (Bn n - l2)).
+apply Rabs_triang.
+rewrite (double_var eps); apply Rplus_lt_compat.
+apply H3; unfold ge in |- *; apply le_trans with N;
+ [ unfold N in |- *; apply le_max_l | assumption ].
+apply H4; unfold ge in |- *; apply le_trans with N;
+ [ unfold N in |- *; apply le_max_r | assumption ].
Qed.
(**********)
-Lemma cv_cvabs : (Un:nat->R;l:R) (Un_cv Un l) -> (Un_cv [i:nat](Rabsolu (Un i)) (Rabsolu l)).
-Unfold Un_cv; Unfold R_dist; Intros.
-Elim (H eps H0); Intros.
-Exists x; Intros.
-Apply Rle_lt_trans with ``(Rabsolu ((Un n)-l))``.
-Apply Rabsolu_triang_inv2.
-Apply H1; Assumption.
+Lemma cv_cvabs :
+ forall (Un:nat -> R) (l:R),
+ Un_cv Un l -> Un_cv (fun i:nat => Rabs (Un i)) (Rabs l).
+unfold Un_cv in |- *; unfold R_dist in |- *; intros.
+elim (H eps H0); intros.
+exists x; intros.
+apply Rle_lt_trans with (Rabs (Un n - l)).
+apply Rabs_triang_inv2.
+apply H1; assumption.
Qed.
(**********)
-Lemma CV_Cauchy : (Un:nat->R) (sigTT R [l:R](Un_cv Un l)) -> (Cauchy_crit Un).
-Intros; Elim X; Intros.
-Unfold Cauchy_crit; Intros.
-Unfold Un_cv in p; Unfold R_dist in p.
-Cut ``0<eps/2``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]].
-Elim (p ``eps/2`` H0); Intros.
-Exists x0; Intros.
-Unfold R_dist; Apply Rle_lt_trans with ``(Rabsolu ((Un n)-x))+(Rabsolu (x-(Un m)))``.
-Replace ``(Un n)-(Un m)`` with ``((Un n)-x)+(x-(Un m))``; [Apply Rabsolu_triang | Ring].
-Rewrite (double_var eps); Apply Rplus_lt.
-Apply H1; Assumption.
-Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H1; Assumption.
+Lemma CV_Cauchy :
+ forall Un:nat -> R, sigT (fun l:R => Un_cv Un l) -> Cauchy_crit Un.
+intros; elim X; intros.
+unfold Cauchy_crit in |- *; intros.
+unfold Un_cv in p; unfold R_dist in p.
+cut (0 < eps / 2);
+ [ intro
+ | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ].
+elim (p (eps / 2) H0); intros.
+exists x0; intros.
+unfold R_dist in |- *;
+ apply Rle_lt_trans with (Rabs (Un n - x) + Rabs (x - Un m)).
+replace (Un n - Un m) with (Un n - x + (x - Un m));
+ [ apply Rabs_triang | ring ].
+rewrite (double_var eps); apply Rplus_lt_compat.
+apply H1; assumption.
+rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H1; assumption.
Qed.
(**********)
-Lemma maj_by_pos : (Un:nat->R) (sigTT R [l:R](Un_cv Un l)) -> (EXT l:R | ``0<l``/\((n:nat)``(Rabsolu (Un n))<=l``)).
-Intros; Elim X; Intros.
-Cut (sigTT R [l:R](Un_cv [k:nat](Rabsolu (Un k)) l)).
-Intro.
-Assert H := (CV_Cauchy [k:nat](Rabsolu (Un k)) X0).
-Assert H0 := (cauchy_bound [k:nat](Rabsolu (Un k)) H).
-Elim H0; Intros.
-Exists ``x0+1``.
-Cut ``0<=x0``.
-Intro.
-Split.
-Apply ge0_plus_gt0_is_gt0; [Assumption | Apply Rlt_R0_R1].
-Intros.
-Apply Rle_trans with x0.
-Unfold is_upper_bound in H1.
-Apply H1.
-Exists n; Reflexivity.
-Pattern 1 x0; Rewrite <- Rplus_Or; Apply Rle_compatibility; Left; Apply Rlt_R0_R1.
-Apply Rle_trans with (Rabsolu (Un O)).
-Apply Rabsolu_pos.
-Unfold is_upper_bound in H1.
-Apply H1.
-Exists O; Reflexivity.
-Apply existTT with (Rabsolu x).
-Apply cv_cvabs; Assumption.
+Lemma maj_by_pos :
+ forall Un:nat -> R,
+ sigT (fun l:R => Un_cv Un l) ->
+ exists l : R | 0 < l /\ (forall n:nat, Rabs (Un n) <= l).
+intros; elim X; intros.
+cut (sigT (fun l:R => Un_cv (fun k:nat => Rabs (Un k)) l)).
+intro.
+assert (H := CV_Cauchy (fun k:nat => Rabs (Un k)) X0).
+assert (H0 := cauchy_bound (fun k:nat => Rabs (Un k)) H).
+elim H0; intros.
+exists (x0 + 1).
+cut (0 <= x0).
+intro.
+split.
+apply Rplus_le_lt_0_compat; [ assumption | apply Rlt_0_1 ].
+intros.
+apply Rle_trans with x0.
+unfold is_upper_bound in H1.
+apply H1.
+exists n; reflexivity.
+pattern x0 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left;
+ apply Rlt_0_1.
+apply Rle_trans with (Rabs (Un 0%nat)).
+apply Rabs_pos.
+unfold is_upper_bound in H1.
+apply H1.
+exists 0%nat; reflexivity.
+apply existT with (Rabs x).
+apply cv_cvabs; assumption.
Qed.
(**********)
-Lemma CV_mult : (An,Bn:nat->R;l1,l2:R) (Un_cv An l1) -> (Un_cv Bn l2) -> (Un_cv [i:nat]``(An i)*(Bn i)`` ``l1*l2``).
-Intros.
-Cut (sigTT R [l:R](Un_cv An l)).
-Intro.
-Assert H1 := (maj_by_pos An X).
-Elim H1; Intros M H2.
-Elim H2; Intros.
-Unfold Un_cv; Unfold R_dist; Intros.
-Cut ``0<eps/(2*M)``.
-Intro.
-Case (Req_EM l2 R0); Intro.
-Unfold Un_cv in H0; Unfold R_dist in H0.
-Elim (H0 ``eps/(2*M)`` H6); Intros.
-Exists x; Intros.
-Apply Rle_lt_trans with ``(Rabsolu ((An n)*(Bn n)-(An n)*l2))+(Rabsolu ((An n)*l2-l1*l2))``.
-Replace ``(An n)*(Bn n)-l1*l2`` with ``((An n)*(Bn n)-(An n)*l2)+((An n)*l2-l1*l2)``; [Apply Rabsolu_triang | Ring].
-Replace ``(Rabsolu ((An n)*(Bn n)-(An n)*l2))`` with ``(Rabsolu (An n))*(Rabsolu ((Bn n)-l2))``.
-Replace ``(Rabsolu ((An n)*l2-l1*l2))`` with R0.
-Rewrite Rplus_Or.
-Apply Rle_lt_trans with ``M*(Rabsolu ((Bn n)-l2))``.
-Do 2 Rewrite <- (Rmult_sym ``(Rabsolu ((Bn n)-l2))``).
-Apply Rle_monotony.
-Apply Rabsolu_pos.
-Apply H4.
-Apply Rlt_monotony_contra with ``/M``.
-Apply Rlt_Rinv; Apply H3.
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l; Rewrite (Rmult_sym ``/M``).
-Apply Rlt_trans with ``eps/(2*M)``.
-Apply H8; Assumption.
-Unfold Rdiv; Rewrite Rinv_Rmult.
-Apply Rlt_monotony_contra with ``2``.
-Sup0.
-Replace ``2*(eps*(/2*/M))`` with ``(2*/2)*(eps*/M)``; [Idtac | Ring].
-Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1l; Rewrite double.
-Pattern 1 ``eps*/M``; Rewrite <- Rplus_Or.
-Apply Rlt_compatibility; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Assumption].
-DiscrR.
-DiscrR.
-Red; Intro; Rewrite H10 in H3; Elim (Rlt_antirefl ? H3).
-Red; Intro; Rewrite H10 in H3; Elim (Rlt_antirefl ? H3).
-Rewrite H7; Do 2 Rewrite Rmult_Or; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Reflexivity.
-Replace ``(An n)*(Bn n)-(An n)*l2`` with ``(An n)*((Bn n)-l2)``; [Idtac | Ring].
-Symmetry; Apply Rabsolu_mult.
-Cut ``0<eps/(2*(Rabsolu l2))``.
-Intro.
-Unfold Un_cv in H; Unfold R_dist in H; Unfold Un_cv in H0; Unfold R_dist in H0.
-Elim (H ``eps/(2*(Rabsolu l2))`` H8); Intros N1 H9.
-Elim (H0 ``eps/(2*M)`` H6); Intros N2 H10.
-Pose N := (max N1 N2).
-Exists N; Intros.
-Apply Rle_lt_trans with ``(Rabsolu ((An n)*(Bn n)-(An n)*l2))+(Rabsolu ((An n)*l2-l1*l2))``.
-Replace ``(An n)*(Bn n)-l1*l2`` with ``((An n)*(Bn n)-(An n)*l2)+((An n)*l2-l1*l2)``; [Apply Rabsolu_triang | Ring].
-Replace ``(Rabsolu ((An n)*(Bn n)-(An n)*l2))`` with ``(Rabsolu (An n))*(Rabsolu ((Bn n)-l2))``.
-Replace ``(Rabsolu ((An n)*l2-l1*l2))`` with ``(Rabsolu l2)*(Rabsolu ((An n)-l1))``.
-Rewrite (double_var eps); Apply Rplus_lt.
-Apply Rle_lt_trans with ``M*(Rabsolu ((Bn n)-l2))``.
-Do 2 Rewrite <- (Rmult_sym ``(Rabsolu ((Bn n)-l2))``).
-Apply Rle_monotony.
-Apply Rabsolu_pos.
-Apply H4.
-Apply Rlt_monotony_contra with ``/M``.
-Apply Rlt_Rinv; Apply H3.
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l; Rewrite (Rmult_sym ``/M``).
-Apply Rlt_le_trans with ``eps/(2*M)``.
-Apply H10.
-Unfold ge; Apply le_trans with N.
-Unfold N; Apply le_max_r.
-Assumption.
-Unfold Rdiv; Rewrite Rinv_Rmult.
-Right; Ring.
-DiscrR.
-Red; Intro; Rewrite H12 in H3; Elim (Rlt_antirefl ? H3).
-Red; Intro; Rewrite H12 in H3; Elim (Rlt_antirefl ? H3).
-Apply Rlt_monotony_contra with ``/(Rabsolu l2)``.
-Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption.
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l; Apply Rlt_le_trans with ``eps/(2*(Rabsolu l2))``.
-Apply H9.
-Unfold ge; Apply le_trans with N.
-Unfold N; Apply le_max_l.
-Assumption.
-Unfold Rdiv; Right; Rewrite Rinv_Rmult.
-Ring.
-DiscrR.
-Apply Rabsolu_no_R0; Assumption.
-Apply Rabsolu_no_R0; Assumption.
-Replace ``(An n)*l2-l1*l2`` with ``l2*((An n)-l1)``; [Symmetry; Apply Rabsolu_mult | Ring].
-Replace ``(An n)*(Bn n)-(An n)*l2`` with ``(An n)*((Bn n)-l2)``; [Symmetry; Apply Rabsolu_mult | Ring].
-Unfold Rdiv; Apply Rmult_lt_pos.
-Assumption.
-Apply Rlt_Rinv; Apply Rmult_lt_pos; [Sup0 | Apply Rabsolu_pos_lt; Assumption].
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Apply Rmult_lt_pos; [Sup0 | Assumption]].
-Apply existTT with l1; Assumption.
+Lemma CV_mult :
+ forall (An Bn:nat -> R) (l1 l2:R),
+ Un_cv An l1 -> Un_cv Bn l2 -> Un_cv (fun i:nat => An i * Bn i) (l1 * l2).
+intros.
+cut (sigT (fun l:R => Un_cv An l)).
+intro.
+assert (H1 := maj_by_pos An X).
+elim H1; intros M H2.
+elim H2; intros.
+unfold Un_cv in |- *; unfold R_dist in |- *; intros.
+cut (0 < eps / (2 * M)).
+intro.
+case (Req_dec l2 0); intro.
+unfold Un_cv in H0; unfold R_dist in H0.
+elim (H0 (eps / (2 * M)) H6); intros.
+exists x; intros.
+apply Rle_lt_trans with
+ (Rabs (An n * Bn n - An n * l2) + Rabs (An n * l2 - l1 * l2)).
+replace (An n * Bn n - l1 * l2) with
+ (An n * Bn n - An n * l2 + (An n * l2 - l1 * l2));
+ [ apply Rabs_triang | ring ].
+replace (Rabs (An n * Bn n - An n * l2)) with
+ (Rabs (An n) * Rabs (Bn n - l2)).
+replace (Rabs (An n * l2 - l1 * l2)) with 0.
+rewrite Rplus_0_r.
+apply Rle_lt_trans with (M * Rabs (Bn n - l2)).
+do 2 rewrite <- (Rmult_comm (Rabs (Bn n - l2))).
+apply Rmult_le_compat_l.
+apply Rabs_pos.
+apply H4.
+apply Rmult_lt_reg_l with (/ M).
+apply Rinv_0_lt_compat; apply H3.
+rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
+rewrite Rmult_1_l; rewrite (Rmult_comm (/ M)).
+apply Rlt_trans with (eps / (2 * M)).
+apply H8; assumption.
+unfold Rdiv in |- *; rewrite Rinv_mult_distr.
+apply Rmult_lt_reg_l with 2.
+prove_sup0.
+replace (2 * (eps * (/ 2 * / M))) with (2 * / 2 * (eps * / M));
+ [ idtac | ring ].
+rewrite <- Rinv_r_sym.
+rewrite Rmult_1_l; rewrite double.
+pattern (eps * / M) at 1 in |- *; rewrite <- Rplus_0_r.
+apply Rplus_lt_compat_l; apply Rmult_lt_0_compat;
+ [ assumption | apply Rinv_0_lt_compat; assumption ].
+discrR.
+discrR.
+red in |- *; intro; rewrite H10 in H3; elim (Rlt_irrefl _ H3).
+red in |- *; intro; rewrite H10 in H3; elim (Rlt_irrefl _ H3).
+rewrite H7; do 2 rewrite Rmult_0_r; unfold Rminus in |- *;
+ rewrite Rplus_opp_r; rewrite Rabs_R0; reflexivity.
+replace (An n * Bn n - An n * l2) with (An n * (Bn n - l2)); [ idtac | ring ].
+symmetry in |- *; apply Rabs_mult.
+cut (0 < eps / (2 * Rabs l2)).
+intro.
+unfold Un_cv in H; unfold R_dist in H; unfold Un_cv in H0;
+ unfold R_dist in H0.
+elim (H (eps / (2 * Rabs l2)) H8); intros N1 H9.
+elim (H0 (eps / (2 * M)) H6); intros N2 H10.
+pose (N := max N1 N2).
+exists N; intros.
+apply Rle_lt_trans with
+ (Rabs (An n * Bn n - An n * l2) + Rabs (An n * l2 - l1 * l2)).
+replace (An n * Bn n - l1 * l2) with
+ (An n * Bn n - An n * l2 + (An n * l2 - l1 * l2));
+ [ apply Rabs_triang | ring ].
+replace (Rabs (An n * Bn n - An n * l2)) with
+ (Rabs (An n) * Rabs (Bn n - l2)).
+replace (Rabs (An n * l2 - l1 * l2)) with (Rabs l2 * Rabs (An n - l1)).
+rewrite (double_var eps); apply Rplus_lt_compat.
+apply Rle_lt_trans with (M * Rabs (Bn n - l2)).
+do 2 rewrite <- (Rmult_comm (Rabs (Bn n - l2))).
+apply Rmult_le_compat_l.
+apply Rabs_pos.
+apply H4.
+apply Rmult_lt_reg_l with (/ M).
+apply Rinv_0_lt_compat; apply H3.
+rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
+rewrite Rmult_1_l; rewrite (Rmult_comm (/ M)).
+apply Rlt_le_trans with (eps / (2 * M)).
+apply H10.
+unfold ge in |- *; apply le_trans with N.
+unfold N in |- *; apply le_max_r.
+assumption.
+unfold Rdiv in |- *; rewrite Rinv_mult_distr.
+right; ring.
+discrR.
+red in |- *; intro; rewrite H12 in H3; elim (Rlt_irrefl _ H3).
+red in |- *; intro; rewrite H12 in H3; elim (Rlt_irrefl _ H3).
+apply Rmult_lt_reg_l with (/ Rabs l2).
+apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption.
+rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
+rewrite Rmult_1_l; apply Rlt_le_trans with (eps / (2 * Rabs l2)).
+apply H9.
+unfold ge in |- *; apply le_trans with N.
+unfold N in |- *; apply le_max_l.
+assumption.
+unfold Rdiv in |- *; right; rewrite Rinv_mult_distr.
+ring.
+discrR.
+apply Rabs_no_R0; assumption.
+apply Rabs_no_R0; assumption.
+replace (An n * l2 - l1 * l2) with (l2 * (An n - l1));
+ [ symmetry in |- *; apply Rabs_mult | ring ].
+replace (An n * Bn n - An n * l2) with (An n * (Bn n - l2));
+ [ symmetry in |- *; apply Rabs_mult | ring ].
+unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+assumption.
+apply Rinv_0_lt_compat; apply Rmult_lt_0_compat;
+ [ prove_sup0 | apply Rabs_pos_lt; assumption ].
+unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ [ assumption
+ | apply Rinv_0_lt_compat; apply Rmult_lt_0_compat;
+ [ prove_sup0 | assumption ] ].
+apply existT with l1; assumption.
Qed.
-Lemma tech9 : (Un:nat->R) (Un_growing Un) -> ((m,n:nat)(le m n)->``(Un m)<=(Un n)``).
-Intros; Unfold Un_growing in H.
-Induction n.
-Induction m.
-Right; Reflexivity.
-Elim (le_Sn_O ? H0).
-Cut (le m n)\/m=(S n).
-Intro; Elim H1; Intro.
-Apply Rle_trans with (Un n).
-Apply Hrecn; Assumption.
-Apply H.
-Rewrite H2; Right; Reflexivity.
-Inversion H0.
-Right; Reflexivity.
-Left; Assumption.
+Lemma tech9 :
+ forall Un:nat -> R,
+ Un_growing Un -> forall m n:nat, (m <= n)%nat -> Un m <= Un n.
+intros; unfold Un_growing in H.
+induction n as [| n Hrecn].
+induction m as [| m Hrecm].
+right; reflexivity.
+elim (le_Sn_O _ H0).
+cut ((m <= n)%nat \/ m = S n).
+intro; elim H1; intro.
+apply Rle_trans with (Un n).
+apply Hrecn; assumption.
+apply H.
+rewrite H2; right; reflexivity.
+inversion H0.
+right; reflexivity.
+left; assumption.
Qed.
-Lemma tech10 : (Un:nat->R;x:R) (Un_growing Un) -> (is_lub (EUn Un) x) -> (Un_cv Un x).
-Intros; Cut (bound (EUn Un)).
-Intro; Assert H2 := (Un_cv_crit ? H H1).
-Elim H2; Intros.
-Case (total_order_T x x0); Intro.
-Elim s; Intro.
-Cut (n:nat)``(Un n)<=x``.
-Intro; Unfold Un_cv in H3; Cut ``0<x0-x``.
-Intro; Elim (H3 ``x0-x`` H5); Intros.
-Cut (ge x1 x1).
-Intro; Assert H8 := (H6 x1 H7).
-Unfold R_dist in H8; Rewrite Rabsolu_left1 in H8.
-Rewrite Ropp_distr2 in H8; Unfold Rminus in H8.
-Assert H9 := (Rlt_anti_compatibility ``x0`` ? ? H8).
-Assert H10 := (Ropp_Rlt ? ? H9).
-Assert H11 := (H4 x1).
-Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? H10 H11)).
-Apply Rle_minus; Apply Rle_trans with x.
-Apply H4.
-Left; Assumption.
-Unfold ge; Apply le_n.
-Apply Rgt_minus; Assumption.
-Intro; Unfold is_lub in H0; Unfold is_upper_bound in H0; Elim H0; Intros.
-Apply H4; Unfold EUn; Exists n; Reflexivity.
-Rewrite b; Assumption.
-Cut ((n:nat)``(Un n)<=x0``).
-Intro; Unfold is_lub in H0; Unfold is_upper_bound in H0; Elim H0; Intros.
-Cut (y:R)(EUn Un y)->``y<=x0``.
-Intro; Assert H8 := (H6 ? H7).
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H8 r)).
-Unfold EUn; Intros; Elim H7; Intros.
-Rewrite H8; Apply H4.
-Intro; Case (total_order_Rle (Un n) x0); Intro.
-Assumption.
-Cut (n0:nat)(le n n0) -> ``x0<(Un n0)``.
-Intro; Unfold Un_cv in H3; Cut ``0<(Un n)-x0``.
-Intro; Elim (H3 ``(Un n)-x0`` H5); Intros.
-Cut (ge (max n x1) x1).
-Intro; Assert H8 := (H6 (max n x1) H7).
-Unfold R_dist in H8.
-Rewrite Rabsolu_right in H8.
-Unfold Rminus in H8; Do 2 Rewrite <- (Rplus_sym ``-x0``) in H8.
-Assert H9 := (Rlt_anti_compatibility ? ? ? H8).
-Cut ``(Un n)<=(Un (max n x1))``.
-Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H10 H9)).
-Apply tech9; [Assumption | Apply le_max_l].
-Apply Rge_trans with ``(Un n)-x0``.
-Unfold Rminus; Apply Rle_sym1; Do 2 Rewrite <- (Rplus_sym ``-x0``); Apply Rle_compatibility.
-Apply tech9; [Assumption | Apply le_max_l].
-Left; Assumption.
-Unfold ge; Apply le_max_r.
-Apply Rlt_anti_compatibility with x0.
-Rewrite Rplus_Or; Unfold Rminus; Rewrite (Rplus_sym x0); Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Apply H4; Apply le_n.
-Intros; Apply Rlt_le_trans with (Un n).
-Case (total_order_Rlt_Rle x0 (Un n)); Intro.
-Assumption.
-Elim n0; Assumption.
-Apply tech9; Assumption.
-Unfold bound; Exists x; Unfold is_lub in H0; Elim H0; Intros; Assumption.
+Lemma tech10 :
+ forall (Un:nat -> R) (x:R), Un_growing Un -> is_lub (EUn Un) x -> Un_cv Un x.
+intros; cut (bound (EUn Un)).
+intro; assert (H2 := Un_cv_crit _ H H1).
+elim H2; intros.
+case (total_order_T x x0); intro.
+elim s; intro.
+cut (forall n:nat, Un n <= x).
+intro; unfold Un_cv in H3; cut (0 < x0 - x).
+intro; elim (H3 (x0 - x) H5); intros.
+cut (x1 >= x1)%nat.
+intro; assert (H8 := H6 x1 H7).
+unfold R_dist in H8; rewrite Rabs_left1 in H8.
+rewrite Ropp_minus_distr in H8; unfold Rminus in H8.
+assert (H9 := Rplus_lt_reg_r x0 _ _ H8).
+assert (H10 := Ropp_lt_cancel _ _ H9).
+assert (H11 := H4 x1).
+elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H10 H11)).
+apply Rle_minus; apply Rle_trans with x.
+apply H4.
+left; assumption.
+unfold ge in |- *; apply le_n.
+apply Rgt_minus; assumption.
+intro; unfold is_lub in H0; unfold is_upper_bound in H0; elim H0; intros.
+apply H4; unfold EUn in |- *; exists n; reflexivity.
+rewrite b; assumption.
+cut (forall n:nat, Un n <= x0).
+intro; unfold is_lub in H0; unfold is_upper_bound in H0; elim H0; intros.
+cut (forall y:R, EUn Un y -> y <= x0).
+intro; assert (H8 := H6 _ H7).
+elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H8 r)).
+unfold EUn in |- *; intros; elim H7; intros.
+rewrite H8; apply H4.
+intro; case (Rle_dec (Un n) x0); intro.
+assumption.
+cut (forall n0:nat, (n <= n0)%nat -> x0 < Un n0).
+intro; unfold Un_cv in H3; cut (0 < Un n - x0).
+intro; elim (H3 (Un n - x0) H5); intros.
+cut (max n x1 >= x1)%nat.
+intro; assert (H8 := H6 (max n x1) H7).
+unfold R_dist in H8.
+rewrite Rabs_right in H8.
+unfold Rminus in H8; do 2 rewrite <- (Rplus_comm (- x0)) in H8.
+assert (H9 := Rplus_lt_reg_r _ _ _ H8).
+cut (Un n <= Un (max n x1)).
+intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H10 H9)).
+apply tech9; [ assumption | apply le_max_l ].
+apply Rge_trans with (Un n - x0).
+unfold Rminus in |- *; apply Rle_ge; do 2 rewrite <- (Rplus_comm (- x0));
+ apply Rplus_le_compat_l.
+apply tech9; [ assumption | apply le_max_l ].
+left; assumption.
+unfold ge in |- *; apply le_max_r.
+apply Rplus_lt_reg_r with x0.
+rewrite Rplus_0_r; unfold Rminus in |- *; rewrite (Rplus_comm x0);
+ rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r;
+ apply H4; apply le_n.
+intros; apply Rlt_le_trans with (Un n).
+case (Rlt_le_dec x0 (Un n)); intro.
+assumption.
+elim n0; assumption.
+apply tech9; assumption.
+unfold bound in |- *; exists x; unfold is_lub in H0; elim H0; intros;
+ assumption.
Qed.
-Lemma tech13 : (An:nat->R;k:R) ``0<=k<1`` -> (Un_cv [n:nat](Rabsolu ``(An (S n))/(An n)``) k) -> (EXT k0 : R | ``k<k0<1`` /\ (EX N:nat | (n:nat) (le N n)->``(Rabsolu ((An (S n))/(An n)))<k0``)).
-Intros; Exists ``k+(1-k)/2``.
-Split.
-Split.
-Pattern 1 k; Rewrite <- Rplus_Or; Apply Rlt_compatibility.
-Unfold Rdiv; Apply Rmult_lt_pos.
-Apply Rlt_anti_compatibility with k; Rewrite Rplus_Or; Replace ``k+(1-k)`` with R1; [Elim H; Intros; Assumption | Ring].
-Apply Rlt_Rinv; Sup0.
-Apply Rlt_monotony_contra with ``2``.
-Sup0.
-Unfold Rdiv; Rewrite Rmult_1r; Rewrite Rmult_Rplus_distr; Pattern 1 ``2``; Rewrite Rmult_sym; Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Idtac | DiscrR]; Rewrite Rmult_1r; Replace ``2*k+(1-k)`` with ``1+k``; [Idtac | Ring].
-Elim H; Intros.
-Apply Rlt_compatibility; Assumption.
-Unfold Un_cv in H0; Cut ``0<(1-k)/2``.
-Intro; Elim (H0 ``(1-k)/2`` H1); Intros.
-Exists x; Intros.
-Assert H4 := (H2 n H3).
-Unfold R_dist in H4; Rewrite <- Rabsolu_Rabsolu; Replace ``(Rabsolu ((An (S n))/(An n)))`` with ``((Rabsolu ((An (S n))/(An n)))-k)+k``; [Idtac | Ring]; Apply Rle_lt_trans with ``(Rabsolu ((Rabsolu ((An (S n))/(An n)))-k))+(Rabsolu k)``.
-Apply Rabsolu_triang.
-Rewrite (Rabsolu_right k).
-Apply Rlt_anti_compatibility with ``-k``; Rewrite <- (Rplus_sym k); Repeat Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Repeat Rewrite Rplus_Ol; Apply H4.
-Apply Rle_sym1; Elim H; Intros; Assumption.
-Unfold Rdiv; Apply Rmult_lt_pos.
-Apply Rlt_anti_compatibility with k; Rewrite Rplus_Or; Elim H; Intros; Replace ``k+(1-k)`` with R1; [Assumption | Ring].
-Apply Rlt_Rinv; Sup0.
+Lemma tech13 :
+ forall (An:nat -> R) (k:R),
+ 0 <= k < 1 ->
+ Un_cv (fun n:nat => Rabs (An (S n) / An n)) k ->
+ exists k0 : R
+ | k < k0 < 1 /\
+ ( exists N : nat
+ | (forall n:nat, (N <= n)%nat -> Rabs (An (S n) / An n) < k0)).
+intros; exists (k + (1 - k) / 2).
+split.
+split.
+pattern k at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l.
+unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+apply Rplus_lt_reg_r with k; rewrite Rplus_0_r; replace (k + (1 - k)) with 1;
+ [ elim H; intros; assumption | ring ].
+apply Rinv_0_lt_compat; prove_sup0.
+apply Rmult_lt_reg_l with 2.
+prove_sup0.
+unfold Rdiv in |- *; rewrite Rmult_1_r; rewrite Rmult_plus_distr_l;
+ pattern 2 at 1 in |- *; rewrite Rmult_comm; rewrite Rmult_assoc;
+ rewrite <- Rinv_l_sym; [ idtac | discrR ]; rewrite Rmult_1_r;
+ replace (2 * k + (1 - k)) with (1 + k); [ idtac | ring ].
+elim H; intros.
+apply Rplus_lt_compat_l; assumption.
+unfold Un_cv in H0; cut (0 < (1 - k) / 2).
+intro; elim (H0 ((1 - k) / 2) H1); intros.
+exists x; intros.
+assert (H4 := H2 n H3).
+unfold R_dist in H4; rewrite <- Rabs_Rabsolu;
+ replace (Rabs (An (S n) / An n)) with (Rabs (An (S n) / An n) - k + k);
+ [ idtac | ring ];
+ apply Rle_lt_trans with (Rabs (Rabs (An (S n) / An n) - k) + Rabs k).
+apply Rabs_triang.
+rewrite (Rabs_right k).
+apply Rplus_lt_reg_r with (- k); rewrite <- (Rplus_comm k);
+ repeat rewrite <- Rplus_assoc; rewrite Rplus_opp_l;
+ repeat rewrite Rplus_0_l; apply H4.
+apply Rle_ge; elim H; intros; assumption.
+unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+apply Rplus_lt_reg_r with k; rewrite Rplus_0_r; elim H; intros;
+ replace (k + (1 - k)) with 1; [ assumption | ring ].
+apply Rinv_0_lt_compat; prove_sup0.
Qed.
(**********)
-Lemma growing_ineq : (Un:nat->R;l:R) (Un_growing Un) -> (Un_cv Un l) -> ((n:nat)``(Un n)<=l``).
-Intros; Case (total_order_T (Un n) l); Intro.
-Elim s; Intro.
-Left; Assumption.
-Right; Assumption.
-Cut ``0<(Un n)-l``.
-Intro; Unfold Un_cv in H0; Unfold R_dist in H0.
-Elim (H0 ``(Un n)-l`` H1); Intros N1 H2.
-Pose N := (max n N1).
-Cut ``(Un n)-l<=(Un N)-l``.
-Intro; Cut ``(Un N)-l<(Un n)-l``.
-Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H3 H4)).
-Apply Rle_lt_trans with ``(Rabsolu ((Un N)-l))``.
-Apply Rle_Rabsolu.
-Apply H2.
-Unfold ge N; Apply le_max_r.
-Unfold Rminus; Do 2 Rewrite <- (Rplus_sym ``-l``); Apply Rle_compatibility.
-Apply tech9.
-Assumption.
-Unfold N; Apply le_max_l.
-Apply Rlt_anti_compatibility with l.
-Rewrite Rplus_Or.
-Replace ``l+((Un n)-l)`` with (Un n); [Assumption | Ring].
+Lemma growing_ineq :
+ forall (Un:nat -> R) (l:R),
+ Un_growing Un -> Un_cv Un l -> forall n:nat, Un n <= l.
+intros; case (total_order_T (Un n) l); intro.
+elim s; intro.
+left; assumption.
+right; assumption.
+cut (0 < Un n - l).
+intro; unfold Un_cv in H0; unfold R_dist in H0.
+elim (H0 (Un n - l) H1); intros N1 H2.
+pose (N := max n N1).
+cut (Un n - l <= Un N - l).
+intro; cut (Un N - l < Un n - l).
+intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H3 H4)).
+apply Rle_lt_trans with (Rabs (Un N - l)).
+apply RRle_abs.
+apply H2.
+unfold ge, N in |- *; apply le_max_r.
+unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (- l));
+ apply Rplus_le_compat_l.
+apply tech9.
+assumption.
+unfold N in |- *; apply le_max_l.
+apply Rplus_lt_reg_r with l.
+rewrite Rplus_0_r.
+replace (l + (Un n - l)) with (Un n); [ assumption | ring ].
Qed.
(* Un->l => (-Un) -> (-l) *)
-Lemma CV_opp : (An:nat->R;l:R) (Un_cv An l) -> (Un_cv (opp_seq An) ``-l``).
-Intros An l.
-Unfold Un_cv; Unfold R_dist; Intros.
-Elim (H eps H0); Intros.
-Exists x; Intros.
-Unfold opp_seq; Replace ``-(An n)- (-l)`` with ``-((An n)-l)``; [Rewrite Rabsolu_Ropp | Ring].
-Apply H1; Assumption.
+Lemma CV_opp :
+ forall (An:nat -> R) (l:R), Un_cv An l -> Un_cv (opp_seq An) (- l).
+intros An l.
+unfold Un_cv in |- *; unfold R_dist in |- *; intros.
+elim (H eps H0); intros.
+exists x; intros.
+unfold opp_seq in |- *; replace (- An n - - l) with (- (An n - l));
+ [ rewrite Rabs_Ropp | ring ].
+apply H1; assumption.
Qed.
(**********)
-Lemma decreasing_ineq : (Un:nat->R;l:R) (Un_decreasing Un) -> (Un_cv Un l) -> ((n:nat)``l<=(Un n)``).
-Intros.
-Assert H1 := (decreasing_growing ? H).
-Assert H2 := (CV_opp ? ? H0).
-Assert H3 := (growing_ineq ? ? H1 H2).
-Apply Ropp_Rle.
-Unfold opp_seq in H3; Apply H3.
+Lemma decreasing_ineq :
+ forall (Un:nat -> R) (l:R),
+ Un_decreasing Un -> Un_cv Un l -> forall n:nat, l <= Un n.
+intros.
+assert (H1 := decreasing_growing _ H).
+assert (H2 := CV_opp _ _ H0).
+assert (H3 := growing_ineq _ _ H1 H2).
+apply Ropp_le_cancel.
+unfold opp_seq in H3; apply H3.
Qed.
(**********)
-Lemma CV_minus : (An,Bn:nat->R;l1,l2:R) (Un_cv An l1) -> (Un_cv Bn l2) -> (Un_cv [i:nat]``(An i)-(Bn i)`` ``l1-l2``).
-Intros.
-Replace [i:nat]``(An i)-(Bn i)`` with [i:nat]``(An i)+((opp_seq Bn) i)``.
-Unfold Rminus; Apply CV_plus.
-Assumption.
-Apply CV_opp; Assumption.
-Unfold Rminus opp_seq; Reflexivity.
+Lemma CV_minus :
+ forall (An Bn:nat -> R) (l1 l2:R),
+ Un_cv An l1 -> Un_cv Bn l2 -> Un_cv (fun i:nat => An i - Bn i) (l1 - l2).
+intros.
+replace (fun i:nat => An i - Bn i) with (fun i:nat => An i + opp_seq Bn i).
+unfold Rminus in |- *; apply CV_plus.
+assumption.
+apply CV_opp; assumption.
+unfold Rminus, opp_seq in |- *; reflexivity.
Qed.
(* Un -> +oo *)
-Definition cv_infty [Un:nat->R] : Prop := (M:R)(EXT N:nat | (n:nat) (le N n) -> ``M<(Un n)``).
+Definition cv_infty (Un:nat -> R) : Prop :=
+ forall M:R, exists N : nat | (forall n:nat, (N <= n)%nat -> M < Un n).
(* Un -> +oo => /Un -> O *)
-Lemma cv_infty_cv_R0 : (Un:nat->R) ((n:nat)``(Un n)<>0``) -> (cv_infty Un) -> (Un_cv [n:nat]``/(Un n)`` R0).
-Unfold cv_infty Un_cv; Unfold R_dist; Intros.
-Elim (H0 ``/eps``); Intros N0 H2.
-Exists N0; Intros.
-Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite (Rabsolu_Rinv ? (H n)).
-Apply Rlt_monotony_contra with (Rabsolu (Un n)).
-Apply Rabsolu_pos_lt; Apply H.
-Rewrite <- Rinv_r_sym.
-Apply Rlt_monotony_contra with ``/eps``.
-Apply Rlt_Rinv; Assumption.
-Rewrite Rmult_1r; Rewrite (Rmult_sym ``/eps``); Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Apply Rlt_le_trans with (Un n).
-Apply H2; Assumption.
-Apply Rle_Rabsolu.
-Red; Intro; Rewrite H4 in H1; Elim (Rlt_antirefl ? H1).
-Apply Rabsolu_no_R0; Apply H.
+Lemma cv_infty_cv_R0 :
+ forall Un:nat -> R,
+ (forall n:nat, Un n <> 0) -> cv_infty Un -> Un_cv (fun n:nat => / Un n) 0.
+unfold cv_infty, Un_cv in |- *; unfold R_dist in |- *; intros.
+elim (H0 (/ eps)); intros N0 H2.
+exists N0; intros.
+unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r;
+ rewrite (Rabs_Rinv _ (H n)).
+apply Rmult_lt_reg_l with (Rabs (Un n)).
+apply Rabs_pos_lt; apply H.
+rewrite <- Rinv_r_sym.
+apply Rmult_lt_reg_l with (/ eps).
+apply Rinv_0_lt_compat; assumption.
+rewrite Rmult_1_r; rewrite (Rmult_comm (/ eps)); rewrite Rmult_assoc;
+ rewrite <- Rinv_r_sym.
+rewrite Rmult_1_r; apply Rlt_le_trans with (Un n).
+apply H2; assumption.
+apply RRle_abs.
+red in |- *; intro; rewrite H4 in H1; elim (Rlt_irrefl _ H1).
+apply Rabs_no_R0; apply H.
Qed.
(**********)
-Lemma decreasing_prop : (Un:nat->R;m,n:nat) (Un_decreasing Un) -> (le m n) -> ``(Un n)<=(Un m)``.
-Unfold Un_decreasing; Intros.
-Induction n.
-Induction m.
-Right; Reflexivity.
-Elim (le_Sn_O ? H0).
-Cut (le m n)\/m=(S n).
-Intro; Elim H1; Intro.
-Apply Rle_trans with (Un n).
-Apply H.
-Apply Hrecn; Assumption.
-Rewrite H2; Right; Reflexivity.
-Inversion H0; [Right; Reflexivity | Left; Assumption].
+Lemma decreasing_prop :
+ forall (Un:nat -> R) (m n:nat),
+ Un_decreasing Un -> (m <= n)%nat -> Un n <= Un m.
+unfold Un_decreasing in |- *; intros.
+induction n as [| n Hrecn].
+induction m as [| m Hrecm].
+right; reflexivity.
+elim (le_Sn_O _ H0).
+cut ((m <= n)%nat \/ m = S n).
+intro; elim H1; intro.
+apply Rle_trans with (Un n).
+apply H.
+apply Hrecn; assumption.
+rewrite H2; right; reflexivity.
+inversion H0; [ right; reflexivity | left; assumption ].
Qed.
(* |x|^n/n! -> 0 *)
-Lemma cv_speed_pow_fact : (x:R) (Un_cv [n:nat]``(pow x n)/(INR (fact n))`` R0).
-Intro; Cut (Un_cv [n:nat]``(pow (Rabsolu x) n)/(INR (fact n))`` R0) -> (Un_cv [n:nat]``(pow x n)/(INR (fact n))`` ``0``).
-Intro; Apply H.
-Unfold Un_cv; Unfold R_dist; Intros; Case (Req_EM x R0); Intro.
-Exists (S O); Intros.
-Rewrite H1; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_R0; Rewrite pow_ne_zero; [Unfold Rdiv; Rewrite Rmult_Ol; Rewrite Rabsolu_R0; Assumption | Red; Intro; Rewrite H3 in H2; Elim (le_Sn_n ? H2)].
-Assert H2 := (Rabsolu_pos_lt x H1); Pose M := (up (Rabsolu x)); Cut `0<=M`.
-Intro; Elim (IZN M H3); Intros M_nat H4.
-Pose Un := [n:nat]``(pow (Rabsolu x) (plus M_nat n))/(INR (fact (plus M_nat n)))``.
-Cut (Un_cv Un R0); Unfold Un_cv; Unfold R_dist; Intros.
-Elim (H5 eps H0); Intros N H6.
-Exists (plus M_nat N); Intros; Cut (EX p:nat | (ge p N)/\n=(plus M_nat p)).
-Intro; Elim H8; Intros p H9.
-Elim H9; Intros; Rewrite H11; Unfold Un in H6; Apply H6; Assumption.
-Exists (minus n M_nat).
-Split.
-Unfold ge; Apply simpl_le_plus_l with M_nat; Rewrite <- le_plus_minus.
-Assumption.
-Apply le_trans with (plus M_nat N).
-Apply le_plus_l.
-Assumption.
-Apply le_plus_minus; Apply le_trans with (plus M_nat N); [Apply le_plus_l | Assumption].
-Pose Vn := [n:nat]``(Rabsolu x)*(Un O)/(INR (S n))``.
-Cut (le (1) M_nat).
-Intro; Cut (n:nat)``0<(Un n)``.
-Intro; Cut (Un_decreasing Un).
-Intro; Cut (n:nat)``(Un (S n))<=(Vn n)``.
-Intro; Cut (Un_cv Vn R0).
-Unfold Un_cv; Unfold R_dist; Intros.
-Elim (H10 eps0 H5); Intros N1 H11.
-Exists (S N1); Intros.
-Cut (n:nat)``0<(Vn n)``.
-Intro; Apply Rle_lt_trans with ``(Rabsolu ((Vn (pred n))-0))``.
-Repeat Rewrite Rabsolu_right.
-Unfold Rminus; Rewrite Ropp_O; Do 2 Rewrite Rplus_Or; Replace n with (S (pred n)).
-Apply H9.
-Inversion H12; Simpl; Reflexivity.
-Apply Rle_sym1; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Left; Apply H13.
-Apply Rle_sym1; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Left; Apply H7.
-Apply H11; Unfold ge; Apply le_S_n; Replace (S (pred n)) with n; [Unfold ge in H12; Exact H12 | Inversion H12; Simpl; Reflexivity].
-Intro; Apply Rlt_le_trans with (Un (S n0)); [Apply H7 | Apply H9].
-Cut (cv_infty [n:nat](INR (S n))).
-Intro; Cut (Un_cv [n:nat]``/(INR (S n))`` R0).
-Unfold Un_cv R_dist; Intros; Unfold Vn.
-Cut ``0<eps1/((Rabsolu x)*(Un O))``.
-Intro; Elim (H11 ? H13); Intros N H14.
-Exists N; Intros; Replace ``(Rabsolu x)*(Un O)/(INR (S n))-0`` with ``((Rabsolu x)*(Un O))*(/(INR (S n))-0)``; [Idtac | Unfold Rdiv; Ring].
-Rewrite Rabsolu_mult; Apply Rlt_monotony_contra with ``/(Rabsolu ((Rabsolu x)*(Un O)))``.
-Apply Rlt_Rinv; Apply Rabsolu_pos_lt.
-Apply prod_neq_R0.
-Apply Rabsolu_no_R0; Assumption.
-Assert H16 := (H7 O); Red; Intro; Rewrite H17 in H16; Elim (Rlt_antirefl ? H16).
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l.
-Replace ``/(Rabsolu ((Rabsolu x)*(Un O)))*eps1`` with ``eps1/((Rabsolu x)*(Un O))``.
-Apply H14; Assumption.
-Unfold Rdiv; Rewrite (Rabsolu_right ``(Rabsolu x)*(Un O)``).
-Apply Rmult_sym.
-Apply Rle_sym1; Apply Rmult_le_pos.
-Apply Rabsolu_pos.
-Left; Apply H7.
-Apply Rabsolu_no_R0.
-Apply prod_neq_R0; [Apply Rabsolu_no_R0; Assumption | Assert H16 := (H7 O); Red; Intro; Rewrite H17 in H16; Elim (Rlt_antirefl ? H16)].
-Unfold Rdiv; Apply Rmult_lt_pos.
-Assumption.
-Apply Rlt_Rinv; Apply Rmult_lt_pos.
-Apply Rabsolu_pos_lt; Assumption.
-Apply H7.
-Apply (cv_infty_cv_R0 [n:nat]``(INR (S n))``).
-Intro; Apply not_O_INR; Discriminate.
-Assumption.
-Unfold cv_infty; Intro; Case (total_order_T M0 R0); Intro.
-Elim s; Intro.
-Exists O; Intros.
-Apply Rlt_trans with R0; [Assumption | Apply lt_INR_0; Apply lt_O_Sn].
-Exists O; Intros; Rewrite b; Apply lt_INR_0; Apply lt_O_Sn.
-Pose M0_z := (up M0).
-Assert H10 := (archimed M0).
-Cut `0<=M0_z`.
-Intro; Elim (IZN ? H11); Intros M0_nat H12.
-Exists M0_nat; Intros.
-Apply Rlt_le_trans with (IZR M0_z).
-Elim H10; Intros; Assumption.
-Rewrite H12; Rewrite <- INR_IZR_INZ; Apply le_INR.
-Apply le_trans with n; [Assumption | Apply le_n_Sn].
-Apply le_IZR; Left; Simpl; Unfold M0_z; Apply Rlt_trans with M0; [Assumption | Elim H10; Intros; Assumption].
-Intro; Apply Rle_trans with ``(Rabsolu x)*(Un n)*/(INR (S n))``.
-Unfold Un; Replace (plus M_nat (S n)) with (plus (plus M_nat n) (1)).
-Rewrite pow_add; Replace (pow (Rabsolu x) (S O)) with (Rabsolu x); [Idtac | Simpl; Ring].
-Unfold Rdiv; Rewrite <- (Rmult_sym (Rabsolu x)); Repeat Rewrite Rmult_assoc; Repeat Apply Rle_monotony.
-Apply Rabsolu_pos.
-Left; Apply pow_lt; Assumption.
-Replace (plus (plus M_nat n) (S O)) with (S (plus M_nat n)).
-Rewrite fact_simpl; Rewrite mult_sym; Rewrite mult_INR; Rewrite Rinv_Rmult.
-Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Apply lt_INR_0; Apply neq_O_lt; Red; Intro; Assert H10 := (sym_eq ? ? ? H9); Elim (fact_neq_0 ? H10).
-Left; Apply Rinv_lt.
-Apply Rmult_lt_pos; Apply lt_INR_0; Apply lt_O_Sn.
-Apply lt_INR; Apply lt_n_S.
-Pattern 1 n; Replace n with (plus O n); [Idtac | Reflexivity].
-Apply lt_reg_r.
-Apply lt_le_trans with (S O); [Apply lt_O_Sn | Assumption].
-Apply INR_fact_neq_0.
-Apply not_O_INR; Discriminate.
-Apply INR_eq; Rewrite S_INR; Do 3 Rewrite plus_INR; Reflexivity.
-Apply INR_eq; Do 3 Rewrite plus_INR; Do 2 Rewrite S_INR; Ring.
-Unfold Vn; Rewrite Rmult_assoc; Unfold Rdiv; Rewrite (Rmult_sym (Un O)); Rewrite (Rmult_sym (Un n)).
-Repeat Apply Rle_monotony.
-Apply Rabsolu_pos.
-Left; Apply Rlt_Rinv; Apply lt_INR_0; Apply lt_O_Sn.
-Apply decreasing_prop; [Assumption | Apply le_O_n].
-Unfold Un_decreasing; Intro; Unfold Un.
-Replace (plus M_nat (S n)) with (plus (plus M_nat n) (1)).
-Rewrite pow_add; Unfold Rdiv; Rewrite Rmult_assoc; Apply Rle_monotony.
-Left; Apply pow_lt; Assumption.
-Replace (pow (Rabsolu x) (S O)) with (Rabsolu x); [Idtac | Simpl; Ring].
-Replace (plus (plus M_nat n) (S O)) with (S (plus M_nat n)).
-Apply Rle_monotony_contra with (INR (fact (S (plus M_nat n)))).
-Apply lt_INR_0; Apply neq_O_lt; Red; Intro; Assert H9 := (sym_eq ? ? ? H8); Elim (fact_neq_0 ? H9).
-Rewrite (Rmult_sym (Rabsolu x)); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1l.
-Rewrite fact_simpl; Rewrite mult_INR; Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Apply Rle_trans with (INR M_nat).
-Left; Rewrite INR_IZR_INZ.
-Rewrite <- H4; Assert H8 := (archimed (Rabsolu x)); Elim H8; Intros; Assumption.
-Apply le_INR; Apply le_trans with (S M_nat); [Apply le_n_Sn | Apply le_n_S; Apply le_plus_l].
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply INR_eq; Rewrite S_INR; Do 3 Rewrite plus_INR; Reflexivity.
-Apply INR_eq; Do 3 Rewrite plus_INR; Do 2 Rewrite S_INR; Ring.
-Intro; Unfold Un; Unfold Rdiv; Apply Rmult_lt_pos.
-Apply pow_lt; Assumption.
-Apply Rlt_Rinv; Apply lt_INR_0; Apply neq_O_lt; Red; Intro; Assert H8 := (sym_eq ? ? ? H7); Elim (fact_neq_0 ? H8).
-Clear Un Vn; Apply INR_le; Simpl.
-Induction M_nat.
-Assert H6 := (archimed (Rabsolu x)); Fold M in H6; Elim H6; Intros.
-Rewrite H4 in H7; Rewrite <- INR_IZR_INZ in H7.
-Simpl in H7; Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H2 H7)).
-Replace R1 with (INR (S O)); [Apply le_INR | Reflexivity]; Apply le_n_S; Apply le_O_n.
-Apply le_IZR; Simpl; Left; Apply Rlt_trans with (Rabsolu x).
-Assumption.
-Elim (archimed (Rabsolu x)); Intros; Assumption.
-Unfold Un_cv; Unfold R_dist; Intros; Elim (H eps H0); Intros.
-Exists x0; Intros; Apply Rle_lt_trans with ``(Rabsolu ((pow (Rabsolu x) n)/(INR (fact n))-0))``.
-Unfold Rminus; Rewrite Ropp_O; Do 2 Rewrite Rplus_Or; Rewrite (Rabsolu_right ``(pow (Rabsolu x) n)/(INR (fact n))``).
-Unfold Rdiv; Rewrite Rabsolu_mult; Rewrite (Rabsolu_right ``/(INR (fact n))``).
-Rewrite Pow_Rabsolu; Right; Reflexivity.
-Apply Rle_sym1; Left; Apply Rlt_Rinv; Apply lt_INR_0; Apply neq_O_lt; Red; Intro; Assert H4 := (sym_eq ? ? ? H3); Elim (fact_neq_0 ? H4).
-Apply Rle_sym1; Unfold Rdiv; Apply Rmult_le_pos.
-Case (Req_EM x R0); Intro.
-Rewrite H3; Rewrite Rabsolu_R0.
-Induction n; [Simpl; Left; Apply Rlt_R0_R1 | Simpl; Rewrite Rmult_Ol; Right; Reflexivity].
-Left; Apply pow_lt; Apply Rabsolu_pos_lt; Assumption.
-Left; Apply Rlt_Rinv; Apply lt_INR_0; Apply neq_O_lt; Red; Intro; Assert H4 := (sym_eq ? ? ? H3); Elim (fact_neq_0 ? H4).
-Apply H1; Assumption.
-Qed.
+Lemma cv_speed_pow_fact :
+ forall x:R, Un_cv (fun n:nat => x ^ n / INR (fact n)) 0.
+intro;
+ cut
+ (Un_cv (fun n:nat => Rabs x ^ n / INR (fact n)) 0 ->
+ Un_cv (fun n:nat => x ^ n / INR (fact n)) 0).
+intro; apply H.
+unfold Un_cv in |- *; unfold R_dist in |- *; intros; case (Req_dec x 0);
+ intro.
+exists 1%nat; intros.
+rewrite H1; unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r;
+ rewrite Rabs_R0; rewrite pow_ne_zero;
+ [ unfold Rdiv in |- *; rewrite Rmult_0_l; rewrite Rabs_R0; assumption
+ | red in |- *; intro; rewrite H3 in H2; elim (le_Sn_n _ H2) ].
+assert (H2 := Rabs_pos_lt x H1); pose (M := up (Rabs x)); cut (0 <= M)%Z.
+intro; elim (IZN M H3); intros M_nat H4.
+pose (Un := fun n:nat => Rabs x ^ (M_nat + n) / INR (fact (M_nat + n))).
+cut (Un_cv Un 0); unfold Un_cv in |- *; unfold R_dist in |- *; intros.
+elim (H5 eps H0); intros N H6.
+exists (M_nat + N)%nat; intros;
+ cut ( exists p : nat | (p >= N)%nat /\ n = (M_nat + p)%nat).
+intro; elim H8; intros p H9.
+elim H9; intros; rewrite H11; unfold Un in H6; apply H6; assumption.
+exists (n - M_nat)%nat.
+split.
+unfold ge in |- *; apply (fun p n m:nat => plus_le_reg_l n m p) with M_nat;
+ rewrite <- le_plus_minus.
+assumption.
+apply le_trans with (M_nat + N)%nat.
+apply le_plus_l.
+assumption.
+apply le_plus_minus; apply le_trans with (M_nat + N)%nat;
+ [ apply le_plus_l | assumption ].
+pose (Vn := fun n:nat => Rabs x * (Un 0%nat / INR (S n))).
+cut (1 <= M_nat)%nat.
+intro; cut (forall n:nat, 0 < Un n).
+intro; cut (Un_decreasing Un).
+intro; cut (forall n:nat, Un (S n) <= Vn n).
+intro; cut (Un_cv Vn 0).
+unfold Un_cv in |- *; unfold R_dist in |- *; intros.
+elim (H10 eps0 H5); intros N1 H11.
+exists (S N1); intros.
+cut (forall n:nat, 0 < Vn n).
+intro; apply Rle_lt_trans with (Rabs (Vn (pred n) - 0)).
+repeat rewrite Rabs_right.
+unfold Rminus in |- *; rewrite Ropp_0; do 2 rewrite Rplus_0_r;
+ replace n with (S (pred n)).
+apply H9.
+inversion H12; simpl in |- *; reflexivity.
+apply Rle_ge; unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; left;
+ apply H13.
+apply Rle_ge; unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; left;
+ apply H7.
+apply H11; unfold ge in |- *; apply le_S_n; replace (S (pred n)) with n;
+ [ unfold ge in H12; exact H12 | inversion H12; simpl in |- *; reflexivity ].
+intro; apply Rlt_le_trans with (Un (S n0)); [ apply H7 | apply H9 ].
+cut (cv_infty (fun n:nat => INR (S n))).
+intro; cut (Un_cv (fun n:nat => / INR (S n)) 0).
+unfold Un_cv, R_dist in |- *; intros; unfold Vn in |- *.
+cut (0 < eps1 / (Rabs x * Un 0%nat)).
+intro; elim (H11 _ H13); intros N H14.
+exists N; intros;
+ replace (Rabs x * (Un 0%nat / INR (S n)) - 0) with
+ (Rabs x * Un 0%nat * (/ INR (S n) - 0));
+ [ idtac | unfold Rdiv in |- *; ring ].
+rewrite Rabs_mult; apply Rmult_lt_reg_l with (/ Rabs (Rabs x * Un 0%nat)).
+apply Rinv_0_lt_compat; apply Rabs_pos_lt.
+apply prod_neq_R0.
+apply Rabs_no_R0; assumption.
+assert (H16 := H7 0%nat); red in |- *; intro; rewrite H17 in H16;
+ elim (Rlt_irrefl _ H16).
+rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
+rewrite Rmult_1_l.
+replace (/ Rabs (Rabs x * Un 0%nat) * eps1) with (eps1 / (Rabs x * Un 0%nat)).
+apply H14; assumption.
+unfold Rdiv in |- *; rewrite (Rabs_right (Rabs x * Un 0%nat)).
+apply Rmult_comm.
+apply Rle_ge; apply Rmult_le_pos.
+apply Rabs_pos.
+left; apply H7.
+apply Rabs_no_R0.
+apply prod_neq_R0;
+ [ apply Rabs_no_R0; assumption
+ | assert (H16 := H7 0%nat); red in |- *; intro; rewrite H17 in H16;
+ elim (Rlt_irrefl _ H16) ].
+unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+assumption.
+apply Rinv_0_lt_compat; apply Rmult_lt_0_compat.
+apply Rabs_pos_lt; assumption.
+apply H7.
+apply (cv_infty_cv_R0 (fun n:nat => INR (S n))).
+intro; apply not_O_INR; discriminate.
+assumption.
+unfold cv_infty in |- *; intro; case (total_order_T M0 0); intro.
+elim s; intro.
+exists 0%nat; intros.
+apply Rlt_trans with 0; [ assumption | apply lt_INR_0; apply lt_O_Sn ].
+exists 0%nat; intros; rewrite b; apply lt_INR_0; apply lt_O_Sn.
+pose (M0_z := up M0).
+assert (H10 := archimed M0).
+cut (0 <= M0_z)%Z.
+intro; elim (IZN _ H11); intros M0_nat H12.
+exists M0_nat; intros.
+apply Rlt_le_trans with (IZR M0_z).
+elim H10; intros; assumption.
+rewrite H12; rewrite <- INR_IZR_INZ; apply le_INR.
+apply le_trans with n; [ assumption | apply le_n_Sn ].
+apply le_IZR; left; simpl in |- *; unfold M0_z in |- *;
+ apply Rlt_trans with M0; [ assumption | elim H10; intros; assumption ].
+intro; apply Rle_trans with (Rabs x * Un n * / INR (S n)).
+unfold Un in |- *; replace (M_nat + S n)%nat with (M_nat + n + 1)%nat.
+rewrite pow_add; replace (Rabs x ^ 1) with (Rabs x);
+ [ idtac | simpl in |- *; ring ].
+unfold Rdiv in |- *; rewrite <- (Rmult_comm (Rabs x));
+ repeat rewrite Rmult_assoc; repeat apply Rmult_le_compat_l.
+apply Rabs_pos.
+left; apply pow_lt; assumption.
+replace (M_nat + n + 1)%nat with (S (M_nat + n)).
+rewrite fact_simpl; rewrite mult_comm; rewrite mult_INR;
+ rewrite Rinv_mult_distr.
+apply Rmult_le_compat_l.
+left; apply Rinv_0_lt_compat; apply lt_INR_0; apply neq_O_lt; red in |- *;
+ intro; assert (H10 := sym_eq H9); elim (fact_neq_0 _ H10).
+left; apply Rinv_lt_contravar.
+apply Rmult_lt_0_compat; apply lt_INR_0; apply lt_O_Sn.
+apply lt_INR; apply lt_n_S.
+pattern n at 1 in |- *; replace n with (0 + n)%nat; [ idtac | reflexivity ].
+apply plus_lt_compat_r.
+apply lt_le_trans with 1%nat; [ apply lt_O_Sn | assumption ].
+apply INR_fact_neq_0.
+apply not_O_INR; discriminate.
+apply INR_eq; rewrite S_INR; do 3 rewrite plus_INR; reflexivity.
+apply INR_eq; do 3 rewrite plus_INR; do 2 rewrite S_INR; ring.
+unfold Vn in |- *; rewrite Rmult_assoc; unfold Rdiv in |- *;
+ rewrite (Rmult_comm (Un 0%nat)); rewrite (Rmult_comm (Un n)).
+repeat apply Rmult_le_compat_l.
+apply Rabs_pos.
+left; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn.
+apply decreasing_prop; [ assumption | apply le_O_n ].
+unfold Un_decreasing in |- *; intro; unfold Un in |- *.
+replace (M_nat + S n)%nat with (M_nat + n + 1)%nat.
+rewrite pow_add; unfold Rdiv in |- *; rewrite Rmult_assoc;
+ apply Rmult_le_compat_l.
+left; apply pow_lt; assumption.
+replace (Rabs x ^ 1) with (Rabs x); [ idtac | simpl in |- *; ring ].
+replace (M_nat + n + 1)%nat with (S (M_nat + n)).
+apply Rmult_le_reg_l with (INR (fact (S (M_nat + n)))).
+apply lt_INR_0; apply neq_O_lt; red in |- *; intro; assert (H9 := sym_eq H8);
+ elim (fact_neq_0 _ H9).
+rewrite (Rmult_comm (Rabs x)); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym.
+rewrite Rmult_1_l.
+rewrite fact_simpl; rewrite mult_INR; rewrite Rmult_assoc;
+ rewrite <- Rinv_r_sym.
+rewrite Rmult_1_r; apply Rle_trans with (INR M_nat).
+left; rewrite INR_IZR_INZ.
+rewrite <- H4; assert (H8 := archimed (Rabs x)); elim H8; intros; assumption.
+apply le_INR; apply le_trans with (S M_nat);
+ [ apply le_n_Sn | apply le_n_S; apply le_plus_l ].
+apply INR_fact_neq_0.
+apply INR_fact_neq_0.
+apply INR_eq; rewrite S_INR; do 3 rewrite plus_INR; reflexivity.
+apply INR_eq; do 3 rewrite plus_INR; do 2 rewrite S_INR; ring.
+intro; unfold Un in |- *; unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+apply pow_lt; assumption.
+apply Rinv_0_lt_compat; apply lt_INR_0; apply neq_O_lt; red in |- *; intro;
+ assert (H8 := sym_eq H7); elim (fact_neq_0 _ H8).
+clear Un Vn; apply INR_le; simpl in |- *.
+induction M_nat as [| M_nat HrecM_nat].
+assert (H6 := archimed (Rabs x)); fold M in H6; elim H6; intros.
+rewrite H4 in H7; rewrite <- INR_IZR_INZ in H7.
+simpl in H7; elim (Rlt_irrefl _ (Rlt_trans _ _ _ H2 H7)).
+replace 1 with (INR 1); [ apply le_INR | reflexivity ]; apply le_n_S;
+ apply le_O_n.
+apply le_IZR; simpl in |- *; left; apply Rlt_trans with (Rabs x).
+assumption.
+elim (archimed (Rabs x)); intros; assumption.
+unfold Un_cv in |- *; unfold R_dist in |- *; intros; elim (H eps H0); intros.
+exists x0; intros;
+ apply Rle_lt_trans with (Rabs (Rabs x ^ n / INR (fact n) - 0)).
+unfold Rminus in |- *; rewrite Ropp_0; do 2 rewrite Rplus_0_r;
+ rewrite (Rabs_right (Rabs x ^ n / INR (fact n))).
+unfold Rdiv in |- *; rewrite Rabs_mult; rewrite (Rabs_right (/ INR (fact n))).
+rewrite RPow_abs; right; reflexivity.
+apply Rle_ge; left; apply Rinv_0_lt_compat; apply lt_INR_0; apply neq_O_lt;
+ red in |- *; intro; assert (H4 := sym_eq H3); elim (fact_neq_0 _ H4).
+apply Rle_ge; unfold Rdiv in |- *; apply Rmult_le_pos.
+case (Req_dec x 0); intro.
+rewrite H3; rewrite Rabs_R0.
+induction n as [| n Hrecn];
+ [ simpl in |- *; left; apply Rlt_0_1
+ | simpl in |- *; rewrite Rmult_0_l; right; reflexivity ].
+left; apply pow_lt; apply Rabs_pos_lt; assumption.
+left; apply Rinv_0_lt_compat; apply lt_INR_0; apply neq_O_lt; red in |- *;
+ intro; assert (H4 := sym_eq H3); elim (fact_neq_0 _ H4).
+apply H1; assumption.
+Qed. \ No newline at end of file
diff --git a/theories/Reals/SeqSeries.v b/theories/Reals/SeqSeries.v
index 03963fc4d..ffac3df29 100644
--- a/theories/Reals/SeqSeries.v
+++ b/theories/Reals/SeqSeries.v
@@ -8,9 +8,9 @@
(*i $Id$ i*)
-Require Rbase.
-Require Rfunctions.
-Require Max.
+Require Import Rbase.
+Require Import Rfunctions.
+Require Import Max.
Require Export Rseries.
Require Export SeqProp.
Require Export Rcomplete.
@@ -21,287 +21,397 @@ Require Export Rsigma.
Require Export Rprod.
Require Export Cauchy_prod.
Require Export Alembert.
-V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
Open Local Scope R_scope.
(**********)
-Lemma sum_maj1 : (fn:nat->R->R;An:nat->R;x,l1,l2:R;N:nat) (Un_cv [n:nat](SP fn n x) l1) -> (Un_cv [n:nat](sum_f_R0 An n) l2) -> ((n:nat)``(Rabsolu (fn n x))<=(An n)``) -> ``(Rabsolu (l1-(SP fn N x)))<=l2-(sum_f_R0 An N)``.
-Intros; Cut (sigTT R [l:R](Un_cv [n:nat](sum_f_R0 [l:nat](fn (plus (S N) l) x) n) l)).
-Intro; Cut (sigTT R [l:R](Un_cv [n:nat](sum_f_R0 [l:nat](An (plus (S N) l)) n) l)).
-Intro; Elim X; Intros l1N H2.
-Elim X0; Intros l2N H3.
-Cut ``l1-(SP fn N x)==l1N``.
-Intro; Cut ``l2-(sum_f_R0 An N)==l2N``.
-Intro; Rewrite H4; Rewrite H5.
-Apply sum_cv_maj with [l:nat](An (plus (S N) l)) [l:nat][x:R](fn (plus (S N) l) x) x.
-Unfold SP; Apply H2.
-Apply H3.
-Intros; Apply H1.
-Symmetry; EApply UL_sequence.
-Apply H3.
-Unfold Un_cv in H0; Unfold Un_cv; Intros; Elim (H0 eps H5); Intros N0 H6.
-Unfold R_dist in H6; Exists N0; Intros.
-Unfold R_dist; Replace (Rminus (sum_f_R0 [l:nat](An (plus (S N) l)) n) (Rminus l2 (sum_f_R0 An N))) with (Rminus (Rplus (sum_f_R0 An N) (sum_f_R0 [l:nat](An (plus (S N) l)) n)) l2); [Idtac | Ring].
-Replace (Rplus (sum_f_R0 An N) (sum_f_R0 [l:nat](An (plus (S N) l)) n)) with (sum_f_R0 An (S (plus N n))).
-Apply H6; Unfold ge; Apply le_trans with n.
-Apply H7.
-Apply le_trans with (plus N n).
-Apply le_plus_r.
-Apply le_n_Sn.
-Cut (le O N).
-Cut (lt N (S (plus N n))).
-Intros; Assert H10 := (sigma_split An H9 H8).
-Unfold sigma in H10.
-Do 2 Rewrite <- minus_n_O in H10.
-Replace (sum_f_R0 An (S (plus N n))) with (sum_f_R0 [k:nat](An (plus (0) k)) (S (plus N n))).
-Replace (sum_f_R0 An N) with (sum_f_R0 [k:nat](An (plus (0) k)) N).
-Cut (minus (S (plus N n)) (S N))=n.
-Intro; Rewrite H11 in H10.
-Apply H10.
-Apply INR_eq; Rewrite minus_INR.
-Do 2 Rewrite S_INR; Rewrite plus_INR; Ring.
-Apply le_n_S; Apply le_plus_l.
-Apply sum_eq; Intros.
-Reflexivity.
-Apply sum_eq; Intros.
-Reflexivity.
-Apply le_lt_n_Sm; Apply le_plus_l.
-Apply le_O_n.
-Symmetry; EApply UL_sequence.
-Apply H2.
-Unfold Un_cv in H; Unfold Un_cv; Intros.
-Elim (H eps H4); Intros N0 H5.
-Unfold R_dist in H5; Exists N0; Intros.
-Unfold R_dist SP; Replace (Rminus (sum_f_R0 [l:nat](fn (plus (S N) l) x) n) (Rminus l1 (sum_f_R0 [k:nat](fn k x) N))) with (Rminus (Rplus (sum_f_R0 [k:nat](fn k x) N) (sum_f_R0 [l:nat](fn (plus (S N) l) x) n)) l1); [Idtac | Ring].
-Replace (Rplus (sum_f_R0 [k:nat](fn k x) N) (sum_f_R0 [l:nat](fn (plus (S N) l) x) n)) with (sum_f_R0 [k:nat](fn k x) (S (plus N n))).
-Unfold SP in H5; Apply H5; Unfold ge; Apply le_trans with n.
-Apply H6.
-Apply le_trans with (plus N n).
-Apply le_plus_r.
-Apply le_n_Sn.
-Cut (le O N).
-Cut (lt N (S (plus N n))).
-Intros; Assert H9 := (sigma_split [k:nat](fn k x) H8 H7).
-Unfold sigma in H9.
-Do 2 Rewrite <- minus_n_O in H9.
-Replace (sum_f_R0 [k:nat](fn k x) (S (plus N n))) with (sum_f_R0 [k:nat](fn (plus (0) k) x) (S (plus N n))).
-Replace (sum_f_R0 [k:nat](fn k x) N) with (sum_f_R0 [k:nat](fn (plus (0) k) x) N).
-Cut (minus (S (plus N n)) (S N))=n.
-Intro; Rewrite H10 in H9.
-Apply H9.
-Apply INR_eq; Rewrite minus_INR.
-Do 2 Rewrite S_INR; Rewrite plus_INR; Ring.
-Apply le_n_S; Apply le_plus_l.
-Apply sum_eq; Intros.
-Reflexivity.
-Apply sum_eq; Intros.
-Reflexivity.
-Apply le_lt_n_Sm.
-Apply le_plus_l.
-Apply le_O_n.
-Apply existTT with ``l2-(sum_f_R0 An N)``.
-Unfold Un_cv in H0; Unfold Un_cv; Intros.
-Elim (H0 eps H2); Intros N0 H3.
-Unfold R_dist in H3; Exists N0; Intros.
-Unfold R_dist; Replace (Rminus (sum_f_R0 [l:nat](An (plus (S N) l)) n) (Rminus l2 (sum_f_R0 An N))) with (Rminus (Rplus (sum_f_R0 An N) (sum_f_R0 [l:nat](An (plus (S N) l)) n)) l2); [Idtac | Ring].
-Replace (Rplus (sum_f_R0 An N) (sum_f_R0 [l:nat](An (plus (S N) l)) n)) with (sum_f_R0 An (S (plus N n))).
-Apply H3; Unfold ge; Apply le_trans with n.
-Apply H4.
-Apply le_trans with (plus N n).
-Apply le_plus_r.
-Apply le_n_Sn.
-Cut (le O N).
-Cut (lt N (S (plus N n))).
-Intros; Assert H7 := (sigma_split An H6 H5).
-Unfold sigma in H7.
-Do 2 Rewrite <- minus_n_O in H7.
-Replace (sum_f_R0 An (S (plus N n))) with (sum_f_R0 [k:nat](An (plus (0) k)) (S (plus N n))).
-Replace (sum_f_R0 An N) with (sum_f_R0 [k:nat](An (plus (0) k)) N).
-Cut (minus (S (plus N n)) (S N))=n.
-Intro; Rewrite H8 in H7.
-Apply H7.
-Apply INR_eq; Rewrite minus_INR.
-Do 2 Rewrite S_INR; Rewrite plus_INR; Ring.
-Apply le_n_S; Apply le_plus_l.
-Apply sum_eq; Intros.
-Reflexivity.
-Apply sum_eq; Intros.
-Reflexivity.
-Apply le_lt_n_Sm.
-Apply le_plus_l.
-Apply le_O_n.
-Apply existTT with ``l1-(SP fn N x)``.
-Unfold Un_cv in H; Unfold Un_cv; Intros.
-Elim (H eps H2); Intros N0 H3.
-Unfold R_dist in H3; Exists N0; Intros.
-Unfold R_dist SP.
-Replace (Rminus (sum_f_R0 [l:nat](fn (plus (S N) l) x) n) (Rminus l1 (sum_f_R0 [k:nat](fn k x) N))) with (Rminus (Rplus (sum_f_R0 [k:nat](fn k x) N) (sum_f_R0 [l:nat](fn (plus (S N) l) x) n)) l1); [Idtac | Ring].
-Replace (Rplus (sum_f_R0 [k:nat](fn k x) N) (sum_f_R0 [l:nat](fn (plus (S N) l) x) n)) with (sum_f_R0 [k:nat](fn k x) (S (plus N n))).
-Unfold SP in H3; Apply H3.
-Unfold ge; Apply le_trans with n.
-Apply H4.
-Apply le_trans with (plus N n).
-Apply le_plus_r.
-Apply le_n_Sn.
-Cut (le O N).
-Cut (lt N (S (plus N n))).
-Intros; Assert H7 := (sigma_split [k:nat](fn k x) H6 H5).
-Unfold sigma in H7.
-Do 2 Rewrite <- minus_n_O in H7.
-Replace (sum_f_R0 [k:nat](fn k x) (S (plus N n))) with (sum_f_R0 [k:nat](fn (plus (0) k) x) (S (plus N n))).
-Replace (sum_f_R0 [k:nat](fn k x) N) with (sum_f_R0 [k:nat](fn (plus (0) k) x) N).
-Cut (minus (S (plus N n)) (S N))=n.
-Intro; Rewrite H8 in H7.
-Apply H7.
-Apply INR_eq; Rewrite minus_INR.
-Do 2 Rewrite S_INR; Rewrite plus_INR; Ring.
-Apply le_n_S; Apply le_plus_l.
-Apply sum_eq; Intros.
-Reflexivity.
-Apply sum_eq; Intros.
-Reflexivity.
-Apply le_lt_n_Sm.
-Apply le_plus_l.
-Apply le_O_n.
+Lemma sum_maj1 :
+ forall (fn:nat -> R -> R) (An:nat -> R) (x l1 l2:R)
+ (N:nat),
+ Un_cv (fun n:nat => SP fn n x) l1 ->
+ Un_cv (fun n:nat => sum_f_R0 An n) l2 ->
+ (forall n:nat, Rabs (fn n x) <= An n) ->
+ Rabs (l1 - SP fn N x) <= l2 - sum_f_R0 An N.
+intros;
+ cut
+ (sigT
+ (fun l:R =>
+ Un_cv (fun n:nat => sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n) l)).
+intro;
+ cut
+ (sigT
+ (fun l:R =>
+ Un_cv (fun n:nat => sum_f_R0 (fun l:nat => An (S N + l)%nat) n) l)).
+intro; elim X; intros l1N H2.
+elim X0; intros l2N H3.
+cut (l1 - SP fn N x = l1N).
+intro; cut (l2 - sum_f_R0 An N = l2N).
+intro; rewrite H4; rewrite H5.
+apply sum_cv_maj with
+ (fun l:nat => An (S N + l)%nat) (fun (l:nat) (x:R) => fn (S N + l)%nat x) x.
+unfold SP in |- *; apply H2.
+apply H3.
+intros; apply H1.
+symmetry in |- *; eapply UL_sequence.
+apply H3.
+unfold Un_cv in H0; unfold Un_cv in |- *; intros; elim (H0 eps H5);
+ intros N0 H6.
+unfold R_dist in H6; exists N0; intros.
+unfold R_dist in |- *;
+ replace (sum_f_R0 (fun l:nat => An (S N + l)%nat) n - (l2 - sum_f_R0 An N))
+ with (sum_f_R0 An N + sum_f_R0 (fun l:nat => An (S N + l)%nat) n - l2);
+ [ idtac | ring ].
+replace (sum_f_R0 An N + sum_f_R0 (fun l:nat => An (S N + l)%nat) n) with
+ (sum_f_R0 An (S (N + n))).
+apply H6; unfold ge in |- *; apply le_trans with n.
+apply H7.
+apply le_trans with (N + n)%nat.
+apply le_plus_r.
+apply le_n_Sn.
+cut (0 <= N)%nat.
+cut (N < S (N + n))%nat.
+intros; assert (H10 := sigma_split An H9 H8).
+unfold sigma in H10.
+do 2 rewrite <- minus_n_O in H10.
+replace (sum_f_R0 An (S (N + n))) with
+ (sum_f_R0 (fun k:nat => An (0 + k)%nat) (S (N + n))).
+replace (sum_f_R0 An N) with (sum_f_R0 (fun k:nat => An (0 + k)%nat) N).
+cut ((S (N + n) - S N)%nat = n).
+intro; rewrite H11 in H10.
+apply H10.
+apply INR_eq; rewrite minus_INR.
+do 2 rewrite S_INR; rewrite plus_INR; ring.
+apply le_n_S; apply le_plus_l.
+apply sum_eq; intros.
+reflexivity.
+apply sum_eq; intros.
+reflexivity.
+apply le_lt_n_Sm; apply le_plus_l.
+apply le_O_n.
+symmetry in |- *; eapply UL_sequence.
+apply H2.
+unfold Un_cv in H; unfold Un_cv in |- *; intros.
+elim (H eps H4); intros N0 H5.
+unfold R_dist in H5; exists N0; intros.
+unfold R_dist, SP in |- *;
+ replace
+ (sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n -
+ (l1 - sum_f_R0 (fun k:nat => fn k x) N)) with
+ (sum_f_R0 (fun k:nat => fn k x) N +
+ sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n - l1);
+ [ idtac | ring ].
+replace
+ (sum_f_R0 (fun k:nat => fn k x) N +
+ sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n) with
+ (sum_f_R0 (fun k:nat => fn k x) (S (N + n))).
+unfold SP in H5; apply H5; unfold ge in |- *; apply le_trans with n.
+apply H6.
+apply le_trans with (N + n)%nat.
+apply le_plus_r.
+apply le_n_Sn.
+cut (0 <= N)%nat.
+cut (N < S (N + n))%nat.
+intros; assert (H9 := sigma_split (fun k:nat => fn k x) H8 H7).
+unfold sigma in H9.
+do 2 rewrite <- minus_n_O in H9.
+replace (sum_f_R0 (fun k:nat => fn k x) (S (N + n))) with
+ (sum_f_R0 (fun k:nat => fn (0 + k)%nat x) (S (N + n))).
+replace (sum_f_R0 (fun k:nat => fn k x) N) with
+ (sum_f_R0 (fun k:nat => fn (0 + k)%nat x) N).
+cut ((S (N + n) - S N)%nat = n).
+intro; rewrite H10 in H9.
+apply H9.
+apply INR_eq; rewrite minus_INR.
+do 2 rewrite S_INR; rewrite plus_INR; ring.
+apply le_n_S; apply le_plus_l.
+apply sum_eq; intros.
+reflexivity.
+apply sum_eq; intros.
+reflexivity.
+apply le_lt_n_Sm.
+apply le_plus_l.
+apply le_O_n.
+apply existT with (l2 - sum_f_R0 An N).
+unfold Un_cv in H0; unfold Un_cv in |- *; intros.
+elim (H0 eps H2); intros N0 H3.
+unfold R_dist in H3; exists N0; intros.
+unfold R_dist in |- *;
+ replace (sum_f_R0 (fun l:nat => An (S N + l)%nat) n - (l2 - sum_f_R0 An N))
+ with (sum_f_R0 An N + sum_f_R0 (fun l:nat => An (S N + l)%nat) n - l2);
+ [ idtac | ring ].
+replace (sum_f_R0 An N + sum_f_R0 (fun l:nat => An (S N + l)%nat) n) with
+ (sum_f_R0 An (S (N + n))).
+apply H3; unfold ge in |- *; apply le_trans with n.
+apply H4.
+apply le_trans with (N + n)%nat.
+apply le_plus_r.
+apply le_n_Sn.
+cut (0 <= N)%nat.
+cut (N < S (N + n))%nat.
+intros; assert (H7 := sigma_split An H6 H5).
+unfold sigma in H7.
+do 2 rewrite <- minus_n_O in H7.
+replace (sum_f_R0 An (S (N + n))) with
+ (sum_f_R0 (fun k:nat => An (0 + k)%nat) (S (N + n))).
+replace (sum_f_R0 An N) with (sum_f_R0 (fun k:nat => An (0 + k)%nat) N).
+cut ((S (N + n) - S N)%nat = n).
+intro; rewrite H8 in H7.
+apply H7.
+apply INR_eq; rewrite minus_INR.
+do 2 rewrite S_INR; rewrite plus_INR; ring.
+apply le_n_S; apply le_plus_l.
+apply sum_eq; intros.
+reflexivity.
+apply sum_eq; intros.
+reflexivity.
+apply le_lt_n_Sm.
+apply le_plus_l.
+apply le_O_n.
+apply existT with (l1 - SP fn N x).
+unfold Un_cv in H; unfold Un_cv in |- *; intros.
+elim (H eps H2); intros N0 H3.
+unfold R_dist in H3; exists N0; intros.
+unfold R_dist, SP in |- *.
+replace
+ (sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n -
+ (l1 - sum_f_R0 (fun k:nat => fn k x) N)) with
+ (sum_f_R0 (fun k:nat => fn k x) N +
+ sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n - l1);
+ [ idtac | ring ].
+replace
+ (sum_f_R0 (fun k:nat => fn k x) N +
+ sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n) with
+ (sum_f_R0 (fun k:nat => fn k x) (S (N + n))).
+unfold SP in H3; apply H3.
+unfold ge in |- *; apply le_trans with n.
+apply H4.
+apply le_trans with (N + n)%nat.
+apply le_plus_r.
+apply le_n_Sn.
+cut (0 <= N)%nat.
+cut (N < S (N + n))%nat.
+intros; assert (H7 := sigma_split (fun k:nat => fn k x) H6 H5).
+unfold sigma in H7.
+do 2 rewrite <- minus_n_O in H7.
+replace (sum_f_R0 (fun k:nat => fn k x) (S (N + n))) with
+ (sum_f_R0 (fun k:nat => fn (0 + k)%nat x) (S (N + n))).
+replace (sum_f_R0 (fun k:nat => fn k x) N) with
+ (sum_f_R0 (fun k:nat => fn (0 + k)%nat x) N).
+cut ((S (N + n) - S N)%nat = n).
+intro; rewrite H8 in H7.
+apply H7.
+apply INR_eq; rewrite minus_INR.
+do 2 rewrite S_INR; rewrite plus_INR; ring.
+apply le_n_S; apply le_plus_l.
+apply sum_eq; intros.
+reflexivity.
+apply sum_eq; intros.
+reflexivity.
+apply le_lt_n_Sm.
+apply le_plus_l.
+apply le_O_n.
Qed.
(* Comparaison of convergence for series *)
-Lemma Rseries_CV_comp : (An,Bn:nat->R) ((n:nat)``0<=(An n)<=(Bn n)``) -> (sigTT ? [l:R](Un_cv [N:nat](sum_f_R0 Bn N) l)) -> (sigTT ? [l:R](Un_cv [N:nat](sum_f_R0 An N) l)).
-Intros; Apply cv_cauchy_2.
-Assert H0 := (cv_cauchy_1 ? X).
-Unfold Cauchy_crit_series; Unfold Cauchy_crit.
-Intros; Elim (H0 eps H1); Intros.
-Exists x; Intros.
-Cut (Rle (R_dist (sum_f_R0 An n) (sum_f_R0 An m)) (R_dist (sum_f_R0 Bn n) (sum_f_R0 Bn m))).
-Intro; Apply Rle_lt_trans with (R_dist (sum_f_R0 Bn n) (sum_f_R0 Bn m)).
-Assumption.
-Apply H2; Assumption.
-Assert H5 := (lt_eq_lt_dec n m).
-Elim H5; Intro.
-Elim a; Intro.
-Rewrite (tech2 An n m); [Idtac | Assumption].
-Rewrite (tech2 Bn n m); [Idtac | Assumption].
-Unfold R_dist; Unfold Rminus; Do 2 Rewrite Ropp_distr1; Do 2 Rewrite <- Rplus_assoc; Do 2 Rewrite Rplus_Ropp_r; Do 2 Rewrite Rplus_Ol; Do 2 Rewrite Rabsolu_Ropp; Repeat Rewrite Rabsolu_right.
-Apply sum_Rle; Intros.
-Elim (H (plus (S n) n0)); Intros.
-Apply H8.
-Apply Rle_sym1; Apply cond_pos_sum; Intro.
-Elim (H (plus (S n) n0)); Intros.
-Apply Rle_trans with (An (plus (S n) n0)); Assumption.
-Apply Rle_sym1; Apply cond_pos_sum; Intro.
-Elim (H (plus (S n) n0)); Intros; Assumption.
-Rewrite b; Unfold R_dist; Unfold Rminus; Do 2 Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Right; Reflexivity.
-Rewrite (tech2 An m n); [Idtac | Assumption].
-Rewrite (tech2 Bn m n); [Idtac | Assumption].
-Unfold R_dist; Unfold Rminus; Do 2 Rewrite Rplus_assoc; Rewrite (Rplus_sym (sum_f_R0 An m)); Rewrite (Rplus_sym (sum_f_R0 Bn m)); Do 2 Rewrite Rplus_assoc; Do 2 Rewrite Rplus_Ropp_l; Do 2 Rewrite Rplus_Or; Repeat Rewrite Rabsolu_right.
-Apply sum_Rle; Intros.
-Elim (H (plus (S m) n0)); Intros; Apply H8.
-Apply Rle_sym1; Apply cond_pos_sum; Intro.
-Elim (H (plus (S m) n0)); Intros.
-Apply Rle_trans with (An (plus (S m) n0)); Assumption.
-Apply Rle_sym1.
-Apply cond_pos_sum; Intro.
-Elim (H (plus (S m) n0)); Intros; Assumption.
+Lemma Rseries_CV_comp :
+ forall An Bn:nat -> R,
+ (forall n:nat, 0 <= An n <= Bn n) ->
+ sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 Bn N) l) ->
+ sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l).
+intros; apply cv_cauchy_2.
+assert (H0 := cv_cauchy_1 _ X).
+unfold Cauchy_crit_series in |- *; unfold Cauchy_crit in |- *.
+intros; elim (H0 eps H1); intros.
+exists x; intros.
+cut
+ (R_dist (sum_f_R0 An n) (sum_f_R0 An m) <=
+ R_dist (sum_f_R0 Bn n) (sum_f_R0 Bn m)).
+intro; apply Rle_lt_trans with (R_dist (sum_f_R0 Bn n) (sum_f_R0 Bn m)).
+assumption.
+apply H2; assumption.
+assert (H5 := lt_eq_lt_dec n m).
+elim H5; intro.
+elim a; intro.
+rewrite (tech2 An n m); [ idtac | assumption ].
+rewrite (tech2 Bn n m); [ idtac | assumption ].
+unfold R_dist in |- *; unfold Rminus in |- *; do 2 rewrite Ropp_plus_distr;
+ do 2 rewrite <- Rplus_assoc; do 2 rewrite Rplus_opp_r;
+ do 2 rewrite Rplus_0_l; do 2 rewrite Rabs_Ropp; repeat rewrite Rabs_right.
+apply sum_Rle; intros.
+elim (H (S n + n0)%nat); intros.
+apply H8.
+apply Rle_ge; apply cond_pos_sum; intro.
+elim (H (S n + n0)%nat); intros.
+apply Rle_trans with (An (S n + n0)%nat); assumption.
+apply Rle_ge; apply cond_pos_sum; intro.
+elim (H (S n + n0)%nat); intros; assumption.
+rewrite b; unfold R_dist in |- *; unfold Rminus in |- *;
+ do 2 rewrite Rplus_opp_r; rewrite Rabs_R0; right;
+ reflexivity.
+rewrite (tech2 An m n); [ idtac | assumption ].
+rewrite (tech2 Bn m n); [ idtac | assumption ].
+unfold R_dist in |- *; unfold Rminus in |- *; do 2 rewrite Rplus_assoc;
+ rewrite (Rplus_comm (sum_f_R0 An m)); rewrite (Rplus_comm (sum_f_R0 Bn m));
+ do 2 rewrite Rplus_assoc; do 2 rewrite Rplus_opp_l;
+ do 2 rewrite Rplus_0_r; repeat rewrite Rabs_right.
+apply sum_Rle; intros.
+elim (H (S m + n0)%nat); intros; apply H8.
+apply Rle_ge; apply cond_pos_sum; intro.
+elim (H (S m + n0)%nat); intros.
+apply Rle_trans with (An (S m + n0)%nat); assumption.
+apply Rle_ge.
+apply cond_pos_sum; intro.
+elim (H (S m + n0)%nat); intros; assumption.
Qed.
(* Cesaro's theorem *)
-Lemma Cesaro : (An,Bn:nat->R;l:R) (Un_cv Bn l) -> ((n:nat)``0<(An n)``) -> (cv_infty [n:nat](sum_f_R0 An n)) -> (Un_cv [n:nat](Rdiv (sum_f_R0 [k:nat]``(An k)*(Bn k)`` n) (sum_f_R0 An n)) l).
-Proof with Trivial.
-Unfold Un_cv; Intros; Assert H3 : (n:nat)``0<(sum_f_R0 An n)``.
-Intro; Apply tech1.
-Assert H4 : (n:nat) ``(sum_f_R0 An n)<>0``.
-Intro; Red; Intro; Assert H5 := (H3 n); Rewrite H4 in H5; Elim (Rlt_antirefl ? H5).
-Assert H5 := (cv_infty_cv_R0 ? H4 H1); Assert H6 : ``0<eps/2``.
-Unfold Rdiv; Apply Rmult_lt_pos.
-Apply Rlt_Rinv; Sup.
-Elim (H ? H6); Clear H; Intros N1 H; Pose C := (Rabsolu (sum_f_R0 [k:nat]``(An k)*((Bn k)-l)`` N1)); Assert H7 : (EX N:nat | (n:nat) (le N n) -> ``C/(sum_f_R0 An n)<eps/2``).
-Case (Req_EM C R0); Intro.
-Exists O; Intros.
-Rewrite H7; Unfold Rdiv; Rewrite Rmult_Ol; Apply Rmult_lt_pos.
-Apply Rlt_Rinv; Sup.
-Assert H8 : ``0<eps/(2*(Rabsolu C))``.
-Unfold Rdiv; Apply Rmult_lt_pos.
-Apply Rlt_Rinv; Apply Rmult_lt_pos.
-Sup.
-Apply Rabsolu_pos_lt.
-Elim (H5 ? H8); Intros; Exists x; Intros; Assert H11 := (H9 ? H10); Unfold R_dist in H11; Unfold Rminus in H11; Rewrite Ropp_O in H11; Rewrite Rplus_Or in H11.
-Apply Rle_lt_trans with (Rabsolu ``C/(sum_f_R0 An n)``).
-Apply Rle_Rabsolu.
-Unfold Rdiv; Rewrite Rabsolu_mult; Apply Rlt_monotony_contra with ``/(Rabsolu C)``.
-Apply Rlt_Rinv; Apply Rabsolu_pos_lt.
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l; Replace ``/(Rabsolu C)*(eps*/2)`` with ``eps/(2*(Rabsolu C))``.
-Unfold Rdiv; Rewrite Rinv_Rmult.
-Ring.
-DiscrR.
-Apply Rabsolu_no_R0.
-Apply Rabsolu_no_R0.
-Elim H7; Clear H7; Intros N2 H7; Pose N := (max N1 N2); Exists (S N); Intros; Unfold R_dist; Replace (Rminus (Rdiv (sum_f_R0 [k:nat]``(An k)*(Bn k)`` n) (sum_f_R0 An n)) l) with (Rdiv (sum_f_R0 [k:nat]``(An k)*((Bn k)-l)`` n) (sum_f_R0 An n)).
-Assert H9 : (lt N1 n).
-Apply lt_le_trans with (S N).
-Apply le_lt_n_Sm; Unfold N; Apply le_max_l.
-Rewrite (tech2 [k:nat]``(An k)*((Bn k)-l)`` ? ? H9); Unfold Rdiv; Rewrite Rmult_Rplus_distrl; Apply Rle_lt_trans with (Rplus (Rabsolu (Rdiv (sum_f_R0 [k:nat]``(An k)*((Bn k)-l)`` N1) (sum_f_R0 An n))) (Rabsolu (Rdiv (sum_f_R0 [i:nat]``(An (plus (S N1) i))*((Bn (plus (S N1) i))-l)`` (minus n (S N1))) (sum_f_R0 An n)))).
-Apply Rabsolu_triang.
-Rewrite (double_var eps); Apply Rplus_lt.
-Unfold Rdiv; Rewrite Rabsolu_mult; Fold C; Rewrite Rabsolu_right.
-Apply (H7 n); Apply le_trans with (S N).
-Apply le_trans with N; [Unfold N; Apply le_max_r | Apply le_n_Sn].
-Apply Rle_sym1; Left; Apply Rlt_Rinv.
+Lemma Cesaro :
+ forall (An Bn:nat -> R) (l:R),
+ Un_cv Bn l ->
+ (forall n:nat, 0 < An n) ->
+ cv_infty (fun n:nat => sum_f_R0 An n) ->
+ Un_cv (fun n:nat => sum_f_R0 (fun k:nat => An k * Bn k) n / sum_f_R0 An n)
+ l.
+Proof with trivial.
+unfold Un_cv in |- *; intros; assert (H3 : forall n:nat, 0 < sum_f_R0 An n)...
+intro; apply tech1...
+assert (H4 : forall n:nat, sum_f_R0 An n <> 0)...
+intro; red in |- *; intro; assert (H5 := H3 n); rewrite H4 in H5;
+ elim (Rlt_irrefl _ H5)...
+assert (H5 := cv_infty_cv_R0 _ H4 H1); assert (H6 : 0 < eps / 2)...
+unfold Rdiv in |- *; apply Rmult_lt_0_compat...
+apply Rinv_0_lt_compat; prove_sup...
+elim (H _ H6); clear H; intros N1 H;
+ pose (C := Rabs (sum_f_R0 (fun k:nat => An k * (Bn k - l)) N1));
+ assert
+ (H7 :
+ exists N : nat
+ | (forall n:nat, (N <= n)%nat -> C / sum_f_R0 An n < eps / 2))...
+case (Req_dec C 0); intro...
+exists 0%nat; intros...
+rewrite H7; unfold Rdiv in |- *; rewrite Rmult_0_l; apply Rmult_lt_0_compat...
+apply Rinv_0_lt_compat; prove_sup...
+assert (H8 : 0 < eps / (2 * Rabs C))...
+unfold Rdiv in |- *; apply Rmult_lt_0_compat...
+apply Rinv_0_lt_compat; apply Rmult_lt_0_compat...
+prove_sup...
+apply Rabs_pos_lt...
+elim (H5 _ H8); intros; exists x; intros; assert (H11 := H9 _ H10);
+ unfold R_dist in H11; unfold Rminus in H11; rewrite Ropp_0 in H11;
+ rewrite Rplus_0_r in H11...
+apply Rle_lt_trans with (Rabs (C / sum_f_R0 An n))...
+apply RRle_abs...
+unfold Rdiv in |- *; rewrite Rabs_mult; apply Rmult_lt_reg_l with (/ Rabs C)...
+apply Rinv_0_lt_compat; apply Rabs_pos_lt...
+rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym...
+rewrite Rmult_1_l; replace (/ Rabs C * (eps * / 2)) with (eps / (2 * Rabs C))...
+unfold Rdiv in |- *; rewrite Rinv_mult_distr...
+ring...
+discrR...
+apply Rabs_no_R0...
+apply Rabs_no_R0...
+elim H7; clear H7; intros N2 H7; pose (N := max N1 N2); exists (S N); intros;
+ unfold R_dist in |- *;
+ replace (sum_f_R0 (fun k:nat => An k * Bn k) n / sum_f_R0 An n - l) with
+ (sum_f_R0 (fun k:nat => An k * (Bn k - l)) n / sum_f_R0 An n)...
+assert (H9 : (N1 < n)%nat)...
+apply lt_le_trans with (S N)...
+apply le_lt_n_Sm; unfold N in |- *; apply le_max_l...
+rewrite (tech2 (fun k:nat => An k * (Bn k - l)) _ _ H9); unfold Rdiv in |- *;
+ rewrite Rmult_plus_distr_r;
+ apply Rle_lt_trans with
+ (Rabs (sum_f_R0 (fun k:nat => An k * (Bn k - l)) N1 / sum_f_R0 An n) +
+ Rabs
+ (sum_f_R0 (fun i:nat => An (S N1 + i)%nat * (Bn (S N1 + i)%nat - l))
+ (n - S N1) / sum_f_R0 An n))...
+apply Rabs_triang...
+rewrite (double_var eps); apply Rplus_lt_compat...
+unfold Rdiv in |- *; rewrite Rabs_mult; fold C in |- *; rewrite Rabs_right...
+apply (H7 n); apply le_trans with (S N)...
+apply le_trans with N; [ unfold N in |- *; apply le_max_r | apply le_n_Sn ]...
+apply Rle_ge; left; apply Rinv_0_lt_compat...
-Unfold R_dist in H; Unfold Rdiv; Rewrite Rabsolu_mult; Rewrite (Rabsolu_right ``/(sum_f_R0 An n)``).
-Apply Rle_lt_trans with (Rmult (sum_f_R0 [i:nat](Rabsolu ``(An (plus (S N1) i))*((Bn (plus (S N1) i))-l)``) (minus n (S N1))) ``/(sum_f_R0 An n)``).
-Do 2 Rewrite <- (Rmult_sym ``/(sum_f_R0 An n)``); Apply Rle_monotony.
-Left; Apply Rlt_Rinv.
-Apply (sum_Rabsolu [i:nat]``(An (plus (S N1) i))*((Bn (plus (S N1) i))-l)`` (minus n (S N1))).
-Apply Rle_lt_trans with (Rmult (sum_f_R0 [i:nat]``(An (plus (S N1) i))*eps/2`` (minus n (S N1))) ``/(sum_f_R0 An n)``).
-Do 2 Rewrite <- (Rmult_sym ``/(sum_f_R0 An n)``); Apply Rle_monotony.
-Left; Apply Rlt_Rinv.
-Apply sum_Rle; Intros; Rewrite Rabsolu_mult; Pattern 2 (An (plus (S N1) n0)); Rewrite <- (Rabsolu_right (An (plus (S N1) n0))).
-Apply Rle_monotony.
-Apply Rabsolu_pos.
-Left; Apply H; Unfold ge; Apply le_trans with (S N1); [Apply le_n_Sn | Apply le_plus_l].
-Apply Rle_sym1; Left.
-Rewrite <- (scal_sum [i:nat](An (plus (S N1) i)) (minus n (S N1)) ``eps/2``); Unfold Rdiv; Repeat Rewrite Rmult_assoc; Apply Rlt_monotony.
-Pattern 2 ``/2``; Rewrite <- Rmult_1r; Apply Rlt_monotony.
-Apply Rlt_Rinv; Sup.
-Rewrite Rmult_sym; Apply Rlt_monotony_contra with (sum_f_R0 An n).
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1l; Rewrite Rmult_1r; Rewrite (tech2 An N1 n).
-Rewrite Rplus_sym; Pattern 1 (sum_f_R0 [i:nat](An (plus (S N1) i)) (minus n (S N1))); Rewrite <- Rplus_Or; Apply Rlt_compatibility.
-Apply Rle_sym1; Left; Apply Rlt_Rinv.
-Replace (sum_f_R0 [k:nat]``(An k)*((Bn k)-l)`` n) with (Rplus (sum_f_R0 [k:nat]``(An k)*(Bn k)`` n) (sum_f_R0 [k:nat]``(An k)*-l`` n)).
-Rewrite <- (scal_sum An n ``-l``); Field.
-Rewrite <- plus_sum; Apply sum_eq; Intros; Ring.
+unfold R_dist in H; unfold Rdiv in |- *; rewrite Rabs_mult;
+ rewrite (Rabs_right (/ sum_f_R0 An n))...
+apply Rle_lt_trans with
+ (sum_f_R0 (fun i:nat => Rabs (An (S N1 + i)%nat * (Bn (S N1 + i)%nat - l)))
+ (n - S N1) * / sum_f_R0 An n)...
+do 2 rewrite <- (Rmult_comm (/ sum_f_R0 An n)); apply Rmult_le_compat_l...
+left; apply Rinv_0_lt_compat...
+apply
+ (Rsum_abs (fun i:nat => An (S N1 + i)%nat * (Bn (S N1 + i)%nat - l))
+ (n - S N1))...
+apply Rle_lt_trans with
+ (sum_f_R0 (fun i:nat => An (S N1 + i)%nat * (eps / 2)) (n - S N1) *
+ / sum_f_R0 An n)...
+do 2 rewrite <- (Rmult_comm (/ sum_f_R0 An n)); apply Rmult_le_compat_l...
+left; apply Rinv_0_lt_compat...
+apply sum_Rle; intros; rewrite Rabs_mult;
+ pattern (An (S N1 + n0)%nat) at 2 in |- *;
+ rewrite <- (Rabs_right (An (S N1 + n0)%nat))...
+apply Rmult_le_compat_l...
+apply Rabs_pos...
+left; apply H; unfold ge in |- *; apply le_trans with (S N1);
+ [ apply le_n_Sn | apply le_plus_l ]...
+apply Rle_ge; left...
+rewrite <- (scal_sum (fun i:nat => An (S N1 + i)%nat) (n - S N1) (eps / 2));
+ unfold Rdiv in |- *; repeat rewrite Rmult_assoc; apply Rmult_lt_compat_l...
+pattern (/ 2) at 2 in |- *; rewrite <- Rmult_1_r; apply Rmult_lt_compat_l...
+apply Rinv_0_lt_compat; prove_sup...
+rewrite Rmult_comm; apply Rmult_lt_reg_l with (sum_f_R0 An n)...
+rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym...
+rewrite Rmult_1_l; rewrite Rmult_1_r; rewrite (tech2 An N1 n)...
+rewrite Rplus_comm;
+ pattern (sum_f_R0 (fun i:nat => An (S N1 + i)%nat) (n - S N1)) at 1 in |- *;
+ rewrite <- Rplus_0_r; apply Rplus_lt_compat_l...
+apply Rle_ge; left; apply Rinv_0_lt_compat...
+replace (sum_f_R0 (fun k:nat => An k * (Bn k - l)) n) with
+ (sum_f_R0 (fun k:nat => An k * Bn k) n +
+ sum_f_R0 (fun k:nat => An k * - l) n)...
+rewrite <- (scal_sum An n (- l)); field...
+rewrite <- plus_sum; apply sum_eq; intros; ring...
Qed.
-Lemma Cesaro_1 : (An:nat->R;l:R) (Un_cv An l) -> (Un_cv [n:nat]``(sum_f_R0 An (pred n))/(INR n)`` l).
-Proof with Trivial.
-Intros Bn l H; Pose An := [_:nat]R1.
-Assert H0 : (n:nat) ``0<(An n)``.
-Intro; Unfold An; Apply Rlt_R0_R1.
-Assert H1 : (n:nat)``0<(sum_f_R0 An n)``.
-Intro; Apply tech1.
-Assert H2 : (cv_infty [n:nat](sum_f_R0 An n)).
-Unfold cv_infty; Intro; Case (total_order_Rle M R0); Intro.
-Exists O; Intros; Apply Rle_lt_trans with R0.
-Assert H2 : ``0<M``.
-Auto with real.
-Clear n; Pose m := (up M); Elim (archimed M); Intros; Assert H5 : `0<=m`.
-Apply le_IZR; Unfold m; Simpl; Left; Apply Rlt_trans with M.
-Elim (IZN ? H5); Intros; Exists x; Intros; Unfold An; Rewrite sum_cte; Rewrite Rmult_1l; Apply Rlt_trans with (IZR (up M)).
-Apply Rle_lt_trans with (INR x).
-Rewrite INR_IZR_INZ; Fold m; Rewrite <- H6; Right.
-Apply lt_INR; Apply le_lt_n_Sm.
-Assert H3 := (Cesaro ? ? ? H H0 H2).
-Unfold Un_cv; Unfold Un_cv in H3; Intros; Elim (H3 ? H4); Intros; Exists (S x); Intros; Unfold R_dist; Unfold R_dist in H5; Apply Rle_lt_trans with (Rabsolu (Rminus (Rdiv (sum_f_R0 [k:nat]``(An k)*(Bn k)`` (pred n)) (sum_f_R0 An (pred n))) l)).
-Right; Replace ``(sum_f_R0 Bn (pred n))/(INR n)-l`` with (Rminus (Rdiv (sum_f_R0 [k:nat]``(An k)*(Bn k)`` (pred n)) (sum_f_R0 An (pred n))) l).
-Unfold Rminus; Do 2 Rewrite <- (Rplus_sym ``-l``); Apply Rplus_plus_r.
-Unfold An; Replace (sum_f_R0 [k:nat]``1*(Bn k)`` (pred n)) with (sum_f_R0 Bn (pred n)).
-Rewrite sum_cte; Rewrite Rmult_1l; Replace (S (pred n)) with n.
-Apply S_pred with O; Apply lt_le_trans with (S x).
-Apply lt_O_Sn.
-Apply sum_eq; Intros; Ring.
-Apply H5; Unfold ge; Apply le_S_n; Replace (S (pred n)) with n.
-Apply S_pred with O; Apply lt_le_trans with (S x).
-Apply lt_O_Sn.
-Qed.
+Lemma Cesaro_1 :
+ forall (An:nat -> R) (l:R),
+ Un_cv An l -> Un_cv (fun n:nat => sum_f_R0 An (pred n) / INR n) l.
+Proof with trivial.
+intros Bn l H; pose (An := fun _:nat => 1)...
+assert (H0 : forall n:nat, 0 < An n)...
+intro; unfold An in |- *; apply Rlt_0_1...
+assert (H1 : forall n:nat, 0 < sum_f_R0 An n)...
+intro; apply tech1...
+assert (H2 : cv_infty (fun n:nat => sum_f_R0 An n))...
+unfold cv_infty in |- *; intro; case (Rle_dec M 0); intro...
+exists 0%nat; intros; apply Rle_lt_trans with 0...
+assert (H2 : 0 < M)...
+auto with real...
+clear n; pose (m := up M); elim (archimed M); intros;
+ assert (H5 : (0 <= m)%Z)...
+apply le_IZR; unfold m in |- *; simpl in |- *; left; apply Rlt_trans with M...
+elim (IZN _ H5); intros; exists x; intros; unfold An in |- *; rewrite sum_cte;
+ rewrite Rmult_1_l; apply Rlt_trans with (IZR (up M))...
+apply Rle_lt_trans with (INR x)...
+rewrite INR_IZR_INZ; fold m in |- *; rewrite <- H6; right...
+apply lt_INR; apply le_lt_n_Sm...
+assert (H3 := Cesaro _ _ _ H H0 H2)...
+unfold Un_cv in |- *; unfold Un_cv in H3; intros; elim (H3 _ H4); intros;
+ exists (S x); intros; unfold R_dist in |- *; unfold R_dist in H5;
+ apply Rle_lt_trans with
+ (Rabs
+ (sum_f_R0 (fun k:nat => An k * Bn k) (pred n) / sum_f_R0 An (pred n) - l))...
+right;
+ replace (sum_f_R0 Bn (pred n) / INR n - l) with
+ (sum_f_R0 (fun k:nat => An k * Bn k) (pred n) / sum_f_R0 An (pred n) - l)...
+unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (- l));
+ apply Rplus_eq_compat_l...
+unfold An in |- *;
+ replace (sum_f_R0 (fun k:nat => 1 * Bn k) (pred n)) with
+ (sum_f_R0 Bn (pred n))...
+rewrite sum_cte; rewrite Rmult_1_l; replace (S (pred n)) with n...
+apply S_pred with 0%nat; apply lt_le_trans with (S x)...
+apply lt_O_Sn...
+apply sum_eq; intros; ring...
+apply H5; unfold ge in |- *; apply le_S_n; replace (S (pred n)) with n...
+apply S_pred with 0%nat; apply lt_le_trans with (S x)...
+apply lt_O_Sn...
+Qed. \ No newline at end of file
diff --git a/theories/Reals/SplitAbsolu.v b/theories/Reals/SplitAbsolu.v
index bc876692d..5ea76696a 100644
--- a/theories/Reals/SplitAbsolu.v
+++ b/theories/Reals/SplitAbsolu.v
@@ -8,15 +8,18 @@
(*i $Id$ i*)
-Require Rbasic_fun.
+Require Import Rbasic_fun.
-Recursive Tactic Definition SplitAbs :=
- Match Context With
- | [ |- [(case_Rabsolu ?1)] ] ->
- Case (case_Rabsolu ?1); Try SplitAbs.
+Ltac split_case_Rabs :=
+ match goal with
+ | |- context [(Rcase_abs ?X1)] =>
+ case (Rcase_abs X1); try split_case_Rabs
+ end.
-Recursive Tactic Definition SplitAbsolu :=
- Match Context With
- | [ id:[(Rabsolu ?)] |- ? ] -> Generalize id; Clear id;Try SplitAbsolu
- | [ |- [(Rabsolu ?1)] ] -> Unfold Rabsolu; Try SplitAbs;Intros.
+Ltac split_Rabs :=
+ match goal with
+ | id:context [(Rabs _)] |- _ => generalize id; clear id; try split_Rabs
+ | |- context [(Rabs ?X1)] =>
+ unfold Rabs in |- *; try split_case_Rabs; intros
+ end. \ No newline at end of file
diff --git a/theories/Reals/SplitRmult.v b/theories/Reals/SplitRmult.v
index 71b2ebf21..281745a11 100644
--- a/theories/Reals/SplitRmult.v
+++ b/theories/Reals/SplitRmult.v
@@ -11,9 +11,10 @@
(*i Lemma mult_non_zero :(r1,r2:R)``r1<>0`` /\ ``r2<>0`` -> ``r1*r2<>0``. i*)
-Require Rbase.
-
-Recursive Tactic Definition SplitRmult :=
- Match Context With
- | [ |- ~(Rmult ?1 ?2)==R0 ] -> Apply mult_non_zero; Split;Try SplitRmult.
+Require Import Rbase.
+Ltac split_Rmult :=
+ match goal with
+ | |- ((?X1 * ?X2)%R <> 0%R) =>
+ apply Rmult_integral_contrapositive; split; try split_Rmult
+ end.
diff --git a/theories/Reals/Sqrt_reg.v b/theories/Reals/Sqrt_reg.v
index 35f6d0f32..def3cd0a4 100644
--- a/theories/Reals/Sqrt_reg.v
+++ b/theories/Reals/Sqrt_reg.v
@@ -8,290 +8,344 @@
(*i $Id$ i*)
-Require Rbase.
-Require Rfunctions.
-Require Ranalysis1.
-Require R_sqrt.
-V7only [Import R_scope.]. Open Local Scope R_scope.
+Require Import Rbase.
+Require Import Rfunctions.
+Require Import Ranalysis1.
+Require Import R_sqrt. Open Local Scope R_scope.
(**********)
-Lemma sqrt_var_maj : (h:R) ``(Rabsolu h) <= 1`` -> ``(Rabsolu ((sqrt (1+h))-1))<=(Rabsolu h)``.
-Intros; Cut ``0<=1+h``.
-Intro; Apply Rle_trans with ``(Rabsolu ((sqrt (Rsqr (1+h)))-1))``.
-Case (total_order_T h R0); Intro.
-Elim s; Intro.
-Repeat Rewrite Rabsolu_left.
-Unfold Rminus; Do 2 Rewrite <- (Rplus_sym ``-1``).
-Do 2 Rewrite Ropp_distr1;Rewrite Ropp_Ropp; Apply Rle_compatibility.
-Apply Rle_Ropp1; Apply sqrt_le_1.
-Apply pos_Rsqr.
-Apply H0.
-Pattern 2 ``1+h``; Rewrite <- Rmult_1r; Unfold Rsqr; Apply Rle_monotony.
-Apply H0.
-Pattern 2 R1; Rewrite <- Rplus_Or; Apply Rle_compatibility; Left; Assumption.
-Apply Rlt_anti_compatibility with R1; Rewrite Rplus_Or; Rewrite Rplus_sym; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or.
-Pattern 2 R1; Rewrite <- sqrt_1; Apply sqrt_lt_1.
-Apply pos_Rsqr.
-Left; Apply Rlt_R0_R1.
-Pattern 2 R1; Rewrite <- Rsqr_1; Apply Rsqr_incrst_1.
-Pattern 2 R1; Rewrite <- Rplus_Or; Apply Rlt_compatibility; Assumption.
-Apply H0.
-Left; Apply Rlt_R0_R1.
-Apply Rlt_anti_compatibility with R1; Rewrite Rplus_Or; Rewrite Rplus_sym; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or.
-Pattern 2 R1; Rewrite <- sqrt_1; Apply sqrt_lt_1.
-Apply H0.
-Left; Apply Rlt_R0_R1.
-Pattern 2 R1; Rewrite <- Rplus_Or; Apply Rlt_compatibility; Assumption.
-Rewrite b; Rewrite Rplus_Or; Rewrite Rsqr_1; Rewrite sqrt_1; Right; Reflexivity.
-Repeat Rewrite Rabsolu_right.
-Unfold Rminus; Do 2 Rewrite <- (Rplus_sym ``-1``); Apply Rle_compatibility.
-Apply sqrt_le_1.
-Apply H0.
-Apply pos_Rsqr.
-Pattern 1 ``1+h``; Rewrite <- Rmult_1r; Unfold Rsqr; Apply Rle_monotony.
-Apply H0.
-Pattern 1 R1; Rewrite <- Rplus_Or; Apply Rle_compatibility; Left; Assumption.
-Apply Rle_sym1; Apply Rle_anti_compatibility with R1.
-Rewrite Rplus_Or; Rewrite Rplus_sym; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or.
-Pattern 1 R1; Rewrite <- sqrt_1; Apply sqrt_le_1.
-Left; Apply Rlt_R0_R1.
-Apply pos_Rsqr.
-Pattern 1 R1; Rewrite <- Rsqr_1; Apply Rsqr_incr_1.
-Pattern 1 R1; Rewrite <- Rplus_Or; Apply Rle_compatibility; Left; Assumption.
-Left; Apply Rlt_R0_R1.
-Apply H0.
-Apply Rle_sym1; Left; Apply Rlt_anti_compatibility with R1.
-Rewrite Rplus_Or; Rewrite Rplus_sym; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or.
-Pattern 1 R1; Rewrite <- sqrt_1; Apply sqrt_lt_1.
-Left; Apply Rlt_R0_R1.
-Apply H0.
-Pattern 1 R1; Rewrite <- Rplus_Or; Apply Rlt_compatibility; Assumption.
-Rewrite sqrt_Rsqr.
-Replace ``(1+h)-1`` with h; [Right; Reflexivity | Ring].
-Apply H0.
-Case (total_order_T h R0); Intro.
-Elim s; Intro.
-Rewrite (Rabsolu_left h a) in H.
-Apply Rle_anti_compatibility with ``-h``.
-Rewrite Rplus_Or; Rewrite Rplus_sym; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or; Exact H.
-Left; Rewrite b; Rewrite Rplus_Or; Apply Rlt_R0_R1.
-Left; Apply gt0_plus_gt0_is_gt0.
-Apply Rlt_R0_R1.
-Apply r.
+Lemma sqrt_var_maj :
+ forall h:R, Rabs h <= 1 -> Rabs (sqrt (1 + h) - 1) <= Rabs h.
+intros; cut (0 <= 1 + h).
+intro; apply Rle_trans with (Rabs (sqrt (Rsqr (1 + h)) - 1)).
+case (total_order_T h 0); intro.
+elim s; intro.
+repeat rewrite Rabs_left.
+unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (-1)).
+do 2 rewrite Ropp_plus_distr; rewrite Ropp_involutive;
+ apply Rplus_le_compat_l.
+apply Ropp_le_contravar; apply sqrt_le_1.
+apply Rle_0_sqr.
+apply H0.
+pattern (1 + h) at 2 in |- *; rewrite <- Rmult_1_r; unfold Rsqr in |- *;
+ apply Rmult_le_compat_l.
+apply H0.
+pattern 1 at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left;
+ assumption.
+apply Rplus_lt_reg_r with 1; rewrite Rplus_0_r; rewrite Rplus_comm;
+ unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_l;
+ rewrite Rplus_0_r.
+pattern 1 at 2 in |- *; rewrite <- sqrt_1; apply sqrt_lt_1.
+apply Rle_0_sqr.
+left; apply Rlt_0_1.
+pattern 1 at 2 in |- *; rewrite <- Rsqr_1; apply Rsqr_incrst_1.
+pattern 1 at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
+ assumption.
+apply H0.
+left; apply Rlt_0_1.
+apply Rplus_lt_reg_r with 1; rewrite Rplus_0_r; rewrite Rplus_comm;
+ unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_l;
+ rewrite Rplus_0_r.
+pattern 1 at 2 in |- *; rewrite <- sqrt_1; apply sqrt_lt_1.
+apply H0.
+left; apply Rlt_0_1.
+pattern 1 at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
+ assumption.
+rewrite b; rewrite Rplus_0_r; rewrite Rsqr_1; rewrite sqrt_1; right;
+ reflexivity.
+repeat rewrite Rabs_right.
+unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (-1));
+ apply Rplus_le_compat_l.
+apply sqrt_le_1.
+apply H0.
+apply Rle_0_sqr.
+pattern (1 + h) at 1 in |- *; rewrite <- Rmult_1_r; unfold Rsqr in |- *;
+ apply Rmult_le_compat_l.
+apply H0.
+pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left;
+ assumption.
+apply Rle_ge; apply Rplus_le_reg_l with 1.
+rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus in |- *;
+ rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r.
+pattern 1 at 1 in |- *; rewrite <- sqrt_1; apply sqrt_le_1.
+left; apply Rlt_0_1.
+apply Rle_0_sqr.
+pattern 1 at 1 in |- *; rewrite <- Rsqr_1; apply Rsqr_incr_1.
+pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left;
+ assumption.
+left; apply Rlt_0_1.
+apply H0.
+apply Rle_ge; left; apply Rplus_lt_reg_r with 1.
+rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus in |- *;
+ rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r.
+pattern 1 at 1 in |- *; rewrite <- sqrt_1; apply sqrt_lt_1.
+left; apply Rlt_0_1.
+apply H0.
+pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
+ assumption.
+rewrite sqrt_Rsqr.
+replace (1 + h - 1) with h; [ right; reflexivity | ring ].
+apply H0.
+case (total_order_T h 0); intro.
+elim s; intro.
+rewrite (Rabs_left h a) in H.
+apply Rplus_le_reg_l with (- h).
+rewrite Rplus_0_r; rewrite Rplus_comm; rewrite Rplus_assoc;
+ rewrite Rplus_opp_r; rewrite Rplus_0_r; exact H.
+left; rewrite b; rewrite Rplus_0_r; apply Rlt_0_1.
+left; apply Rplus_lt_0_compat.
+apply Rlt_0_1.
+apply r.
Qed.
(* sqrt is continuous in 1 *)
-Lemma sqrt_continuity_pt_R1 : (continuity_pt sqrt R1).
-Unfold continuity_pt; Unfold continue_in; Unfold limit1_in; Unfold limit_in; Unfold dist; Simpl; Unfold R_dist; Intros.
-Pose alpha := (Rmin eps R1).
-Exists alpha; Intros.
-Split.
-Unfold alpha; Unfold Rmin; Case (total_order_Rle eps R1); Intro.
-Assumption.
-Apply Rlt_R0_R1.
-Intros; Elim H0; Intros.
-Rewrite sqrt_1; Replace x with ``1+(x-1)``; [Idtac | Ring]; Apply Rle_lt_trans with ``(Rabsolu (x-1))``.
-Apply sqrt_var_maj.
-Apply Rle_trans with alpha.
-Left; Apply H2.
-Unfold alpha; Apply Rmin_r.
-Apply Rlt_le_trans with alpha; [Apply H2 | Unfold alpha; Apply Rmin_l].
+Lemma sqrt_continuity_pt_R1 : continuity_pt sqrt 1.
+unfold continuity_pt in |- *; unfold continue_in in |- *;
+ unfold limit1_in in |- *; unfold limit_in in |- *;
+ unfold dist in |- *; simpl in |- *; unfold R_dist in |- *;
+ intros.
+pose (alpha := Rmin eps 1).
+exists alpha; intros.
+split.
+unfold alpha in |- *; unfold Rmin in |- *; case (Rle_dec eps 1); intro.
+assumption.
+apply Rlt_0_1.
+intros; elim H0; intros.
+rewrite sqrt_1; replace x with (1 + (x - 1)); [ idtac | ring ];
+ apply Rle_lt_trans with (Rabs (x - 1)).
+apply sqrt_var_maj.
+apply Rle_trans with alpha.
+left; apply H2.
+unfold alpha in |- *; apply Rmin_r.
+apply Rlt_le_trans with alpha;
+ [ apply H2 | unfold alpha in |- *; apply Rmin_l ].
Qed.
(* sqrt is continuous forall x>0 *)
-Lemma sqrt_continuity_pt : (x:R) ``0<x`` -> (continuity_pt sqrt x).
-Intros; Generalize sqrt_continuity_pt_R1.
-Unfold continuity_pt; Unfold continue_in; Unfold limit1_in; Unfold limit_in; Unfold dist; Simpl; Unfold R_dist; Intros.
-Cut ``0<eps/(sqrt x)``.
-Intro; Elim (H0 ? H2); Intros alp_1 H3.
-Elim H3; Intros.
-Pose alpha := ``alp_1*x``.
-Exists (Rmin alpha x); Intros.
-Split.
-Change ``0<(Rmin alpha x)``; Unfold Rmin; Case (total_order_Rle alpha x); Intro.
-Unfold alpha; Apply Rmult_lt_pos; Assumption.
-Apply H.
-Intros; Replace x0 with ``x+(x0-x)``; [Idtac | Ring]; Replace ``(sqrt (x+(x0-x)))-(sqrt x)`` with ``(sqrt x)*((sqrt (1+(x0-x)/x))-(sqrt 1))``.
-Rewrite Rabsolu_mult; Rewrite (Rabsolu_right (sqrt x)).
-Apply Rlt_monotony_contra with ``/(sqrt x)``.
-Apply Rlt_Rinv; Apply sqrt_lt_R0; Assumption.
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l; Rewrite Rmult_sym.
-Unfold Rdiv in H5.
-Case (Req_EM x x0); Intro.
-Rewrite H7; Unfold Rminus Rdiv; Rewrite Rplus_Ropp_r; Rewrite Rmult_Ol; Rewrite Rplus_Or; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0.
-Apply Rmult_lt_pos.
-Assumption.
-Apply Rlt_Rinv; Rewrite <- H7; Apply sqrt_lt_R0; Assumption.
-Apply H5.
-Split.
-Unfold D_x no_cond.
-Split.
-Trivial.
-Red; Intro.
-Cut ``(x0-x)*/x==0``.
-Intro.
-Elim (without_div_Od ? ? H9); Intro.
-Elim H7.
-Apply (Rminus_eq_right ? ? H10).
-Assert H11 := (without_div_Oi1 ? x H10).
-Rewrite <- Rinv_l_sym in H11.
-Elim R1_neq_R0; Exact H11.
-Red; Intro; Rewrite H12 in H; Elim (Rlt_antirefl ? H).
-Symmetry; Apply r_Rplus_plus with R1; Rewrite Rplus_Or; Unfold Rdiv in H8; Exact H8.
-Unfold Rminus; Rewrite Rplus_sym; Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Elim H6; Intros.
-Unfold Rdiv; Rewrite Rabsolu_mult.
-Rewrite Rabsolu_Rinv.
-Rewrite (Rabsolu_right x).
-Rewrite Rmult_sym; Apply Rlt_monotony_contra with x.
-Apply H.
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1l; Rewrite Rmult_sym; Fold alpha.
-Apply Rlt_le_trans with (Rmin alpha x).
-Apply H9.
-Apply Rmin_l.
-Red; Intro; Rewrite H10 in H; Elim (Rlt_antirefl ? H).
-Apply Rle_sym1; Left; Apply H.
-Red; Intro; Rewrite H10 in H; Elim (Rlt_antirefl ? H).
-Assert H7 := (sqrt_lt_R0 x H).
-Red; Intro; Rewrite H8 in H7; Elim (Rlt_antirefl ? H7).
-Apply Rle_sym1; Apply sqrt_positivity.
-Left; Apply H.
-Unfold Rminus; Rewrite Rmult_Rplus_distr; Rewrite Ropp_mul3; Repeat Rewrite <- sqrt_times.
-Rewrite Rmult_1r; Rewrite Rmult_Rplus_distr; Rewrite Rmult_1r; Unfold Rdiv; Rewrite Rmult_sym; Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Reflexivity.
-Red; Intro; Rewrite H7 in H; Elim (Rlt_antirefl ? H).
-Left; Apply H.
-Left; Apply Rlt_R0_R1.
-Left; Apply H.
-Elim H6; Intros.
-Case (case_Rabsolu ``x0-x``); Intro.
-Rewrite (Rabsolu_left ``x0-x`` r) in H8.
-Rewrite Rplus_sym.
-Apply Rle_anti_compatibility with ``-((x0-x)/x)``.
-Rewrite Rplus_Or; Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Unfold Rdiv; Rewrite <- Ropp_mul1.
-Apply Rle_monotony_contra with x.
-Apply H.
-Rewrite Rmult_1r; Rewrite Rmult_sym; Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Left; Apply Rlt_le_trans with (Rmin alpha x).
-Apply H8.
-Apply Rmin_r.
-Red; Intro; Rewrite H9 in H; Elim (Rlt_antirefl ? H).
-Apply ge0_plus_ge0_is_ge0.
-Left; Apply Rlt_R0_R1.
-Unfold Rdiv; Apply Rmult_le_pos.
-Apply Rle_sym2; Exact r.
-Left; Apply Rlt_Rinv; Apply H.
-Unfold Rdiv; Apply Rmult_lt_pos.
-Apply H1.
-Apply Rlt_Rinv; Apply sqrt_lt_R0; Apply H.
+Lemma sqrt_continuity_pt : forall x:R, 0 < x -> continuity_pt sqrt x.
+intros; generalize sqrt_continuity_pt_R1.
+unfold continuity_pt in |- *; unfold continue_in in |- *;
+ unfold limit1_in in |- *; unfold limit_in in |- *;
+ unfold dist in |- *; simpl in |- *; unfold R_dist in |- *;
+ intros.
+cut (0 < eps / sqrt x).
+intro; elim (H0 _ H2); intros alp_1 H3.
+elim H3; intros.
+pose (alpha := alp_1 * x).
+exists (Rmin alpha x); intros.
+split.
+change (0 < Rmin alpha x) in |- *; unfold Rmin in |- *;
+ case (Rle_dec alpha x); intro.
+unfold alpha in |- *; apply Rmult_lt_0_compat; assumption.
+apply H.
+intros; replace x0 with (x + (x0 - x)); [ idtac | ring ];
+ replace (sqrt (x + (x0 - x)) - sqrt x) with
+ (sqrt x * (sqrt (1 + (x0 - x) / x) - sqrt 1)).
+rewrite Rabs_mult; rewrite (Rabs_right (sqrt x)).
+apply Rmult_lt_reg_l with (/ sqrt x).
+apply Rinv_0_lt_compat; apply sqrt_lt_R0; assumption.
+rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
+rewrite Rmult_1_l; rewrite Rmult_comm.
+unfold Rdiv in H5.
+case (Req_dec x x0); intro.
+rewrite H7; unfold Rminus, Rdiv in |- *; rewrite Rplus_opp_r;
+ rewrite Rmult_0_l; rewrite Rplus_0_r; rewrite Rplus_opp_r;
+ rewrite Rabs_R0.
+apply Rmult_lt_0_compat.
+assumption.
+apply Rinv_0_lt_compat; rewrite <- H7; apply sqrt_lt_R0; assumption.
+apply H5.
+split.
+unfold D_x, no_cond in |- *.
+split.
+trivial.
+red in |- *; intro.
+cut ((x0 - x) * / x = 0).
+intro.
+elim (Rmult_integral _ _ H9); intro.
+elim H7.
+apply (Rminus_diag_uniq_sym _ _ H10).
+assert (H11 := Rmult_eq_0_compat_r _ x H10).
+rewrite <- Rinv_l_sym in H11.
+elim R1_neq_R0; exact H11.
+red in |- *; intro; rewrite H12 in H; elim (Rlt_irrefl _ H).
+symmetry in |- *; apply Rplus_eq_reg_l with 1; rewrite Rplus_0_r;
+ unfold Rdiv in H8; exact H8.
+unfold Rminus in |- *; rewrite Rplus_comm; rewrite <- Rplus_assoc;
+ rewrite Rplus_opp_l; rewrite Rplus_0_l; elim H6; intros.
+unfold Rdiv in |- *; rewrite Rabs_mult.
+rewrite Rabs_Rinv.
+rewrite (Rabs_right x).
+rewrite Rmult_comm; apply Rmult_lt_reg_l with x.
+apply H.
+rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym.
+rewrite Rmult_1_l; rewrite Rmult_comm; fold alpha in |- *.
+apply Rlt_le_trans with (Rmin alpha x).
+apply H9.
+apply Rmin_l.
+red in |- *; intro; rewrite H10 in H; elim (Rlt_irrefl _ H).
+apply Rle_ge; left; apply H.
+red in |- *; intro; rewrite H10 in H; elim (Rlt_irrefl _ H).
+assert (H7 := sqrt_lt_R0 x H).
+red in |- *; intro; rewrite H8 in H7; elim (Rlt_irrefl _ H7).
+apply Rle_ge; apply sqrt_positivity.
+left; apply H.
+unfold Rminus in |- *; rewrite Rmult_plus_distr_l;
+ rewrite Ropp_mult_distr_r_reverse; repeat rewrite <- sqrt_mult.
+rewrite Rmult_1_r; rewrite Rmult_plus_distr_l; rewrite Rmult_1_r;
+ unfold Rdiv in |- *; rewrite Rmult_comm; rewrite Rmult_assoc;
+ rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r; reflexivity.
+red in |- *; intro; rewrite H7 in H; elim (Rlt_irrefl _ H).
+left; apply H.
+left; apply Rlt_0_1.
+left; apply H.
+elim H6; intros.
+case (Rcase_abs (x0 - x)); intro.
+rewrite (Rabs_left (x0 - x) r) in H8.
+rewrite Rplus_comm.
+apply Rplus_le_reg_l with (- ((x0 - x) / x)).
+rewrite Rplus_0_r; rewrite <- Rplus_assoc; rewrite Rplus_opp_l;
+ rewrite Rplus_0_l; unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse.
+apply Rmult_le_reg_l with x.
+apply H.
+rewrite Rmult_1_r; rewrite Rmult_comm; rewrite Rmult_assoc;
+ rewrite <- Rinv_l_sym.
+rewrite Rmult_1_r; left; apply Rlt_le_trans with (Rmin alpha x).
+apply H8.
+apply Rmin_r.
+red in |- *; intro; rewrite H9 in H; elim (Rlt_irrefl _ H).
+apply Rplus_le_le_0_compat.
+left; apply Rlt_0_1.
+unfold Rdiv in |- *; apply Rmult_le_pos.
+apply Rge_le; exact r.
+left; apply Rinv_0_lt_compat; apply H.
+unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+apply H1.
+apply Rinv_0_lt_compat; apply sqrt_lt_R0; apply H.
Qed.
(* sqrt is derivable for all x>0 *)
-Lemma derivable_pt_lim_sqrt : (x:R) ``0<x`` -> (derivable_pt_lim sqrt x ``/(2*(sqrt x))``).
-Intros; Pose g := [h:R]``(sqrt x)+(sqrt (x+h))``.
-Cut (continuity_pt g R0).
-Intro; Cut ``(g 0)<>0``.
-Intro; Assert H2 := (continuity_pt_inv g R0 H0 H1).
-Unfold derivable_pt_lim; Intros; Unfold continuity_pt in H2; Unfold continue_in in H2; Unfold limit1_in in H2; Unfold limit_in in H2; Simpl in H2; Unfold R_dist in H2.
-Elim (H2 eps H3); Intros alpha H4.
-Elim H4; Intros.
-Pose alpha1 := (Rmin alpha x).
-Cut ``0<alpha1``.
-Intro; Exists (mkposreal alpha1 H7); Intros.
-Replace ``((sqrt (x+h))-(sqrt x))/h`` with ``/((sqrt x)+(sqrt (x+h)))``.
-Unfold inv_fct g in H6; Replace ``2*(sqrt x)`` with ``(sqrt x)+(sqrt (x+0))``.
-Apply H6.
-Split.
-Unfold D_x no_cond.
-Split.
-Trivial.
-Apply not_sym; Exact H8.
-Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rlt_le_trans with alpha1.
-Exact H9.
-Unfold alpha1; Apply Rmin_l.
-Rewrite Rplus_Or; Ring.
-Cut ``0<=x+h``.
-Intro; Cut ``0<(sqrt x)+(sqrt (x+h))``.
-Intro; Apply r_Rmult_mult with ``((sqrt x)+(sqrt (x+h)))``.
-Rewrite <- Rinv_r_sym.
-Rewrite Rplus_sym; Unfold Rdiv; Rewrite <- Rmult_assoc; Rewrite Rsqr_plus_minus; Repeat Rewrite Rsqr_sqrt.
-Rewrite Rplus_sym; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or; Rewrite <- Rinv_r_sym.
-Reflexivity.
-Apply H8.
-Left; Apply H.
-Assumption.
-Red; Intro; Rewrite H12 in H11; Elim (Rlt_antirefl ? H11).
-Red; Intro; Rewrite H12 in H11; Elim (Rlt_antirefl ? H11).
-Apply gt0_plus_ge0_is_gt0.
-Apply sqrt_lt_R0; Apply H.
-Apply sqrt_positivity; Apply H10.
-Case (case_Rabsolu h); Intro.
-Rewrite (Rabsolu_left h r) in H9.
-Apply Rle_anti_compatibility with ``-h``.
-Rewrite Rplus_Or; Rewrite Rplus_sym; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or; Left; Apply Rlt_le_trans with alpha1.
-Apply H9.
-Unfold alpha1; Apply Rmin_r.
-Apply ge0_plus_ge0_is_ge0.
-Left; Assumption.
-Apply Rle_sym2; Apply r.
-Unfold alpha1; Unfold Rmin; Case (total_order_Rle alpha x); Intro.
-Apply H5.
-Apply H.
-Unfold g; Rewrite Rplus_Or.
-Cut ``0<(sqrt x)+(sqrt x)``.
-Intro; Red; Intro; Rewrite H2 in H1; Elim (Rlt_antirefl ? H1).
-Apply gt0_plus_gt0_is_gt0; Apply sqrt_lt_R0; Apply H.
-Replace g with (plus_fct (fct_cte (sqrt x)) (comp sqrt (plus_fct (fct_cte x) id))); [Idtac | Reflexivity].
-Apply continuity_pt_plus.
-Apply continuity_pt_const; Unfold constant fct_cte; Intro; Reflexivity.
-Apply continuity_pt_comp.
-Apply continuity_pt_plus.
-Apply continuity_pt_const; Unfold constant fct_cte; Intro; Reflexivity.
-Apply derivable_continuous_pt; Apply derivable_pt_id.
-Apply sqrt_continuity_pt.
-Unfold plus_fct fct_cte id; Rewrite Rplus_Or; Apply H.
+Lemma derivable_pt_lim_sqrt :
+ forall x:R, 0 < x -> derivable_pt_lim sqrt x (/ (2 * sqrt x)).
+intros; pose (g := fun h:R => sqrt x + sqrt (x + h)).
+cut (continuity_pt g 0).
+intro; cut (g 0 <> 0).
+intro; assert (H2 := continuity_pt_inv g 0 H0 H1).
+unfold derivable_pt_lim in |- *; intros; unfold continuity_pt in H2;
+ unfold continue_in in H2; unfold limit1_in in H2;
+ unfold limit_in in H2; simpl in H2; unfold R_dist in H2.
+elim (H2 eps H3); intros alpha H4.
+elim H4; intros.
+pose (alpha1 := Rmin alpha x).
+cut (0 < alpha1).
+intro; exists (mkposreal alpha1 H7); intros.
+replace ((sqrt (x + h) - sqrt x) / h) with (/ (sqrt x + sqrt (x + h))).
+unfold inv_fct, g in H6; replace (2 * sqrt x) with (sqrt x + sqrt (x + 0)).
+apply H6.
+split.
+unfold D_x, no_cond in |- *.
+split.
+trivial.
+apply (sym_not_eq (A:=R)); exact H8.
+unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r;
+ apply Rlt_le_trans with alpha1.
+exact H9.
+unfold alpha1 in |- *; apply Rmin_l.
+rewrite Rplus_0_r; ring.
+cut (0 <= x + h).
+intro; cut (0 < sqrt x + sqrt (x + h)).
+intro; apply Rmult_eq_reg_l with (sqrt x + sqrt (x + h)).
+rewrite <- Rinv_r_sym.
+rewrite Rplus_comm; unfold Rdiv in |- *; rewrite <- Rmult_assoc;
+ rewrite Rsqr_plus_minus; repeat rewrite Rsqr_sqrt.
+rewrite Rplus_comm; unfold Rminus in |- *; rewrite Rplus_assoc;
+ rewrite Rplus_opp_r; rewrite Rplus_0_r; rewrite <- Rinv_r_sym.
+reflexivity.
+apply H8.
+left; apply H.
+assumption.
+red in |- *; intro; rewrite H12 in H11; elim (Rlt_irrefl _ H11).
+red in |- *; intro; rewrite H12 in H11; elim (Rlt_irrefl _ H11).
+apply Rplus_lt_le_0_compat.
+apply sqrt_lt_R0; apply H.
+apply sqrt_positivity; apply H10.
+case (Rcase_abs h); intro.
+rewrite (Rabs_left h r) in H9.
+apply Rplus_le_reg_l with (- h).
+rewrite Rplus_0_r; rewrite Rplus_comm; rewrite Rplus_assoc;
+ rewrite Rplus_opp_r; rewrite Rplus_0_r; left; apply Rlt_le_trans with alpha1.
+apply H9.
+unfold alpha1 in |- *; apply Rmin_r.
+apply Rplus_le_le_0_compat.
+left; assumption.
+apply Rge_le; apply r.
+unfold alpha1 in |- *; unfold Rmin in |- *; case (Rle_dec alpha x); intro.
+apply H5.
+apply H.
+unfold g in |- *; rewrite Rplus_0_r.
+cut (0 < sqrt x + sqrt x).
+intro; red in |- *; intro; rewrite H2 in H1; elim (Rlt_irrefl _ H1).
+apply Rplus_lt_0_compat; apply sqrt_lt_R0; apply H.
+replace g with (fct_cte (sqrt x) + comp sqrt (fct_cte x + id))%F;
+ [ idtac | reflexivity ].
+apply continuity_pt_plus.
+apply continuity_pt_const; unfold constant, fct_cte in |- *; intro;
+ reflexivity.
+apply continuity_pt_comp.
+apply continuity_pt_plus.
+apply continuity_pt_const; unfold constant, fct_cte in |- *; intro;
+ reflexivity.
+apply derivable_continuous_pt; apply derivable_pt_id.
+apply sqrt_continuity_pt.
+unfold plus_fct, fct_cte, id in |- *; rewrite Rplus_0_r; apply H.
Qed.
(**********)
-Lemma derivable_pt_sqrt : (x:R) ``0<x`` -> (derivable_pt sqrt x).
-Unfold derivable_pt; Intros.
-Apply Specif.existT with ``/(2*(sqrt x))``.
-Apply derivable_pt_lim_sqrt; Assumption.
+Lemma derivable_pt_sqrt : forall x:R, 0 < x -> derivable_pt sqrt x.
+unfold derivable_pt in |- *; intros.
+apply existT with (/ (2 * sqrt x)).
+apply derivable_pt_lim_sqrt; assumption.
Qed.
(**********)
-Lemma derive_pt_sqrt : (x:R;pr:``0<x``) ``(derive_pt sqrt x (derivable_pt_sqrt ? pr)) == /(2*(sqrt x))``.
-Intros.
-Apply derive_pt_eq_0.
-Apply derivable_pt_lim_sqrt; Assumption.
+Lemma derive_pt_sqrt :
+ forall (x:R) (pr:0 < x),
+ derive_pt sqrt x (derivable_pt_sqrt _ pr) = / (2 * sqrt x).
+intros.
+apply derive_pt_eq_0.
+apply derivable_pt_lim_sqrt; assumption.
Qed.
(* We show that sqrt is continuous for all x>=0 *)
(* Remark : by definition of sqrt (as extension of Rsqrt on |R), *)
(* we could also show that sqrt is continuous for all x *)
-Lemma continuity_pt_sqrt : (x:R) ``0<=x`` -> (continuity_pt sqrt x).
-Intros; Case (total_order R0 x); Intro.
-Apply (sqrt_continuity_pt x H0).
-Elim H0; Intro.
-Unfold continuity_pt; Unfold continue_in; Unfold limit1_in; Unfold limit_in; Simpl; Unfold R_dist; Intros.
-Exists (Rsqr eps); Intros.
-Split.
-Change ``0<(Rsqr eps)``; Apply Rsqr_pos_lt.
-Red; Intro; Rewrite H3 in H2; Elim (Rlt_antirefl ? H2).
-Intros; Elim H3; Intros.
-Rewrite <- H1; Rewrite sqrt_0; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite <- H1 in H5; Unfold Rminus in H5; Rewrite Ropp_O in H5; Rewrite Rplus_Or in H5.
-Case (case_Rabsolu x0); Intro.
-Unfold sqrt; Case (case_Rabsolu x0); Intro.
-Rewrite Rabsolu_R0; Apply H2.
-Assert H6 := (Rle_sym2 ? ? r0); Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H6 r)).
-Rewrite Rabsolu_right.
-Apply Rsqr_incrst_0.
-Rewrite Rsqr_sqrt.
-Rewrite (Rabsolu_right x0 r) in H5; Apply H5.
-Apply Rle_sym2; Exact r.
-Apply sqrt_positivity; Apply Rle_sym2; Exact r.
-Left; Exact H2.
-Apply Rle_sym1; Apply sqrt_positivity; Apply Rle_sym2; Exact r.
-Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? H1 H)).
-Qed.
+Lemma continuity_pt_sqrt : forall x:R, 0 <= x -> continuity_pt sqrt x.
+intros; case (Rtotal_order 0 x); intro.
+apply (sqrt_continuity_pt x H0).
+elim H0; intro.
+unfold continuity_pt in |- *; unfold continue_in in |- *;
+ unfold limit1_in in |- *; unfold limit_in in |- *;
+ simpl in |- *; unfold R_dist in |- *; intros.
+exists (Rsqr eps); intros.
+split.
+change (0 < Rsqr eps) in |- *; apply Rsqr_pos_lt.
+red in |- *; intro; rewrite H3 in H2; elim (Rlt_irrefl _ H2).
+intros; elim H3; intros.
+rewrite <- H1; rewrite sqrt_0; unfold Rminus in |- *; rewrite Ropp_0;
+ rewrite Rplus_0_r; rewrite <- H1 in H5; unfold Rminus in H5;
+ rewrite Ropp_0 in H5; rewrite Rplus_0_r in H5.
+case (Rcase_abs x0); intro.
+unfold sqrt in |- *; case (Rcase_abs x0); intro.
+rewrite Rabs_R0; apply H2.
+assert (H6 := Rge_le _ _ r0); elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H6 r)).
+rewrite Rabs_right.
+apply Rsqr_incrst_0.
+rewrite Rsqr_sqrt.
+rewrite (Rabs_right x0 r) in H5; apply H5.
+apply Rge_le; exact r.
+apply sqrt_positivity; apply Rge_le; exact r.
+left; exact H2.
+apply Rle_ge; apply sqrt_positivity; apply Rge_le; exact r.
+elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H1 H)).
+Qed. \ No newline at end of file
diff --git a/theories/Relations/Newman.v b/theories/Relations/Newman.v
index 57e93240a..7de49f62f 100755
--- a/theories/Relations/Newman.v
+++ b/theories/Relations/Newman.v
@@ -8,108 +8,116 @@
(*i $Id$ i*)
-Require Rstar.
+Require Import Rstar.
Section Newman.
-Variable A: Type.
-Variable R: A->A->Prop.
+Variable A : Type.
+Variable R : A -> A -> Prop.
-Local Rstar := (Rstar A R).
-Local Rstar_reflexive := (Rstar_reflexive A R).
-Local Rstar_transitive := (Rstar_transitive A R).
-Local Rstar_Rstar' := (Rstar_Rstar' A R).
+Let Rstar := Rstar A R.
+Let Rstar_reflexive := Rstar_reflexive A R.
+Let Rstar_transitive := Rstar_transitive A R.
+Let Rstar_Rstar' := Rstar_Rstar' A R.
-Definition coherence := [x:A][y:A] (exT2 ? (Rstar x) (Rstar y)).
+Definition coherence (x y:A) := ex2 (Rstar x) (Rstar y).
-Theorem coherence_intro : (x:A)(y:A)(z:A)(Rstar x z)->(Rstar y z)->(coherence x y).
-Proof [x:A][y:A][z:A][h1:(Rstar x z)][h2:(Rstar y z)]
- (exT_intro2 A (Rstar x) (Rstar y) z h1 h2).
+Theorem coherence_intro :
+ forall x y z:A, Rstar x z -> Rstar y z -> coherence x y.
+Proof
+ fun (x y z:A) (h1:Rstar x z) (h2:Rstar y z) =>
+ ex_intro2 (Rstar x) (Rstar y) z h1 h2.
(** A very simple case of coherence : *)
-Lemma Rstar_coherence : (x:A)(y:A)(Rstar x y)->(coherence x y).
- Proof [x:A][y:A][h:(Rstar x y)](coherence_intro x y y h (Rstar_reflexive y)).
+Lemma Rstar_coherence : forall x y:A, Rstar x y -> coherence x y.
+ Proof
+ fun (x y:A) (h:Rstar x y) => coherence_intro x y y h (Rstar_reflexive y).
(** coherence is symmetric *)
-Lemma coherence_sym: (x:A)(y:A)(coherence x y)->(coherence y x).
- Proof [x:A][y:A][h:(coherence x y)]
- (exT2_ind A (Rstar x) (Rstar y) (coherence y x)
- [w:A][h1:(Rstar x w)][h2:(Rstar y w)]
- (coherence_intro y x w h2 h1) h).
-
-Definition confluence :=
- [x:A](y:A)(z:A)(Rstar x y)->(Rstar x z)->(coherence y z).
+Lemma coherence_sym : forall x y:A, coherence x y -> coherence y x.
+ Proof
+ fun (x y:A) (h:coherence x y) =>
+ ex2_ind
+ (fun (w:A) (h1:Rstar x w) (h2:Rstar y w) =>
+ coherence_intro y x w h2 h1) h.
+
+Definition confluence (x:A) :=
+ forall y z:A, Rstar x y -> Rstar x z -> coherence y z.
-Definition local_confluence :=
- [x:A](y:A)(z:A)(R x y)->(R x z)->(coherence y z).
+Definition local_confluence (x:A) :=
+ forall y z:A, R x y -> R x z -> coherence y z.
Definition noetherian :=
- (x:A)(P:A->Prop)((y:A)((z:A)(R y z)->(P z))->(P y))->(P x).
+ forall (x:A) (P:A -> Prop),
+ (forall y:A, (forall z:A, R y z -> P z) -> P y) -> P x.
Section Newman_section.
(** The general hypotheses of the theorem *)
-Hypothesis Hyp1:noetherian.
-Hypothesis Hyp2:(x:A)(local_confluence x).
+Hypothesis Hyp1 : noetherian.
+Hypothesis Hyp2 : forall x:A, local_confluence x.
(** The induction hypothesis *)
Section Induct.
- Variable x:A.
- Hypothesis hyp_ind:(u:A)(R x u)->(confluence u).
+ Variable x : A.
+ Hypothesis hyp_ind : forall u:A, R x u -> confluence u.
(** Confluence in [x] *)
- Variables y,z:A.
- Hypothesis h1:(Rstar x y).
- Hypothesis h2:(Rstar x z).
+ Variables y z : A.
+ Hypothesis h1 : Rstar x y.
+ Hypothesis h2 : Rstar x z.
(** particular case [x->u] and [u->*y] *)
Section Newman_.
- Variable u:A.
- Hypothesis t1:(R x u).
- Hypothesis t2:(Rstar u y).
+ Variable u : A.
+ Hypothesis t1 : R x u.
+ Hypothesis t2 : Rstar u y.
(** In the usual diagram, we assume also [x->v] and [v->*z] *)
-Theorem Diagram : (v:A)(u1:(R x v))(u2:(Rstar v z))(coherence y z).
-
-Proof (* We draw the diagram ! *)
- [v:A][u1:(R x v)][u2:(Rstar v z)]
- (exT2_ind A (Rstar u) (Rstar v) (* local confluence in x for u,v *)
- (coherence y z) (* gives w, u->*w and v->*w *)
- ([w:A][s1:(Rstar u w)][s2:(Rstar v w)]
- (exT2_ind A (Rstar y) (Rstar w) (* confluence in u => coherence(y,w) *)
- (coherence y z) (* gives a, y->*a and z->*a *)
- ([a:A][v1:(Rstar y a)][v2:(Rstar w a)]
- (exT2_ind A (Rstar a) (Rstar z) (* confluence in v => coherence(a,z) *)
- (coherence y z) (* gives b, a->*b and z->*b *)
- ([b:A][w1:(Rstar a b)][w2:(Rstar z b)]
- (coherence_intro y z b (Rstar_transitive y a b v1 w1) w2))
- (hyp_ind v u1 a z (Rstar_transitive v w a s2 v2) u2)))
- (hyp_ind u t1 y w t2 s1)))
- (Hyp2 x u v t1 u1)).
+Theorem Diagram : forall (v:A) (u1:R x v) (u2:Rstar v z), coherence y z.
+
+Proof
+ (* We draw the diagram ! *)
+ fun (v:A) (u1:R x v) (u2:Rstar v z) =>
+ ex2_ind
+ (* local confluence in x for u,v *)
+ (* gives w, u->*w and v->*w *)
+ (fun (w:A) (s1:Rstar u w) (s2:Rstar v w) =>
+ ex2_ind
+ (* confluence in u => coherence(y,w) *)
+ (* gives a, y->*a and z->*a *)
+ (fun (a:A) (v1:Rstar y a) (v2:Rstar w a) =>
+ ex2_ind
+ (* confluence in v => coherence(a,z) *)
+ (* gives b, a->*b and z->*b *)
+ (fun (b:A) (w1:Rstar a b) (w2:Rstar z b) =>
+ coherence_intro y z b (Rstar_transitive y a b v1 w1) w2)
+ (hyp_ind v u1 a z (Rstar_transitive v w a s2 v2) u2))
+ (hyp_ind u t1 y w t2 s1)) (Hyp2 x u v t1 u1).
-Theorem caseRxy : (coherence y z).
-Proof (Rstar_Rstar' x z h2
- ([v:A][w:A](coherence y w))
- (coherence_sym x y (Rstar_coherence x y h1)) (*i case x=z i*)
- Diagram). (*i case x->v->*z i*)
+Theorem caseRxy : coherence y z.
+Proof
+ Rstar_Rstar' x z h2 (fun v w:A => coherence y w)
+ (coherence_sym x y (Rstar_coherence x y h1)) (*i case x=z i*)
+ Diagram. (*i case x->v->*z i*)
End Newman_.
-Theorem Ind_proof : (coherence y z).
-Proof (Rstar_Rstar' x y h1 ([u:A][v:A](coherence v z))
- (Rstar_coherence x z h2) (*i case x=y i*)
- caseRxy). (*i case x->u->*z i*)
+Theorem Ind_proof : coherence y z.
+Proof
+ Rstar_Rstar' x y h1 (fun u v:A => coherence v z)
+ (Rstar_coherence x z h2) (*i case x=y i*)
+ caseRxy. (*i case x->u->*z i*)
End Induct.
-Theorem Newman : (x:A)(confluence x).
-Proof [x:A](Hyp1 x confluence Ind_proof).
+Theorem Newman : forall x:A, confluence x.
+Proof fun x:A => Hyp1 x confluence Ind_proof.
End Newman_section.
End Newman.
-
diff --git a/theories/Relations/Operators_Properties.v b/theories/Relations/Operators_Properties.v
index 0ca819b84..9534f707f 100755
--- a/theories/Relations/Operators_Properties.v
+++ b/theories/Relations/Operators_Properties.v
@@ -12,55 +12,53 @@
(* Bruno Barras *)
(****************************************************************************)
-Require Relation_Definitions.
-Require Relation_Operators.
+Require Import Relation_Definitions.
+Require Import Relation_Operators.
Section Properties.
- Variable A: Set.
- Variable R: (relation A).
+ Variable A : Set.
+ Variable R : relation A.
- Local incl : (relation A)->(relation A)->Prop :=
- [R1,R2: (relation A)] (x,y:A) (R1 x y) -> (R2 x y).
+ Let incl (R1 R2:relation A) : Prop := forall x y:A, R1 x y -> R2 x y.
Section Clos_Refl_Trans.
- Lemma clos_rt_is_preorder: (preorder A (clos_refl_trans A R)).
-Apply Build_preorder.
-Exact (rt_refl A R).
+ Lemma clos_rt_is_preorder : preorder A (clos_refl_trans A R).
+apply Build_preorder.
+exact (rt_refl A R).
-Exact (rt_trans A R).
+exact (rt_trans A R).
Qed.
-Lemma clos_rt_idempotent:
- (incl (clos_refl_trans A (clos_refl_trans A R))
- (clos_refl_trans A R)).
-Red.
-NewInduction 1; Auto with sets.
-Intros.
-Apply rt_trans with y; Auto with sets.
+Lemma clos_rt_idempotent :
+ incl (clos_refl_trans A (clos_refl_trans A R)) (clos_refl_trans A R).
+red in |- *.
+induction 1; auto with sets.
+intros.
+apply rt_trans with y; auto with sets.
Qed.
- Lemma clos_refl_trans_ind_left: (A:Set)(R:A->A->Prop)(M:A)(P:A->Prop)
- (P M)
- ->((P0,N:A)
- (clos_refl_trans A R M P0)->(P P0)->(R P0 N)->(P N))
- ->(a:A)(clos_refl_trans A R M a)->(P a).
-Intros.
-Generalize H H0 .
-Clear H H0.
-Elim H1; Intros; Auto with sets.
-Apply H2 with x; Auto with sets.
-
-Apply H3.
-Apply H0; Auto with sets.
-
-Intros.
-Apply H5 with P0; Auto with sets.
-Apply rt_trans with y; Auto with sets.
+ Lemma clos_refl_trans_ind_left :
+ forall (A:Set) (R:A -> A -> Prop) (M:A) (P:A -> Prop),
+ P M ->
+ (forall P0 N:A, clos_refl_trans A R M P0 -> P P0 -> R P0 N -> P N) ->
+ forall a:A, clos_refl_trans A R M a -> P a.
+intros.
+generalize H H0.
+clear H H0.
+elim H1; intros; auto with sets.
+apply H2 with x; auto with sets.
+
+apply H3.
+apply H0; auto with sets.
+
+intros.
+apply H5 with P0; auto with sets.
+apply rt_trans with y; auto with sets.
Qed.
@@ -69,30 +67,30 @@ End Clos_Refl_Trans.
Section Clos_Refl_Sym_Trans.
- Lemma clos_rt_clos_rst: (inclusion A (clos_refl_trans A R)
- (clos_refl_sym_trans A R)).
-Red.
-NewInduction 1; Auto with sets.
-Apply rst_trans with y; Auto with sets.
+ Lemma clos_rt_clos_rst :
+ inclusion A (clos_refl_trans A R) (clos_refl_sym_trans A R).
+red in |- *.
+induction 1; auto with sets.
+apply rst_trans with y; auto with sets.
Qed.
- Lemma clos_rst_is_equiv: (equivalence A (clos_refl_sym_trans A R)).
-Apply Build_equivalence.
-Exact (rst_refl A R).
+ Lemma clos_rst_is_equiv : equivalence A (clos_refl_sym_trans A R).
+apply Build_equivalence.
+exact (rst_refl A R).
-Exact (rst_trans A R).
+exact (rst_trans A R).
-Exact (rst_sym A R).
+exact (rst_sym A R).
Qed.
- Lemma clos_rst_idempotent:
- (incl (clos_refl_sym_trans A (clos_refl_sym_trans A R))
- (clos_refl_sym_trans A R)).
-Red.
-NewInduction 1; Auto with sets.
-Apply rst_trans with y; Auto with sets.
+ Lemma clos_rst_idempotent :
+ incl (clos_refl_sym_trans A (clos_refl_sym_trans A R))
+ (clos_refl_sym_trans A R).
+red in |- *.
+induction 1; auto with sets.
+apply rst_trans with y; auto with sets.
Qed.
End Clos_Refl_Sym_Trans.
-End Properties.
+End Properties. \ No newline at end of file
diff --git a/theories/Relations/Relation_Definitions.v b/theories/Relations/Relation_Definitions.v
index 32f433d07..06440fd86 100755
--- a/theories/Relations/Relation_Definitions.v
+++ b/theories/Relations/Relation_Definitions.v
@@ -10,19 +10,19 @@
Section Relation_Definition.
- Variable A: Type.
+ Variable A : Type.
- Definition relation := A -> A -> Prop.
+ Definition relation := A -> A -> Prop.
- Variable R: relation.
+ Variable R : relation.
Section General_Properties_of_Relations.
- Definition reflexive : Prop := (x: A) (R x x).
- Definition transitive : Prop := (x,y,z: A) (R x y) -> (R y z) -> (R x z).
- Definition symmetric : Prop := (x,y: A) (R x y) -> (R y x).
- Definition antisymmetric : Prop := (x,y: A) (R x y) -> (R y x) -> x=y.
+ Definition reflexive : Prop := forall x:A, R x x.
+ Definition transitive : Prop := forall x y z:A, R x y -> R y z -> R x z.
+ Definition symmetric : Prop := forall x y:A, R x y -> R y x.
+ Definition antisymmetric : Prop := forall x y:A, R x y -> R y x -> x = y.
(* for compatibility with Equivalence in ../PROGRAMS/ALG/ *)
Definition equiv := reflexive /\ transitive /\ symmetric.
@@ -33,23 +33,20 @@ End General_Properties_of_Relations.
Section Sets_of_Relations.
- Record preorder : Prop := {
- preord_refl : reflexive;
- preord_trans : transitive }.
+ Record preorder : Prop :=
+ {preord_refl : reflexive; preord_trans : transitive}.
- Record order : Prop := {
- ord_refl : reflexive;
- ord_trans : transitive;
- ord_antisym : antisymmetric }.
+ Record order : Prop :=
+ {ord_refl : reflexive;
+ ord_trans : transitive;
+ ord_antisym : antisymmetric}.
- Record equivalence : Prop := {
- equiv_refl : reflexive;
- equiv_trans : transitive;
- equiv_sym : symmetric }.
+ Record equivalence : Prop :=
+ {equiv_refl : reflexive;
+ equiv_trans : transitive;
+ equiv_sym : symmetric}.
- Record PER : Prop := {
- per_sym : symmetric;
- per_trans : transitive }.
+ Record PER : Prop := {per_sym : symmetric; per_trans : transitive}.
End Sets_of_Relations.
@@ -57,27 +54,25 @@ End Sets_of_Relations.
Section Relations_of_Relations.
- Definition inclusion : relation -> relation -> Prop :=
- [R1,R2: relation] (x,y:A) (R1 x y) -> (R2 x y).
+ Definition inclusion (R1 R2:relation) : Prop :=
+ forall x y:A, R1 x y -> R2 x y.
- Definition same_relation : relation -> relation -> Prop :=
- [R1,R2: relation] (inclusion R1 R2) /\ (inclusion R2 R1).
+ Definition same_relation (R1 R2:relation) : Prop :=
+ inclusion R1 R2 /\ inclusion R2 R1.
- Definition commut : relation -> relation -> Prop :=
- [R1,R2:relation] (x,y:A) (R1 y x) -> (z:A) (R2 z y)
- -> (EX y':A |(R2 y' x) & (R1 z y')).
+ Definition commut (R1 R2:relation) : Prop :=
+ forall x y:A,
+ R1 y x -> forall z:A, R2 z y -> exists2 y' : A | R2 y' x & R1 z y'.
End Relations_of_Relations.
End Relation_Definition.
-Hints Unfold reflexive transitive antisymmetric symmetric : sets v62.
+Hint Unfold reflexive transitive antisymmetric symmetric: sets v62.
-Hints Resolve Build_preorder Build_order Build_equivalence
- Build_PER preord_refl preord_trans
- ord_refl ord_trans ord_antisym
- equiv_refl equiv_trans equiv_sym
- per_sym per_trans : sets v62.
+Hint Resolve Build_preorder Build_order Build_equivalence Build_PER
+ preord_refl preord_trans ord_refl ord_trans ord_antisym equiv_refl
+ equiv_trans equiv_sym per_sym per_trans: sets v62.
-Hints Unfold inclusion same_relation commut : sets v62.
+Hint Unfold inclusion same_relation commut: sets v62. \ No newline at end of file
diff --git a/theories/Relations/Relation_Operators.v b/theories/Relations/Relation_Operators.v
index 7b07ac0db..0d5f2fd97 100755
--- a/theories/Relations/Relation_Operators.v
+++ b/theories/Relations/Relation_Operators.v
@@ -16,72 +16,76 @@
(* L. Paulson JSC (1986) 2, 325-355 *)
(****************************************************************************)
-Require Relation_Definitions.
-Require PolyList.
-Require PolyListSyntax.
+Require Import Relation_Definitions.
+Require Import List.
(** Some operators to build relations *)
Section Transitive_Closure.
- Variable A: Set.
- Variable R: (relation A).
+ Variable A : Set.
+ Variable R : relation A.
- Inductive clos_trans : A->A->Prop :=
- t_step: (x,y:A)(R x y)->(clos_trans x y)
- | t_trans: (x,y,z:A)(clos_trans x y)->(clos_trans y z)->(clos_trans x z).
+ Inductive clos_trans : A -> A -> Prop :=
+ | t_step : forall x y:A, R x y -> clos_trans x y
+ | t_trans :
+ forall x y z:A, clos_trans x y -> clos_trans y z -> clos_trans x z.
End Transitive_Closure.
Section Reflexive_Transitive_Closure.
- Variable A: Set.
- Variable R: (relation A).
-
- Inductive clos_refl_trans: (relation A) :=
- rt_step: (x,y:A)(R x y)->(clos_refl_trans x y)
- | rt_refl: (x:A)(clos_refl_trans x x)
- | rt_trans: (x,y,z: A)(clos_refl_trans x y)->(clos_refl_trans y z)
- ->(clos_refl_trans x z).
+ Variable A : Set.
+ Variable R : relation A.
+
+ Inductive clos_refl_trans : relation A :=
+ | rt_step : forall x y:A, R x y -> clos_refl_trans x y
+ | rt_refl : forall x:A, clos_refl_trans x x
+ | rt_trans :
+ forall x y z:A,
+ clos_refl_trans x y -> clos_refl_trans y z -> clos_refl_trans x z.
End Reflexive_Transitive_Closure.
Section Reflexive_Symetric_Transitive_Closure.
- Variable A: Set.
- Variable R: (relation A).
-
- Inductive clos_refl_sym_trans: (relation A) :=
- rst_step: (x,y:A)(R x y)->(clos_refl_sym_trans x y)
- | rst_refl: (x:A)(clos_refl_sym_trans x x)
- | rst_sym: (x,y:A)(clos_refl_sym_trans x y)->(clos_refl_sym_trans y x)
- | rst_trans: (x,y,z:A)(clos_refl_sym_trans x y)->(clos_refl_sym_trans y z)
- ->(clos_refl_sym_trans x z).
+ Variable A : Set.
+ Variable R : relation A.
+
+ Inductive clos_refl_sym_trans : relation A :=
+ | rst_step : forall x y:A, R x y -> clos_refl_sym_trans x y
+ | rst_refl : forall x:A, clos_refl_sym_trans x x
+ | rst_sym :
+ forall x y:A, clos_refl_sym_trans x y -> clos_refl_sym_trans y x
+ | rst_trans :
+ forall x y z:A,
+ clos_refl_sym_trans x y ->
+ clos_refl_sym_trans y z -> clos_refl_sym_trans x z.
End Reflexive_Symetric_Transitive_Closure.
Section Transposee.
- Variable A: Set.
- Variable R: (relation A).
+ Variable A : Set.
+ Variable R : relation A.
- Definition transp := [x,y:A](R y x).
+ Definition transp (x y:A) := R y x.
End Transposee.
Section Union.
- Variable A: Set.
- Variable R1,R2: (relation A).
+ Variable A : Set.
+ Variables R1 R2 : relation A.
- Definition union := [x,y:A](R1 x y)\/(R2 x y).
+ Definition union (x y:A) := R1 x y \/ R2 x y.
End Union.
Section Disjoint_Union.
-Variable A,B:Set.
-Variable leA: A->A->Prop.
-Variable leB: B->B->Prop.
+Variables A B : Set.
+Variable leA : A -> A -> Prop.
+Variable leB : B -> B -> Prop.
-Inductive le_AsB : A+B->A+B->Prop :=
- le_aa: (x,y:A) (leA x y) -> (le_AsB (inl A B x) (inl A B y))
-| le_ab: (x:A)(y:B) (le_AsB (inl A B x) (inr A B y))
-| le_bb: (x,y:B) (leB x y) -> (le_AsB (inr A B x) (inr A B y)).
+Inductive le_AsB : A + B -> A + B -> Prop :=
+ | le_aa : forall x y:A, leA x y -> le_AsB (inl B x) (inl B y)
+ | le_ab : forall (x:A) (y:B), le_AsB (inl B x) (inr A y)
+ | le_bb : forall x y:B, leB x y -> le_AsB (inr A x) (inr A y).
End Disjoint_Union.
@@ -90,68 +94,74 @@ End Disjoint_Union.
Section Lexicographic_Product.
(* Lexicographic order on dependent pairs *)
-Variable A:Set.
-Variable B:A->Set.
-Variable leA: A->A->Prop.
-Variable leB: (x:A)(B x)->(B x)->Prop.
-
-Inductive lexprod : (sigS A B) -> (sigS A B) ->Prop :=
- left_lex : (x,x':A)(y:(B x)) (y':(B x'))
- (leA x x') ->(lexprod (existS A B x y) (existS A B x' y'))
-| right_lex : (x:A) (y,y':(B x))
- (leB x y y') -> (lexprod (existS A B x y) (existS A B x y')).
+Variable A : Set.
+Variable B : A -> Set.
+Variable leA : A -> A -> Prop.
+Variable leB : forall x:A, B x -> B x -> Prop.
+
+Inductive lexprod : sigS B -> sigS B -> Prop :=
+ | left_lex :
+ forall (x x':A) (y:B x) (y':B x'),
+ leA x x' -> lexprod (existS B x y) (existS B x' y')
+ | right_lex :
+ forall (x:A) (y y':B x),
+ leB x y y' -> lexprod (existS B x y) (existS B x y').
End Lexicographic_Product.
Section Symmetric_Product.
- Variable A:Set.
- Variable B:Set.
- Variable leA: A->A->Prop.
- Variable leB: B->B->Prop.
+ Variable A : Set.
+ Variable B : Set.
+ Variable leA : A -> A -> Prop.
+ Variable leB : B -> B -> Prop.
- Inductive symprod : (A*B) -> (A*B) ->Prop :=
- left_sym : (x,x':A)(leA x x')->(y:B)(symprod (x,y) (x',y))
- | right_sym : (y,y':B)(leB y y')->(x:A)(symprod (x,y) (x,y')).
+ Inductive symprod : A * B -> A * B -> Prop :=
+ | left_sym :
+ forall x x':A, leA x x' -> forall y:B, symprod (x, y) (x', y)
+ | right_sym :
+ forall y y':B, leB y y' -> forall x:A, symprod (x, y) (x, y').
End Symmetric_Product.
Section Swap.
- Variable A:Set.
- Variable R:A->A->Prop.
-
- Inductive swapprod: (A*A)->(A*A)->Prop :=
- sp_noswap: (x,x':A*A)(symprod A A R R x x')->(swapprod x x')
- | sp_swap: (x,y:A)(p:A*A)(symprod A A R R (x,y) p)->(swapprod (y,x) p).
+ Variable A : Set.
+ Variable R : A -> A -> Prop.
+
+ Inductive swapprod : A * A -> A * A -> Prop :=
+ | sp_noswap : forall x x':A * A, symprod A A R R x x' -> swapprod x x'
+ | sp_swap :
+ forall (x y:A) (p:A * A),
+ symprod A A R R (x, y) p -> swapprod (y, x) p.
End Swap.
Section Lexicographic_Exponentiation.
Variable A : Set.
-Variable leA : A->A->Prop.
-Local Nil := (nil A).
-Local List := (list A).
+Variable leA : A -> A -> Prop.
+Let Nil := nil (A:=A).
+Let List := list A.
-Inductive Ltl : List->List->Prop :=
- Lt_nil: (a:A)(x:List)(Ltl Nil (cons a x))
-| Lt_hd : (a,b:A) (leA a b)-> (x,y:(list A))(Ltl (cons a x) (cons b y))
-| Lt_tl : (a:A)(x,y:List)(Ltl x y) -> (Ltl (cons a x) (cons a y)).
+Inductive Ltl : List -> List -> Prop :=
+ | Lt_nil : forall (a:A) (x:List), Ltl Nil (a :: x)
+ | Lt_hd : forall a b:A, leA a b -> forall x y:list A, Ltl (a :: x) (b :: y)
+ | Lt_tl : forall (a:A) (x y:List), Ltl x y -> Ltl (a :: x) (a :: y).
-Inductive Desc : List->Prop :=
- d_nil : (Desc Nil)
-| d_one : (x:A)(Desc (cons x Nil))
-| d_conc : (x,y:A)(l:List)(leA x y)
- -> (Desc l^(cons y Nil))->(Desc (l^(cons y Nil))^(cons x Nil)).
+Inductive Desc : List -> Prop :=
+ | d_nil : Desc Nil
+ | d_one : forall x:A, Desc (x :: Nil)
+ | d_conc :
+ forall (x y:A) (l:List),
+ leA x y -> Desc (l ++ y :: Nil) -> Desc ((l ++ y :: Nil) ++ x :: Nil).
-Definition Pow :Set := (sig List Desc).
+Definition Pow : Set := sig Desc.
-Definition lex_exp : Pow -> Pow ->Prop :=
- [a,b:Pow](Ltl (proj1_sig List Desc a) (proj1_sig List Desc b)).
+Definition lex_exp (a b:Pow) : Prop := Ltl (proj1_sig a) (proj1_sig b).
End Lexicographic_Exponentiation.
-Hints Unfold transp union : sets v62.
-Hints Resolve t_step rt_step rt_refl rst_step rst_refl : sets v62.
-Hints Immediate rst_sym : sets v62.
+Hint Unfold transp union: sets v62.
+Hint Resolve t_step rt_step rt_refl rst_step rst_refl: sets v62.
+Hint Immediate rst_sym: sets v62. \ No newline at end of file
diff --git a/theories/Relations/Relations.v b/theories/Relations/Relations.v
index f792e4c2a..d2c3e2776 100755
--- a/theories/Relations/Relations.v
+++ b/theories/Relations/Relations.v
@@ -12,17 +12,17 @@ Require Export Relation_Definitions.
Require Export Relation_Operators.
Require Export Operators_Properties.
-Lemma inverse_image_of_equivalence : (A,B:Set)(f:A->B)
- (r:(relation B))(equivalence B r)->(equivalence A [x,y:A](r (f x) (f y))).
-Intros; Split; Elim H; Red; Auto.
-Intros _ equiv_trans _ x y z H0 H1; Apply equiv_trans with (f y); Assumption.
+Lemma inverse_image_of_equivalence :
+ forall (A B:Set) (f:A -> B) (r:relation B),
+ equivalence B r -> equivalence A (fun x y:A => r (f x) (f y)).
+intros; split; elim H; red in |- *; auto.
+intros _ equiv_trans _ x y z H0 H1; apply equiv_trans with (f y); assumption.
Qed.
-Lemma inverse_image_of_eq : (A,B:Set)(f:A->B)
- (equivalence A [x,y:A](f x)=(f y)).
-Split; Red;
-[ (* reflexivity *) Reflexivity
-| (* transitivity *) Intros; Transitivity (f y); Assumption
-| (* symmetry *) Intros; Symmetry; Assumption
-].
-Qed.
+Lemma inverse_image_of_eq :
+ forall (A B:Set) (f:A -> B), equivalence A (fun x y:A => f x = f y).
+split; red in |- *;
+ [ (* reflexivity *) reflexivity
+ | (* transitivity *) intros; transitivity (f y); assumption
+ | (* symmetry *) intros; symmetry in |- *; assumption ].
+Qed. \ No newline at end of file
diff --git a/theories/Relations/Rstar.v b/theories/Relations/Rstar.v
index 90ab6d6c2..349650629 100755
--- a/theories/Relations/Rstar.v
+++ b/theories/Relations/Rstar.v
@@ -13,66 +13,75 @@
Section Rstar.
Variable A : Type.
-Variable R : A->A->Prop.
+Variable R : A -> A -> Prop.
(** Definition of the reflexive-transitive closure [R*] of [R] *)
(** Smallest reflexive [P] containing [R o P] *)
-Definition Rstar := [x,y:A](P:A->A->Prop)
- ((u:A)(P u u))->((u:A)(v:A)(w:A)(R u v)->(P v w)->(P u w)) -> (P x y).
+Definition Rstar (x y:A) :=
+ forall P:A -> A -> Prop,
+ (forall u:A, P u u) -> (forall u v w:A, R u v -> P v w -> P u w) -> P x y.
-Theorem Rstar_reflexive: (x:A)(Rstar x x).
- Proof [x:A][P:A->A->Prop]
- [h1:(u:A)(P u u)][h2:(u:A)(v:A)(w:A)(R u v)->(P v w)->(P u w)]
- (h1 x).
+Theorem Rstar_reflexive : forall x:A, Rstar x x.
+ Proof
+ fun (x:A) (P:A -> A -> Prop) (h1:forall u:A, P u u)
+ (h2:forall u v w:A, R u v -> P v w -> P u w) =>
+ h1 x.
-Theorem Rstar_R: (x:A)(y:A)(z:A)(R x y)->(Rstar y z)->(Rstar x z).
- Proof [x:A][y:A][z:A][t1:(R x y)][t2:(Rstar y z)]
- [P:A->A->Prop]
- [h1:(u:A)(P u u)][h2:(u:A)(v:A)(w:A)(R u v)->(P v w)->(P u w)]
- (h2 x y z t1 (t2 P h1 h2)).
+Theorem Rstar_R : forall x y z:A, R x y -> Rstar y z -> Rstar x z.
+ Proof
+ fun (x y z:A) (t1:R x y) (t2:Rstar y z) (P:A -> A -> Prop)
+ (h1:forall u:A, P u u) (h2:forall u v w:A, R u v -> P v w -> P u w) =>
+ h2 x y z t1 (t2 P h1 h2).
(** We conclude with transitivity of [Rstar] : *)
-Theorem Rstar_transitive: (x:A)(y:A)(z:A)(Rstar x y)->(Rstar y z)->(Rstar x z).
- Proof [x:A][y:A][z:A][h:(Rstar x y)]
- (h ([u:A][v:A](Rstar v z)->(Rstar u z))
- ([u:A][t:(Rstar u z)]t)
- ([u:A][v:A][w:A][t1:(R u v)][t2:(Rstar w z)->(Rstar v z)]
- [t3:(Rstar w z)](Rstar_R u v z t1 (t2 t3)))).
+Theorem Rstar_transitive :
+ forall x y z:A, Rstar x y -> Rstar y z -> Rstar x z.
+ Proof
+ fun (x y z:A) (h:Rstar x y) =>
+ h (fun u v:A => Rstar v z -> Rstar u z) (fun (u:A) (t:Rstar u z) => t)
+ (fun (u v w:A) (t1:R u v) (t2:Rstar w z -> Rstar v z)
+ (t3:Rstar w z) => Rstar_R u v z t1 (t2 t3)).
(** Another characterization of [R*] *)
(** Smallest reflexive [P] containing [R o R*] *)
-Definition Rstar' := [x:A][y:A](P:A->A->Prop)
- ((P x x))->((u:A)(R x u)->(Rstar u y)->(P x y)) -> (P x y).
+Definition Rstar' (x y:A) :=
+ forall P:A -> A -> Prop,
+ P x x -> (forall u:A, R x u -> Rstar u y -> P x y) -> P x y.
-Theorem Rstar'_reflexive: (x:A)(Rstar' x x).
- Proof [x:A][P:A->A->Prop][h:(P x x)][h':(u:A)(R x u)->(Rstar u x)->(P x x)]h.
+Theorem Rstar'_reflexive : forall x:A, Rstar' x x.
+ Proof
+ fun (x:A) (P:A -> A -> Prop) (h:P x x)
+ (h':forall u:A, R x u -> Rstar u x -> P x x) => h.
-Theorem Rstar'_R: (x:A)(y:A)(z:A)(R x z)->(Rstar z y)->(Rstar' x y).
- Proof [x:A][y:A][z:A][t1:(R x z)][t2:(Rstar z y)]
- [P:A->A->Prop][h1:(P x x)]
- [h2:(u:A)(R x u)->(Rstar u y)->(P x y)](h2 z t1 t2).
+Theorem Rstar'_R : forall x y z:A, R x z -> Rstar z y -> Rstar' x y.
+ Proof
+ fun (x y z:A) (t1:R x z) (t2:Rstar z y) (P:A -> A -> Prop)
+ (h1:P x x) (h2:forall u:A, R x u -> Rstar u y -> P x y) =>
+ h2 z t1 t2.
(** Equivalence of the two definitions: *)
-Theorem Rstar'_Rstar: (x:A)(y:A)(Rstar' x y)->(Rstar x y).
- Proof [x:A][y:A][h:(Rstar' x y)]
- (h Rstar (Rstar_reflexive x) ([u:A](Rstar_R x u y))).
+Theorem Rstar'_Rstar : forall x y:A, Rstar' x y -> Rstar x y.
+ Proof
+ fun (x y:A) (h:Rstar' x y) =>
+ h Rstar (Rstar_reflexive x) (fun u:A => Rstar_R x u y).
-Theorem Rstar_Rstar': (x:A)(y:A)(Rstar x y)->(Rstar' x y).
- Proof [x:A][y:A][h:(Rstar x y)](h Rstar' ([u:A](Rstar'_reflexive u))
- ([u:A][v:A][w:A][h1:(R u v)][h2:(Rstar' v w)]
- (Rstar'_R u w v h1 (Rstar'_Rstar v w h2)))).
+Theorem Rstar_Rstar' : forall x y:A, Rstar x y -> Rstar' x y.
+ Proof
+ fun (x y:A) (h:Rstar x y) =>
+ h Rstar' (fun u:A => Rstar'_reflexive u)
+ (fun (u v w:A) (h1:R u v) (h2:Rstar' v w) =>
+ Rstar'_R u w v h1 (Rstar'_Rstar v w h2)).
(** Property of Commutativity of two relations *)
-Definition commut := [A:Set][R1,R2:A->A->Prop]
- (x,y:A)(R1 y x)->(z:A)(R2 z y)
- ->(EX y':A |(R2 y' x) & (R1 z y')).
+Definition commut (A:Set) (R1 R2:A -> A -> Prop) :=
+ forall x y:A,
+ R1 y x -> forall z:A, R2 z y -> exists2 y' : A | R2 y' x & R1 z y'.
End Rstar.
-
diff --git a/theories/Setoids/Setoid.v b/theories/Setoids/Setoid.v
index 8a5a9892a..0051c4e00 100644
--- a/theories/Setoids/Setoid.v
+++ b/theories/Setoids/Setoid.v
@@ -13,61 +13,59 @@ Section Setoid.
Variable A : Type.
Variable Aeq : A -> A -> Prop.
-Record Setoid_Theory : Prop :=
-{ Seq_refl : (x:A) (Aeq x x);
- Seq_sym : (x,y:A) (Aeq x y) -> (Aeq y x);
- Seq_trans : (x,y,z:A) (Aeq x y) -> (Aeq y z) -> (Aeq x z)
-}.
+Record Setoid_Theory : Prop :=
+ {Seq_refl : forall x:A, Aeq x x;
+ Seq_sym : forall x y:A, Aeq x y -> Aeq y x;
+ Seq_trans : forall x y z:A, Aeq x y -> Aeq y z -> Aeq x z}.
End Setoid.
-Definition Prop_S : (Setoid_Theory Prop iff).
-Split; [Exact iff_refl | Exact iff_sym | Exact iff_trans].
+Definition Prop_S : Setoid_Theory Prop iff.
+split; [ exact iff_refl | exact iff_sym | exact iff_trans ].
Qed.
Add Setoid Prop iff Prop_S.
-Hint prop_set : setoid := Resolve (Seq_refl Prop iff Prop_S).
-Hint prop_set : setoid := Resolve (Seq_sym Prop iff Prop_S).
-Hint prop_set : setoid := Resolve (Seq_trans Prop iff Prop_S).
+Hint Resolve (Seq_refl Prop iff Prop_S): setoid.
+Hint Resolve (Seq_sym Prop iff Prop_S): setoid.
+Hint Resolve (Seq_trans Prop iff Prop_S): setoid.
Add Morphism or : or_ext.
-Intros.
-Inversion H1.
-Left.
-Inversion H.
-Apply (H3 H2).
-
-Right.
-Inversion H0.
-Apply (H3 H2).
+intros.
+inversion H1.
+left.
+inversion H.
+apply (H3 H2).
+
+right.
+inversion H0.
+apply (H3 H2).
Qed.
Add Morphism and : and_ext.
-Intros.
-Inversion H1.
-Split.
-Inversion H.
-Apply (H4 H2).
-
-Inversion H0.
-Apply (H4 H3).
+intros.
+inversion H1.
+split.
+inversion H.
+apply (H4 H2).
+
+inversion H0.
+apply (H4 H3).
Qed.
Add Morphism not : not_ext.
-Red ; Intros.
-Apply H0.
-Inversion H.
-Apply (H3 H1).
+red in |- *; intros.
+apply H0.
+inversion H.
+apply (H3 H1).
Qed.
-Definition fleche [A,B:Prop] := A -> B.
+Definition fleche (A B:Prop) := A -> B.
Add Morphism fleche : fleche_ext.
-Unfold fleche.
-Intros.
-Inversion H0.
-Inversion H.
-Apply (H3 (H1 (H6 H2))).
+unfold fleche in |- *.
+intros.
+inversion H0.
+inversion H.
+apply (H3 (H1 (H6 H2))).
Qed.
-
diff --git a/theories/Sets/Classical_sets.v b/theories/Sets/Classical_sets.v
index cd72483a3..e2d707367 100755
--- a/theories/Sets/Classical_sets.v
+++ b/theories/Sets/Classical_sets.v
@@ -33,101 +33,100 @@ Require Export Classical_Type.
(* Hints Unfold not . *)
Section Ensembles_classical.
-Variable U: Type.
+Variable U : Type.
-Lemma not_included_empty_Inhabited:
- (A: (Ensemble U)) ~ (Included U A (Empty_set U)) -> (Inhabited U A).
+Lemma not_included_empty_Inhabited :
+ forall A:Ensemble U, ~ Included U A (Empty_set U) -> Inhabited U A.
Proof.
-Intros A NI.
-Elim (not_all_ex_not U [x:U]~(In U A x)).
-Intros x H; Apply Inhabited_intro with x.
-Apply NNPP; Auto with sets.
-Red; Intro.
-Apply NI; Red.
-Intros x H'; Elim (H x); Trivial with sets.
+intros A NI.
+elim (not_all_ex_not U (fun x:U => ~ In U A x)).
+intros x H; apply Inhabited_intro with x.
+apply NNPP; auto with sets.
+red in |- *; intro.
+apply NI; red in |- *.
+intros x H'; elim (H x); trivial with sets.
Qed.
-Hints Resolve not_included_empty_Inhabited.
+Hint Resolve not_included_empty_Inhabited.
-Lemma not_empty_Inhabited:
- (A: (Ensemble U)) ~ A == (Empty_set U) -> (Inhabited U A).
+Lemma not_empty_Inhabited :
+ forall A:Ensemble U, A <> Empty_set U -> Inhabited U A.
Proof.
-Intros; Apply not_included_empty_Inhabited.
-Red; Auto with sets.
+intros; apply not_included_empty_Inhabited.
+red in |- *; auto with sets.
Qed.
Lemma Inhabited_Setminus :
-(X, Y: (Ensemble U)) (Included U X Y) -> ~ (Included U Y X) ->
- (Inhabited U (Setminus U Y X)).
+ forall X Y:Ensemble U,
+ Included U X Y -> ~ Included U Y X -> Inhabited U (Setminus U Y X).
Proof.
-Intros X Y I NI.
-Elim (not_all_ex_not U [x:U](In U Y x)->(In U X x) NI).
-Intros x YX.
-Apply Inhabited_intro with x.
-Apply Setminus_intro.
-Apply not_imply_elim with (In U X x); Trivial with sets.
-Auto with sets.
+intros X Y I NI.
+elim (not_all_ex_not U (fun x:U => In U Y x -> In U X x) NI).
+intros x YX.
+apply Inhabited_intro with x.
+apply Setminus_intro.
+apply not_imply_elim with (In U X x); trivial with sets.
+auto with sets.
Qed.
-Hints Resolve Inhabited_Setminus.
+Hint Resolve Inhabited_Setminus.
-Lemma Strict_super_set_contains_new_element:
- (X, Y: (Ensemble U)) (Included U X Y) -> ~ X == Y ->
- (Inhabited U (Setminus U Y X)).
+Lemma Strict_super_set_contains_new_element :
+ forall X Y:Ensemble U,
+ Included U X Y -> X <> Y -> Inhabited U (Setminus U Y X).
Proof.
-Auto 7 with sets.
+auto 7 with sets.
Qed.
-Hints Resolve Strict_super_set_contains_new_element.
+Hint Resolve Strict_super_set_contains_new_element.
-Lemma Subtract_intro:
- (A: (Ensemble U)) (x, y: U) (In U A y) -> ~ x == y ->
- (In U (Subtract U A x) y).
+Lemma Subtract_intro :
+ forall (A:Ensemble U) (x y:U), In U A y -> x <> y -> In U (Subtract U A x) y.
Proof.
-Unfold 1 Subtract; Auto with sets.
+unfold Subtract at 1 in |- *; auto with sets.
Qed.
-Hints Resolve Subtract_intro.
+Hint Resolve Subtract_intro.
-Lemma Subtract_inv:
- (A: (Ensemble U)) (x, y: U) (In U (Subtract U A x) y) ->
- (In U A y) /\ ~ x == y.
+Lemma Subtract_inv :
+ forall (A:Ensemble U) (x y:U), In U (Subtract U A x) y -> In U A y /\ x <> y.
Proof.
-Intros A x y H'; Elim H'; Auto with sets.
+intros A x y H'; elim H'; auto with sets.
Qed.
-Lemma Included_Strict_Included:
- (X, Y: (Ensemble U)) (Included U X Y) -> (Strict_Included U X Y) \/ X == Y.
+Lemma Included_Strict_Included :
+ forall X Y:Ensemble U, Included U X Y -> Strict_Included U X Y \/ X = Y.
Proof.
-Intros X Y H'; Try Assumption.
-Elim (classic X == Y); Auto with sets.
+intros X Y H'; try assumption.
+elim (classic (X = Y)); auto with sets.
Qed.
-Lemma Strict_Included_inv:
- (X, Y: (Ensemble U)) (Strict_Included U X Y) ->
- (Included U X Y) /\ (Inhabited U (Setminus U Y X)).
+Lemma Strict_Included_inv :
+ forall X Y:Ensemble U,
+ Strict_Included U X Y -> Included U X Y /\ Inhabited U (Setminus U Y X).
Proof.
-Intros X Y H'; Red in H'.
-Split; [Tauto | Idtac].
-Elim H'; Intros H'0 H'1; Try Exact H'1; Clear H'.
-Apply Strict_super_set_contains_new_element; Auto with sets.
+intros X Y H'; red in H'.
+split; [ tauto | idtac ].
+elim H'; intros H'0 H'1; try exact H'1; clear H'.
+apply Strict_super_set_contains_new_element; auto with sets.
Qed.
-Lemma not_SIncl_empty:
- (X: (Ensemble U)) ~ (Strict_Included U X (Empty_set U)).
+Lemma not_SIncl_empty :
+ forall X:Ensemble U, ~ Strict_Included U X (Empty_set U).
Proof.
-Intro X; Red; Intro H'; Try Exact H'.
-LApply (Strict_Included_inv X (Empty_set U)); Auto with sets.
-Intro H'0; Elim H'0; Intros H'1 H'2; Elim H'2; Clear H'0.
-Intros x H'0; Elim H'0.
-Intro H'3; Elim H'3.
+intro X; red in |- *; intro H'; try exact H'.
+lapply (Strict_Included_inv X (Empty_set U)); auto with sets.
+intro H'0; elim H'0; intros H'1 H'2; elim H'2; clear H'0.
+intros x H'0; elim H'0.
+intro H'3; elim H'3.
Qed.
Lemma Complement_Complement :
- (A: (Ensemble U)) (Complement U (Complement U A)) == A.
+ forall A:Ensemble U, Complement U (Complement U A) = A.
Proof.
-Unfold Complement; Intros; Apply Extensionality_Ensembles; Auto with sets.
-Red; Split; Auto with sets.
-Red; Intros; Apply NNPP; Auto with sets.
+unfold Complement in |- *; intros; apply Extensionality_Ensembles;
+ auto with sets.
+red in |- *; split; auto with sets.
+red in |- *; intros; apply NNPP; auto with sets.
Qed.
End Ensembles_classical.
-Hints Resolve Strict_super_set_contains_new_element Subtract_intro
- not_SIncl_empty : sets v62.
+Hint Resolve Strict_super_set_contains_new_element Subtract_intro
+ not_SIncl_empty: sets v62. \ No newline at end of file
diff --git a/theories/Sets/Constructive_sets.v b/theories/Sets/Constructive_sets.v
index 78ad3d2f2..b4250be92 100755
--- a/theories/Sets/Constructive_sets.v
+++ b/theories/Sets/Constructive_sets.v
@@ -29,134 +29,131 @@
Require Export Ensembles.
Section Ensembles_facts.
-Variable U: Type.
+Variable U : Type.
-Lemma Extension: (B, C: (Ensemble U)) B == C -> (Same_set U B C).
+Lemma Extension : forall B C:Ensemble U, B = C -> Same_set U B C.
Proof.
-Intros B C H'; Rewrite H'; Auto with sets.
+intros B C H'; rewrite H'; auto with sets.
Qed.
-Lemma Noone_in_empty: (x: U) ~ (In U (Empty_set U) x).
+Lemma Noone_in_empty : forall x:U, ~ In U (Empty_set U) x.
Proof.
-Red; NewDestruct 1.
+red in |- *; destruct 1.
Qed.
-Hints Resolve Noone_in_empty.
+Hint Resolve Noone_in_empty.
-Lemma Included_Empty: (A: (Ensemble U))(Included U (Empty_set U) A).
+Lemma Included_Empty : forall A:Ensemble U, Included U (Empty_set U) A.
Proof.
-Intro; Red.
-Intros x H; Elim (Noone_in_empty x); Auto with sets.
+intro; red in |- *.
+intros x H; elim (Noone_in_empty x); auto with sets.
Qed.
-Hints Resolve Included_Empty.
+Hint Resolve Included_Empty.
-Lemma Add_intro1:
- (A: (Ensemble U)) (x, y: U) (In U A y) -> (In U (Add U A x) y).
+Lemma Add_intro1 :
+ forall (A:Ensemble U) (x y:U), In U A y -> In U (Add U A x) y.
Proof.
-Unfold 1 Add; Auto with sets.
+unfold Add at 1 in |- *; auto with sets.
Qed.
-Hints Resolve Add_intro1.
+Hint Resolve Add_intro1.
-Lemma Add_intro2: (A: (Ensemble U)) (x: U) (In U (Add U A x) x).
+Lemma Add_intro2 : forall (A:Ensemble U) (x:U), In U (Add U A x) x.
Proof.
-Unfold 1 Add; Auto with sets.
+unfold Add at 1 in |- *; auto with sets.
Qed.
-Hints Resolve Add_intro2.
+Hint Resolve Add_intro2.
-Lemma Inhabited_add: (A: (Ensemble U)) (x: U) (Inhabited U (Add U A x)).
+Lemma Inhabited_add : forall (A:Ensemble U) (x:U), Inhabited U (Add U A x).
Proof.
-Intros A x.
-Apply Inhabited_intro with x := x; Auto with sets.
+intros A x.
+apply Inhabited_intro with (x := x); auto with sets.
Qed.
-Hints Resolve Inhabited_add.
+Hint Resolve Inhabited_add.
-Lemma Inhabited_not_empty:
- (X: (Ensemble U)) (Inhabited U X) -> ~ X == (Empty_set U).
+Lemma Inhabited_not_empty :
+ forall X:Ensemble U, Inhabited U X -> X <> Empty_set U.
Proof.
-Intros X H'; Elim H'.
-Intros x H'0; Red; Intro H'1.
-Absurd (In U X x); Auto with sets.
-Rewrite H'1; Auto with sets.
+intros X H'; elim H'.
+intros x H'0; red in |- *; intro H'1.
+absurd (In U X x); auto with sets.
+rewrite H'1; auto with sets.
Qed.
-Hints Resolve Inhabited_not_empty.
+Hint Resolve Inhabited_not_empty.
-Lemma Add_not_Empty :
- (A: (Ensemble U)) (x: U) ~ (Add U A x) == (Empty_set U).
+Lemma Add_not_Empty : forall (A:Ensemble U) (x:U), Add U A x <> Empty_set U.
Proof.
-Auto with sets.
+auto with sets.
Qed.
-Hints Resolve Add_not_Empty.
+Hint Resolve Add_not_Empty.
-Lemma not_Empty_Add :
- (A: (Ensemble U)) (x: U) ~ (Empty_set U) == (Add U A x).
+Lemma not_Empty_Add : forall (A:Ensemble U) (x:U), Empty_set U <> Add U A x.
Proof.
-Intros; Red; Intro H; Generalize (Add_not_Empty A x); Auto with sets.
+intros; red in |- *; intro H; generalize (Add_not_Empty A x); auto with sets.
Qed.
-Hints Resolve not_Empty_Add.
+Hint Resolve not_Empty_Add.
-Lemma Singleton_inv: (x, y: U) (In U (Singleton U x) y) -> x == y.
+Lemma Singleton_inv : forall x y:U, In U (Singleton U x) y -> x = y.
Proof.
-Intros x y H'; Elim H'; Trivial with sets.
+intros x y H'; elim H'; trivial with sets.
Qed.
-Hints Resolve Singleton_inv.
+Hint Resolve Singleton_inv.
-Lemma Singleton_intro: (x, y: U) x == y -> (In U (Singleton U x) y).
+Lemma Singleton_intro : forall x y:U, x = y -> In U (Singleton U x) y.
Proof.
-Intros x y H'; Rewrite H'; Trivial with sets.
+intros x y H'; rewrite H'; trivial with sets.
Qed.
-Hints Resolve Singleton_intro.
+Hint Resolve Singleton_intro.
-Lemma Union_inv: (B, C: (Ensemble U)) (x: U)
- (In U (Union U B C) x) -> (In U B x) \/ (In U C x).
+Lemma Union_inv :
+ forall (B C:Ensemble U) (x:U), In U (Union U B C) x -> In U B x \/ In U C x.
Proof.
-Intros B C x H'; Elim H'; Auto with sets.
+intros B C x H'; elim H'; auto with sets.
Qed.
-Lemma Add_inv:
- (A: (Ensemble U)) (x, y: U) (In U (Add U A x) y) -> (In U A y) \/ x == y.
+Lemma Add_inv :
+ forall (A:Ensemble U) (x y:U), In U (Add U A x) y -> In U A y \/ x = y.
Proof.
-Intros A x y H'; Elim H'; Auto with sets.
+intros A x y H'; elim H'; auto with sets.
Qed.
-Lemma Intersection_inv:
- (B, C: (Ensemble U)) (x: U) (In U (Intersection U B C) x) ->
- (In U B x) /\ (In U C x).
+Lemma Intersection_inv :
+ forall (B C:Ensemble U) (x:U),
+ In U (Intersection U B C) x -> In U B x /\ In U C x.
Proof.
-Intros B C x H'; Elim H'; Auto with sets.
+intros B C x H'; elim H'; auto with sets.
Qed.
-Hints Resolve Intersection_inv.
+Hint Resolve Intersection_inv.
-Lemma Couple_inv: (x, y, z: U) (In U (Couple U x y) z) -> z == x \/ z == y.
+Lemma Couple_inv : forall x y z:U, In U (Couple U x y) z -> z = x \/ z = y.
Proof.
-Intros x y z H'; Elim H'; Auto with sets.
+intros x y z H'; elim H'; auto with sets.
Qed.
-Hints Resolve Couple_inv.
+Hint Resolve Couple_inv.
-Lemma Setminus_intro:
- (A, B: (Ensemble U)) (x: U) (In U A x) -> ~ (In U B x) ->
- (In U (Setminus U A B) x).
+Lemma Setminus_intro :
+ forall (A B:Ensemble U) (x:U),
+ In U A x -> ~ In U B x -> In U (Setminus U A B) x.
Proof.
-Unfold 1 Setminus; Red; Auto with sets.
+unfold Setminus at 1 in |- *; red in |- *; auto with sets.
Qed.
-Hints Resolve Setminus_intro.
+Hint Resolve Setminus_intro.
-Lemma Strict_Included_intro:
- (X, Y: (Ensemble U)) (Included U X Y) /\ ~ X == Y ->
- (Strict_Included U X Y).
+Lemma Strict_Included_intro :
+ forall X Y:Ensemble U, Included U X Y /\ X <> Y -> Strict_Included U X Y.
Proof.
-Auto with sets.
+auto with sets.
Qed.
-Hints Resolve Strict_Included_intro.
+Hint Resolve Strict_Included_intro.
-Lemma Strict_Included_strict: (X: (Ensemble U)) ~ (Strict_Included U X X).
+Lemma Strict_Included_strict : forall X:Ensemble U, ~ Strict_Included U X X.
Proof.
-Intro X; Red; Intro H'; Elim H'.
-Intros H'0 H'1; Elim H'1; Auto with sets.
+intro X; red in |- *; intro H'; elim H'.
+intros H'0 H'1; elim H'1; auto with sets.
Qed.
-Hints Resolve Strict_Included_strict.
+Hint Resolve Strict_Included_strict.
End Ensembles_facts.
-Hints Resolve Singleton_inv Singleton_intro Add_intro1 Add_intro2
- Intersection_inv Couple_inv Setminus_intro Strict_Included_intro
- Strict_Included_strict Noone_in_empty Inhabited_not_empty
- Add_not_Empty not_Empty_Add Inhabited_add Included_Empty : sets v62.
+Hint Resolve Singleton_inv Singleton_intro Add_intro1 Add_intro2
+ Intersection_inv Couple_inv Setminus_intro Strict_Included_intro
+ Strict_Included_strict Noone_in_empty Inhabited_not_empty Add_not_Empty
+ not_Empty_Add Inhabited_add Included_Empty: sets v62. \ No newline at end of file
diff --git a/theories/Sets/Cpo.v b/theories/Sets/Cpo.v
index c234bd1c7..0d77c0617 100755
--- a/theories/Sets/Cpo.v
+++ b/theories/Sets/Cpo.v
@@ -31,77 +31,79 @@ Require Export Relations_1.
Require Export Partial_Order.
Section Bounds.
-Variable U: Type.
-Variable D: (PO U).
+Variable U : Type.
+Variable D : PO U.
-Local C := (Carrier_of U D).
+Let C := Carrier_of U D.
-Local R := (Rel_of U D).
+Let R := Rel_of U D.
-Inductive Upper_Bound [B:(Ensemble U); x:U]: Prop :=
- Upper_Bound_definition:
- (In U C x) -> ((y: U) (In U B y) -> (R y x)) -> (Upper_Bound B x).
+Inductive Upper_Bound (B:Ensemble U) (x:U) : Prop :=
+ Upper_Bound_definition :
+ In U C x -> (forall y:U, In U B y -> R y x) -> Upper_Bound B x.
-Inductive Lower_Bound [B:(Ensemble U); x:U]: Prop :=
- Lower_Bound_definition:
- (In U C x) -> ((y: U) (In U B y) -> (R x y)) -> (Lower_Bound B x).
+Inductive Lower_Bound (B:Ensemble U) (x:U) : Prop :=
+ Lower_Bound_definition :
+ In U C x -> (forall y:U, In U B y -> R x y) -> Lower_Bound B x.
-Inductive Lub [B:(Ensemble U); x:U]: Prop :=
- Lub_definition:
- (Upper_Bound B x) -> ((y: U) (Upper_Bound B y) -> (R x y)) -> (Lub B x).
+Inductive Lub (B:Ensemble U) (x:U) : Prop :=
+ Lub_definition :
+ Upper_Bound B x -> (forall y:U, Upper_Bound B y -> R x y) -> Lub B x.
-Inductive Glb [B:(Ensemble U); x:U]: Prop :=
- Glb_definition:
- (Lower_Bound B x) -> ((y: U) (Lower_Bound B y) -> (R y x)) -> (Glb B x).
+Inductive Glb (B:Ensemble U) (x:U) : Prop :=
+ Glb_definition :
+ Lower_Bound B x -> (forall y:U, Lower_Bound B y -> R y x) -> Glb B x.
-Inductive Bottom [bot:U]: Prop :=
- Bottom_definition:
- (In U C bot) -> ((y: U) (In U C y) -> (R bot y)) -> (Bottom bot).
+Inductive Bottom (bot:U) : Prop :=
+ Bottom_definition :
+ In U C bot -> (forall y:U, In U C y -> R bot y) -> Bottom bot.
-Inductive Totally_ordered [B:(Ensemble U)]: Prop :=
- Totally_ordered_definition:
- ((Included U B C) ->
- (x: U) (y: U) (Included U (Couple U x y) B) -> (R x y) \/ (R y x)) ->
- (Totally_ordered B).
+Inductive Totally_ordered (B:Ensemble U) : Prop :=
+ Totally_ordered_definition :
+ (Included U B C ->
+ forall x y:U, Included U (Couple U x y) B -> R x y \/ R y x) ->
+ Totally_ordered B.
-Definition Compatible : (Relation U) :=
- [x: U] [y: U] (In U C x) -> (In U C y) ->
- (EXT z | (In U C z) /\ (Upper_Bound (Couple U x y) z)).
+Definition Compatible : Relation U :=
+ fun x y:U =>
+ In U C x ->
+ In U C y -> exists z : _ | In U C z /\ Upper_Bound (Couple U x y) z.
-Inductive Directed [X:(Ensemble U)]: Prop :=
- Definition_of_Directed:
- (Included U X C) ->
- (Inhabited U X) ->
- ((x1: U) (x2: U) (Included U (Couple U x1 x2) X) ->
- (EXT x3 | (In U X x3) /\ (Upper_Bound (Couple U x1 x2) x3))) ->
- (Directed X).
+Inductive Directed (X:Ensemble U) : Prop :=
+ Definition_of_Directed :
+ Included U X C ->
+ Inhabited U X ->
+ (forall x1 x2:U,
+ Included U (Couple U x1 x2) X ->
+ exists x3 : _ | In U X x3 /\ Upper_Bound (Couple U x1 x2) x3) ->
+ Directed X.
Inductive Complete : Prop :=
- Definition_of_Complete:
- ((EXT bot | (Bottom bot))) ->
- ((X: (Ensemble U)) (Directed X) -> (EXT bsup | (Lub X bsup))) ->
- Complete.
+ Definition_of_Complete :
+ ( exists bot : _ | Bottom bot) ->
+ (forall X:Ensemble U, Directed X -> exists bsup : _ | Lub X bsup) ->
+ Complete.
Inductive Conditionally_complete : Prop :=
- Definition_of_Conditionally_complete:
- ((X: (Ensemble U))
- (Included U X C) -> (EXT maj | (Upper_Bound X maj)) ->
- (EXT bsup | (Lub X bsup))) -> Conditionally_complete.
+ Definition_of_Conditionally_complete :
+ (forall X:Ensemble U,
+ Included U X C ->
+ ( exists maj : _ | Upper_Bound X maj) ->
+ exists bsup : _ | Lub X bsup) -> Conditionally_complete.
End Bounds.
-Hints Resolve Totally_ordered_definition Upper_Bound_definition
- Lower_Bound_definition Lub_definition Glb_definition
- Bottom_definition Definition_of_Complete
- Definition_of_Complete Definition_of_Conditionally_complete.
+Hint Resolve Totally_ordered_definition Upper_Bound_definition
+ Lower_Bound_definition Lub_definition Glb_definition Bottom_definition
+ Definition_of_Complete Definition_of_Complete
+ Definition_of_Conditionally_complete.
Section Specific_orders.
-Variable U: Type.
+Variable U : Type.
-Record Cpo : Type := Definition_of_cpo {
- PO_of_cpo: (PO U);
- Cpo_cond: (Complete U PO_of_cpo) }.
+Record Cpo : Type := Definition_of_cpo
+ {PO_of_cpo : PO U; Cpo_cond : Complete U PO_of_cpo}.
-Record Chain : Type := Definition_of_chain {
- PO_of_chain: (PO U);
- Chain_cond: (Totally_ordered U PO_of_chain (Carrier_of U PO_of_chain)) }.
+Record Chain : Type := Definition_of_chain
+ {PO_of_chain : PO U;
+ Chain_cond : Totally_ordered U PO_of_chain (Carrier_of U PO_of_chain)}.
-End Specific_orders.
+End Specific_orders. \ No newline at end of file
diff --git a/theories/Sets/Ensembles.v b/theories/Sets/Ensembles.v
index af202239e..eae50a3d1 100755
--- a/theories/Sets/Ensembles.v
+++ b/theories/Sets/Ensembles.v
@@ -27,20 +27,18 @@
(*i $Id$ i*)
Section Ensembles.
-Variable U: Type.
+Variable U : Type.
-Definition Ensemble := U -> Prop.
+Definition Ensemble := U -> Prop.
-Definition In : Ensemble -> U -> Prop := [A: Ensemble] [x: U] (A x).
+Definition In (A:Ensemble) (x:U) : Prop := A x.
-Definition Included : Ensemble -> Ensemble -> Prop :=
- [B, C: Ensemble] (x: U) (In B x) -> (In C x).
+Definition Included (B C:Ensemble) : Prop := forall x:U, In B x -> In C x.
-Inductive Empty_set : Ensemble :=
- .
+Inductive Empty_set : Ensemble :=.
Inductive Full_set : Ensemble :=
- Full_intro: (x: U) (In Full_set x).
+ Full_intro : forall x:U, In Full_set x.
(** NB: The following definition builds-in equality of elements in [U] as
Leibniz equality.
@@ -49,60 +47,55 @@ Inductive Full_set : Ensemble :=
with its own equality [eqs], with
[In_singleton: (y: U)(eqs x y) -> (In (Singleton x) y)]. *)
-Inductive Singleton [x:U] : Ensemble :=
- In_singleton: (In (Singleton x) x).
+Inductive Singleton (x:U) : Ensemble :=
+ In_singleton : In (Singleton x) x.
-Inductive Union [B, C: Ensemble] : Ensemble :=
- Union_introl: (x: U) (In B x) -> (In (Union B C) x)
- | Union_intror: (x: U) (In C x) -> (In (Union B C) x).
+Inductive Union (B C:Ensemble) : Ensemble :=
+ | Union_introl : forall x:U, In B x -> In (Union B C) x
+ | Union_intror : forall x:U, In C x -> In (Union B C) x.
-Definition Add : Ensemble -> U -> Ensemble :=
- [B: Ensemble] [x: U] (Union B (Singleton x)).
+Definition Add (B:Ensemble) (x:U) : Ensemble := Union B (Singleton x).
-Inductive Intersection [B, C:Ensemble] : Ensemble :=
- Intersection_intro:
- (x: U) (In B x) -> (In C x) -> (In (Intersection B C) x).
+Inductive Intersection (B C:Ensemble) : Ensemble :=
+ Intersection_intro :
+ forall x:U, In B x -> In C x -> In (Intersection B C) x.
-Inductive Couple [x,y:U] : Ensemble :=
- Couple_l: (In (Couple x y) x)
- | Couple_r: (In (Couple x y) y).
+Inductive Couple (x y:U) : Ensemble :=
+ | Couple_l : In (Couple x y) x
+ | Couple_r : In (Couple x y) y.
-Inductive Triple[x, y, z:U] : Ensemble :=
- Triple_l: (In (Triple x y z) x)
- | Triple_m: (In (Triple x y z) y)
- | Triple_r: (In (Triple x y z) z).
+Inductive Triple (x y z:U) : Ensemble :=
+ | Triple_l : In (Triple x y z) x
+ | Triple_m : In (Triple x y z) y
+ | Triple_r : In (Triple x y z) z.
-Definition Complement : Ensemble -> Ensemble :=
- [A: Ensemble] [x: U] ~ (In A x).
+Definition Complement (A:Ensemble) : Ensemble := fun x:U => ~ In A x.
-Definition Setminus : Ensemble -> Ensemble -> Ensemble :=
- [B: Ensemble] [C: Ensemble] [x: U] (In B x) /\ ~ (In C x).
+Definition Setminus (B C:Ensemble) : Ensemble :=
+ fun x:U => In B x /\ ~ In C x.
-Definition Subtract : Ensemble -> U -> Ensemble :=
- [B: Ensemble] [x: U] (Setminus B (Singleton x)).
+Definition Subtract (B:Ensemble) (x:U) : Ensemble := Setminus B (Singleton x).
-Inductive Disjoint [B, C:Ensemble] : Prop :=
- Disjoint_intro: ((x: U) ~ (In (Intersection B C) x)) -> (Disjoint B C).
+Inductive Disjoint (B C:Ensemble) : Prop :=
+ Disjoint_intro : (forall x:U, ~ In (Intersection B C) x) -> Disjoint B C.
-Inductive Inhabited [B:Ensemble] : Prop :=
- Inhabited_intro: (x: U) (In B x) -> (Inhabited B).
+Inductive Inhabited (B:Ensemble) : Prop :=
+ Inhabited_intro : forall x:U, In B x -> Inhabited B.
-Definition Strict_Included : Ensemble -> Ensemble -> Prop :=
- [B, C: Ensemble] (Included B C) /\ ~ B == C.
+Definition Strict_Included (B C:Ensemble) : Prop := Included B C /\ B <> C.
-Definition Same_set : Ensemble -> Ensemble -> Prop :=
- [B, C: Ensemble] (Included B C) /\ (Included C B).
+Definition Same_set (B C:Ensemble) : Prop := Included B C /\ Included C B.
(** Extensionality Axiom *)
-Axiom Extensionality_Ensembles:
- (A,B: Ensemble) (Same_set A B) -> A == B.
-Hints Resolve Extensionality_Ensembles.
+Axiom Extensionality_Ensembles : forall A B:Ensemble, Same_set A B -> A = B.
+Hint Resolve Extensionality_Ensembles.
End Ensembles.
-Hints Unfold In Included Same_set Strict_Included Add Setminus Subtract : sets v62.
+Hint Unfold In Included Same_set Strict_Included Add Setminus Subtract: sets
+ v62.
-Hints Resolve Union_introl Union_intror Intersection_intro In_singleton Couple_l
- Couple_r Triple_l Triple_m Triple_r Disjoint_intro
- Extensionality_Ensembles : sets v62.
+Hint Resolve Union_introl Union_intror Intersection_intro In_singleton
+ Couple_l Couple_r Triple_l Triple_m Triple_r Disjoint_intro
+ Extensionality_Ensembles: sets v62. \ No newline at end of file
diff --git a/theories/Sets/Finite_sets.v b/theories/Sets/Finite_sets.v
index 1e7168791..28b2d6fb9 100755
--- a/theories/Sets/Finite_sets.v
+++ b/theories/Sets/Finite_sets.v
@@ -26,49 +26,56 @@
(*i $Id$ i*)
-Require Ensembles.
+Require Import Ensembles.
Section Ensembles_finis.
-Variable U: Type.
+Variable U : Type.
-Inductive Finite : (Ensemble U) -> Prop :=
- Empty_is_finite: (Finite (Empty_set U))
- | Union_is_finite:
- (A: (Ensemble U)) (Finite A) ->
- (x: U) ~ (In U A x) -> (Finite (Add U A x)).
+Inductive Finite : Ensemble U -> Prop :=
+ | Empty_is_finite : Finite (Empty_set U)
+ | Union_is_finite :
+ forall A:Ensemble U,
+ Finite A -> forall x:U, ~ In U A x -> Finite (Add U A x).
-Inductive cardinal : (Ensemble U) -> nat -> Prop :=
- card_empty: (cardinal (Empty_set U) O)
- | card_add:
- (A: (Ensemble U)) (n: nat) (cardinal A n) ->
- (x: U) ~ (In U A x) -> (cardinal (Add U A x) (S n)).
+Inductive cardinal : Ensemble U -> nat -> Prop :=
+ | card_empty : cardinal (Empty_set U) 0
+ | card_add :
+ forall (A:Ensemble U) (n:nat),
+ cardinal A n -> forall x:U, ~ In U A x -> cardinal (Add U A x) (S n).
End Ensembles_finis.
-Hints Resolve Empty_is_finite Union_is_finite : sets v62.
-Hints Resolve card_empty card_add : sets v62.
+Hint Resolve Empty_is_finite Union_is_finite: sets v62.
+Hint Resolve card_empty card_add: sets v62.
-Require Constructive_sets.
+Require Import Constructive_sets.
Section Ensembles_finis_facts.
-Variable U: Type.
+Variable U : Type.
Lemma cardinal_invert :
- (X: (Ensemble U)) (p:nat)(cardinal U X p) -> Case p of
- X == (Empty_set U)
- [n:nat] (EXT A | (EXT x |
- X == (Add U A x) /\ ~ (In U A x) /\ (cardinal U A n))) end.
+ forall (X:Ensemble U) (p:nat),
+ cardinal U X p ->
+ match p with
+ | O => X = Empty_set U
+ | S n =>
+ exists A : _
+ | ( exists x : _ | X = Add U A x /\ ~ In U A x /\ cardinal U A n)
+ end.
Proof.
-NewInduction 1; Simpl; Auto.
-Exists A; Exists x; Auto.
+induction 1; simpl in |- *; auto.
+exists A; exists x; auto.
Qed.
Lemma cardinal_elim :
- (X: (Ensemble U)) (p:nat)(cardinal U X p) -> Case p of
- X == (Empty_set U)
- [n:nat](Inhabited U X) end.
+ forall (X:Ensemble U) (p:nat),
+ cardinal U X p ->
+ match p with
+ | O => X = Empty_set U
+ | S n => Inhabited U X
+ end.
Proof.
-Intros X p C; Elim C; Simpl; Trivial with sets.
+intros X p C; elim C; simpl in |- *; trivial with sets.
Qed.
-End Ensembles_finis_facts.
+End Ensembles_finis_facts. \ No newline at end of file
diff --git a/theories/Sets/Finite_sets_facts.v b/theories/Sets/Finite_sets_facts.v
index 4e7b6931f..2849bce6c 100755
--- a/theories/Sets/Finite_sets_facts.v
+++ b/theories/Sets/Finite_sets_facts.v
@@ -37,309 +37,311 @@ Require Export Gt.
Require Export Lt.
Section Finite_sets_facts.
-Variable U: Type.
+Variable U : Type.
Lemma finite_cardinal :
- (X: (Ensemble U)) (Finite U X) -> (EX n:nat |(cardinal U X n)).
+ forall X:Ensemble U, Finite U X -> exists n : nat | cardinal U X n.
Proof.
-NewInduction 1 as [|A _ [n H]].
-Exists O; Auto with sets.
-Exists (S n); Auto with sets.
+induction 1 as [| A _ [n H]].
+exists 0; auto with sets.
+exists (S n); auto with sets.
Qed.
-Lemma cardinal_finite:
- (X: (Ensemble U)) (n: nat) (cardinal U X n) -> (Finite U X).
+Lemma cardinal_finite :
+ forall (X:Ensemble U) (n:nat), cardinal U X n -> Finite U X.
Proof.
-NewInduction 1; Auto with sets.
+induction 1; auto with sets.
Qed.
-Theorem Add_preserves_Finite:
- (X: (Ensemble U)) (x: U) (Finite U X) -> (Finite U (Add U X x)).
+Theorem Add_preserves_Finite :
+ forall (X:Ensemble U) (x:U), Finite U X -> Finite U (Add U X x).
Proof.
-Intros X x H'.
-Elim (classic (In U X x)); Intro H'0; Auto with sets.
-Rewrite (Non_disjoint_union U X x); Auto with sets.
+intros X x H'.
+elim (classic (In U X x)); intro H'0; auto with sets.
+rewrite (Non_disjoint_union U X x); auto with sets.
Qed.
-Hints Resolve Add_preserves_Finite.
+Hint Resolve Add_preserves_Finite.
-Theorem Singleton_is_finite: (x: U) (Finite U (Singleton U x)).
+Theorem Singleton_is_finite : forall x:U, Finite U (Singleton U x).
Proof.
-Intro x; Rewrite <- (Empty_set_zero U (Singleton U x)).
-Change (Finite U (Add U (Empty_set U) x)); Auto with sets.
+intro x; rewrite <- (Empty_set_zero U (Singleton U x)).
+change (Finite U (Add U (Empty_set U) x)) in |- *; auto with sets.
Qed.
-Hints Resolve Singleton_is_finite.
+Hint Resolve Singleton_is_finite.
-Theorem Union_preserves_Finite:
- (X, Y: (Ensemble U)) (Finite U X) -> (Finite U Y) ->
- (Finite U (Union U X Y)).
+Theorem Union_preserves_Finite :
+ forall X Y:Ensemble U, Finite U X -> Finite U Y -> Finite U (Union U X Y).
Proof.
-Intros X Y H'; Elim H'.
-Rewrite (Empty_set_zero U Y); Auto with sets.
-Intros A H'0 H'1 x H'2 H'3.
-Rewrite (Union_commutative U (Add U A x) Y).
-Rewrite <- (Union_add U Y A x).
-Rewrite (Union_commutative U Y A); Auto with sets.
+intros X Y H'; elim H'.
+rewrite (Empty_set_zero U Y); auto with sets.
+intros A H'0 H'1 x H'2 H'3.
+rewrite (Union_commutative U (Add U A x) Y).
+rewrite <- (Union_add U Y A x).
+rewrite (Union_commutative U Y A); auto with sets.
Qed.
-Lemma Finite_downward_closed:
- (A: (Ensemble U)) (Finite U A) ->
- (X: (Ensemble U)) (Included U X A) -> (Finite U X).
+Lemma Finite_downward_closed :
+ forall A:Ensemble U,
+ Finite U A -> forall X:Ensemble U, Included U X A -> Finite U X.
Proof.
-Intros A H'; Elim H'; Auto with sets.
-Intros X H'0.
-Rewrite (less_than_empty U X H'0); Auto with sets.
-Intros; Elim Included_Add with U X A0 x; Auto with sets.
-NewDestruct 1 as [A' [H5 H6]].
-Rewrite H5; Auto with sets.
+intros A H'; elim H'; auto with sets.
+intros X H'0.
+rewrite (less_than_empty U X H'0); auto with sets.
+intros; elim Included_Add with U X A0 x; auto with sets.
+destruct 1 as [A' [H5 H6]].
+rewrite H5; auto with sets.
Qed.
-Lemma Intersection_preserves_finite:
- (A: (Ensemble U)) (Finite U A) ->
- (X: (Ensemble U)) (Finite U (Intersection U X A)).
+Lemma Intersection_preserves_finite :
+ forall A:Ensemble U,
+ Finite U A -> forall X:Ensemble U, Finite U (Intersection U X A).
Proof.
-Intros A H' X; Apply Finite_downward_closed with A; Auto with sets.
+intros A H' X; apply Finite_downward_closed with A; auto with sets.
Qed.
-Lemma cardinalO_empty:
- (X: (Ensemble U)) (cardinal U X O) -> X == (Empty_set U).
+Lemma cardinalO_empty :
+ forall X:Ensemble U, cardinal U X 0 -> X = Empty_set U.
Proof.
-Intros X H; Apply (cardinal_invert U X O); Trivial with sets.
+intros X H; apply (cardinal_invert U X 0); trivial with sets.
Qed.
-Hints Resolve cardinalO_empty.
+Hint Resolve cardinalO_empty.
-Lemma inh_card_gt_O:
- (X: (Ensemble U)) (Inhabited U X) -> (n: nat) (cardinal U X n) -> (gt n O).
+Lemma inh_card_gt_O :
+ forall X:Ensemble U, Inhabited U X -> forall n:nat, cardinal U X n -> n > 0.
Proof.
-NewInduction 1 as [x H'].
-Intros n H'0.
-Elim (gt_O_eq n); Auto with sets.
-Intro H'1; Generalize H'; Generalize H'0.
-Rewrite <- H'1; Intro H'2.
-Rewrite (cardinalO_empty X); Auto with sets.
-Intro H'3; Elim H'3.
+induction 1 as [x H'].
+intros n H'0.
+elim (gt_O_eq n); auto with sets.
+intro H'1; generalize H'; generalize H'0.
+rewrite <- H'1; intro H'2.
+rewrite (cardinalO_empty X); auto with sets.
+intro H'3; elim H'3.
Qed.
-Lemma card_soustr_1:
- (X: (Ensemble U)) (n: nat) (cardinal U X n) ->
- (x: U) (In U X x) -> (cardinal U (Subtract U X x) (pred n)).
+Lemma card_soustr_1 :
+ forall (X:Ensemble U) (n:nat),
+ cardinal U X n ->
+ forall x:U, In U X x -> cardinal U (Subtract U X x) (pred n).
Proof.
-Intros X n H'; Elim H'.
-Intros x H'0; Elim H'0.
-Clear H' n X.
-Intros X n H' H'0 x H'1 x0 H'2.
-Elim (classic (In U X x0)).
-Intro H'4; Rewrite (add_soustr_xy U X x x0).
-Elim (classic x == x0).
-Intro H'5.
-Absurd (In U X x0); Auto with sets.
-Rewrite <- H'5; Auto with sets.
-Intro H'3; Try Assumption.
-Cut (S (pred n)) = (pred (S n)).
-Intro H'5; Rewrite <- H'5.
-Apply card_add; Auto with sets.
-Red; Intro H'6; Elim H'6.
-Intros H'7 H'8; Try Assumption.
-Elim H'1; Auto with sets.
-Unfold 2 pred; Symmetry.
-Apply S_pred with m := O.
-Change (gt n O).
-Apply inh_card_gt_O with X := X; Auto with sets.
-Apply Inhabited_intro with x := x0; Auto with sets.
-Red; Intro H'3.
-Apply H'1.
-Elim H'3; Auto with sets.
-Rewrite H'3; Auto with sets.
-Elim (classic x == x0).
-Intro H'3; Rewrite <- H'3.
-Cut (Subtract U (Add U X x) x) == X; Auto with sets.
-Intro H'4; Rewrite H'4; Auto with sets.
-Intros H'3 H'4; Try Assumption.
-Absurd (In U (Add U X x) x0); Auto with sets.
-Red; Intro H'5; Try Exact H'5.
-LApply (Add_inv U X x x0); Tauto.
+intros X n H'; elim H'.
+intros x H'0; elim H'0.
+clear H' n X.
+intros X n H' H'0 x H'1 x0 H'2.
+elim (classic (In U X x0)).
+intro H'4; rewrite (add_soustr_xy U X x x0).
+elim (classic (x = x0)).
+intro H'5.
+absurd (In U X x0); auto with sets.
+rewrite <- H'5; auto with sets.
+intro H'3; try assumption.
+cut (S (pred n) = pred (S n)).
+intro H'5; rewrite <- H'5.
+apply card_add; auto with sets.
+red in |- *; intro H'6; elim H'6.
+intros H'7 H'8; try assumption.
+elim H'1; auto with sets.
+unfold pred at 2 in |- *; symmetry in |- *.
+apply S_pred with (m := 0).
+change (n > 0) in |- *.
+apply inh_card_gt_O with (X := X); auto with sets.
+apply Inhabited_intro with (x := x0); auto with sets.
+red in |- *; intro H'3.
+apply H'1.
+elim H'3; auto with sets.
+rewrite H'3; auto with sets.
+elim (classic (x = x0)).
+intro H'3; rewrite <- H'3.
+cut (Subtract U (Add U X x) x = X); auto with sets.
+intro H'4; rewrite H'4; auto with sets.
+intros H'3 H'4; try assumption.
+absurd (In U (Add U X x) x0); auto with sets.
+red in |- *; intro H'5; try exact H'5.
+lapply (Add_inv U X x x0); tauto.
Qed.
-Lemma cardinal_is_functional:
- (X: (Ensemble U)) (c1: nat) (cardinal U X c1) ->
- (Y: (Ensemble U)) (c2: nat) (cardinal U Y c2) -> X == Y ->
- c1 = c2.
+Lemma cardinal_is_functional :
+ forall (X:Ensemble U) (c1:nat),
+ cardinal U X c1 ->
+ forall (Y:Ensemble U) (c2:nat), cardinal U Y c2 -> X = Y -> c1 = c2.
Proof.
-Intros X c1 H'; Elim H'.
-Intros Y c2 H'0; Elim H'0; Auto with sets.
-Intros A n H'1 H'2 x H'3 H'5.
-Elim (not_Empty_Add U A x); Auto with sets.
-Clear H' c1 X.
-Intros X n H' H'0 x H'1 Y c2 H'2.
-Elim H'2.
-Intro H'3.
-Elim (not_Empty_Add U X x); Auto with sets.
-Clear H'2 c2 Y.
-Intros X0 c2 H'2 H'3 x0 H'4 H'5.
-Elim (classic (In U X0 x)).
-Intro H'6; Apply f_equal with nat.
-Apply H'0 with Y := (Subtract U (Add U X0 x0) x).
-ElimType (pred (S c2)) = c2; Auto with sets.
-Apply card_soustr_1; Auto with sets.
-Rewrite <- H'5.
-Apply Sub_Add_new; Auto with sets.
-Elim (classic x == x0).
-Intros H'6 H'7; Apply f_equal with nat.
-Apply H'0 with Y := X0; Auto with sets.
-Apply Simplify_add with x := x; Auto with sets.
-Pattern 2 x; Rewrite H'6; Auto with sets.
-Intros H'6 H'7.
-Absurd (Add U X x) == (Add U X0 x0); Auto with sets.
-Clear H'0 H' H'3 n H'5 H'4 H'2 H'1 c2.
-Red; Intro H'.
-LApply (Extension U (Add U X x) (Add U X0 x0)); Auto with sets.
-Clear H'.
-Intro H'; Red in H'.
-Elim H'; Intros H'0 H'1; Red in H'0; Clear H' H'1.
-Absurd (In U (Add U X0 x0) x); Auto with sets.
-LApply (Add_inv U X0 x0 x); [ Intuition | Apply (H'0 x); Apply Add_intro2 ].
+intros X c1 H'; elim H'.
+intros Y c2 H'0; elim H'0; auto with sets.
+intros A n H'1 H'2 x H'3 H'5.
+elim (not_Empty_Add U A x); auto with sets.
+clear H' c1 X.
+intros X n H' H'0 x H'1 Y c2 H'2.
+elim H'2.
+intro H'3.
+elim (not_Empty_Add U X x); auto with sets.
+clear H'2 c2 Y.
+intros X0 c2 H'2 H'3 x0 H'4 H'5.
+elim (classic (In U X0 x)).
+intro H'6; apply f_equal with nat.
+apply H'0 with (Y := Subtract U (Add U X0 x0) x).
+elimtype (pred (S c2) = c2); auto with sets.
+apply card_soustr_1; auto with sets.
+rewrite <- H'5.
+apply Sub_Add_new; auto with sets.
+elim (classic (x = x0)).
+intros H'6 H'7; apply f_equal with nat.
+apply H'0 with (Y := X0); auto with sets.
+apply Simplify_add with (x := x); auto with sets.
+pattern x at 2 in |- *; rewrite H'6; auto with sets.
+intros H'6 H'7.
+absurd (Add U X x = Add U X0 x0); auto with sets.
+clear H'0 H' H'3 n H'5 H'4 H'2 H'1 c2.
+red in |- *; intro H'.
+lapply (Extension U (Add U X x) (Add U X0 x0)); auto with sets.
+clear H'.
+intro H'; red in H'.
+elim H'; intros H'0 H'1; red in H'0; clear H' H'1.
+absurd (In U (Add U X0 x0) x); auto with sets.
+lapply (Add_inv U X0 x0 x); [ intuition | apply (H'0 x); apply Add_intro2 ].
Qed.
-Lemma cardinal_Empty : (m:nat)(cardinal U (Empty_set U) m) -> O = m.
+Lemma cardinal_Empty : forall m:nat, cardinal U (Empty_set U) m -> 0 = m.
Proof.
-Intros m Cm; Generalize (cardinal_invert U (Empty_set U) m Cm).
-Elim m; Auto with sets.
-Intros; Elim H0; Intros; Elim H1; Intros; Elim H2; Intros.
-Elim (not_Empty_Add U x x0 H3).
+intros m Cm; generalize (cardinal_invert U (Empty_set U) m Cm).
+elim m; auto with sets.
+intros; elim H0; intros; elim H1; intros; elim H2; intros.
+elim (not_Empty_Add U x x0 H3).
Qed.
Lemma cardinal_unicity :
- (X: (Ensemble U)) (n: nat) (cardinal U X n) ->
- (m: nat) (cardinal U X m) -> n = m.
+ forall (X:Ensemble U) (n:nat),
+ cardinal U X n -> forall m:nat, cardinal U X m -> n = m.
Proof.
-Intros; Apply cardinal_is_functional with X X; Auto with sets.
+intros; apply cardinal_is_functional with X X; auto with sets.
Qed.
-Lemma card_Add_gen:
- (A: (Ensemble U))
- (x: U) (n, n': nat) (cardinal U A n) -> (cardinal U (Add U A x) n') ->
- (le n' (S n)).
+Lemma card_Add_gen :
+ forall (A:Ensemble U) (x:U) (n n':nat),
+ cardinal U A n -> cardinal U (Add U A x) n' -> n' <= S n.
Proof.
-Intros A x n n' H'.
-Elim (classic (In U A x)).
-Intro H'0.
-Rewrite (Non_disjoint_union U A x H'0).
-Intro H'1; Cut n = n'.
-Intro E; Rewrite E; Auto with sets.
-Apply cardinal_unicity with A; Auto with sets.
-Intros H'0 H'1.
-Cut n'=(S n).
-Intro E; Rewrite E; Auto with sets.
-Apply cardinal_unicity with (Add U A x); Auto with sets.
+intros A x n n' H'.
+elim (classic (In U A x)).
+intro H'0.
+rewrite (Non_disjoint_union U A x H'0).
+intro H'1; cut (n = n').
+intro E; rewrite E; auto with sets.
+apply cardinal_unicity with A; auto with sets.
+intros H'0 H'1.
+cut (n' = S n).
+intro E; rewrite E; auto with sets.
+apply cardinal_unicity with (Add U A x); auto with sets.
Qed.
-Lemma incl_st_card_lt:
- (X: (Ensemble U)) (c1: nat) (cardinal U X c1) ->
- (Y: (Ensemble U)) (c2: nat) (cardinal U Y c2) -> (Strict_Included U X Y) ->
- (gt c2 c1).
+Lemma incl_st_card_lt :
+ forall (X:Ensemble U) (c1:nat),
+ cardinal U X c1 ->
+ forall (Y:Ensemble U) (c2:nat),
+ cardinal U Y c2 -> Strict_Included U X Y -> c2 > c1.
Proof.
-Intros X c1 H'; Elim H'.
-Intros Y c2 H'0; Elim H'0; Auto with sets arith.
-Intro H'1.
-Elim (Strict_Included_strict U (Empty_set U)); Auto with sets arith.
-Clear H' c1 X.
-Intros X n H' H'0 x H'1 Y c2 H'2.
-Elim H'2.
-Intro H'3; Elim (not_SIncl_empty U (Add U X x)); Auto with sets arith.
-Clear H'2 c2 Y.
-Intros X0 c2 H'2 H'3 x0 H'4 H'5; Elim (classic (In U X0 x)).
-Intro H'6; Apply gt_n_S.
-Apply H'0 with Y := (Subtract U (Add U X0 x0) x).
-ElimType (pred (S c2)) = c2; Auto with sets arith.
-Apply card_soustr_1; Auto with sets arith.
-Apply incl_st_add_soustr; Auto with sets arith.
-Elim (classic x == x0).
-Intros H'6 H'7; Apply gt_n_S.
-Apply H'0 with Y := X0; Auto with sets arith.
-Apply sincl_add_x with x := x0.
-Rewrite <- H'6; Auto with sets arith.
-Pattern 1 x0; Rewrite <- H'6; Trivial with sets arith.
-Intros H'6 H'7; Red in H'5.
-Elim H'5; Intros H'8 H'9; Try Exact H'8; Clear H'5.
-Red in H'8.
-Generalize (H'8 x).
-Intro H'5; LApply H'5; Auto with sets arith.
-Intro H; Elim Add_inv with U X0 x0 x; Auto with sets arith.
-Intro; Absurd (In U X0 x); Auto with sets arith.
-Intro; Absurd x==x0; Auto with sets arith.
+intros X c1 H'; elim H'.
+intros Y c2 H'0; elim H'0; auto with sets arith.
+intro H'1.
+elim (Strict_Included_strict U (Empty_set U)); auto with sets arith.
+clear H' c1 X.
+intros X n H' H'0 x H'1 Y c2 H'2.
+elim H'2.
+intro H'3; elim (not_SIncl_empty U (Add U X x)); auto with sets arith.
+clear H'2 c2 Y.
+intros X0 c2 H'2 H'3 x0 H'4 H'5; elim (classic (In U X0 x)).
+intro H'6; apply gt_n_S.
+apply H'0 with (Y := Subtract U (Add U X0 x0) x).
+elimtype (pred (S c2) = c2); auto with sets arith.
+apply card_soustr_1; auto with sets arith.
+apply incl_st_add_soustr; auto with sets arith.
+elim (classic (x = x0)).
+intros H'6 H'7; apply gt_n_S.
+apply H'0 with (Y := X0); auto with sets arith.
+apply sincl_add_x with (x := x0).
+rewrite <- H'6; auto with sets arith.
+pattern x0 at 1 in |- *; rewrite <- H'6; trivial with sets arith.
+intros H'6 H'7; red in H'5.
+elim H'5; intros H'8 H'9; try exact H'8; clear H'5.
+red in H'8.
+generalize (H'8 x).
+intro H'5; lapply H'5; auto with sets arith.
+intro H; elim Add_inv with U X0 x0 x; auto with sets arith.
+intro; absurd (In U X0 x); auto with sets arith.
+intro; absurd (x = x0); auto with sets arith.
Qed.
-Lemma incl_card_le:
- (X,Y: (Ensemble U)) (n,m: nat) (cardinal U X n) -> (cardinal U Y m) ->
- (Included U X Y) -> (le n m).
+Lemma incl_card_le :
+ forall (X Y:Ensemble U) (n m:nat),
+ cardinal U X n -> cardinal U Y m -> Included U X Y -> n <= m.
Proof.
-Intros;
-Elim Included_Strict_Included with U X Y; Auto with sets arith; Intro.
-Cut (gt m n); Auto with sets arith.
-Apply incl_st_card_lt with X := X Y := Y; Auto with sets arith.
-Generalize H0; Rewrite <- H2; Intro.
-Cut n=m.
-Intro E; Rewrite E; Auto with sets arith.
-Apply cardinal_unicity with X; Auto with sets arith.
+intros; elim Included_Strict_Included with U X Y; auto with sets arith; intro.
+cut (m > n); auto with sets arith.
+apply incl_st_card_lt with (X := X) (Y := Y); auto with sets arith.
+generalize H0; rewrite <- H2; intro.
+cut (n = m).
+intro E; rewrite E; auto with sets arith.
+apply cardinal_unicity with X; auto with sets arith.
Qed.
-Lemma G_aux:
- (P:(Ensemble U) ->Prop)
- ((X:(Ensemble U))
- (Finite U X) -> ((Y:(Ensemble U)) (Strict_Included U Y X) ->(P Y)) ->(P X)) ->
- (P (Empty_set U)).
+Lemma G_aux :
+ forall P:Ensemble U -> Prop,
+ (forall X:Ensemble U,
+ Finite U X ->
+ (forall Y:Ensemble U, Strict_Included U Y X -> P Y) -> P X) ->
+ P (Empty_set U).
Proof.
-Intros P H'; Try Assumption.
-Apply H'; Auto with sets.
-Clear H'; Auto with sets.
-Intros Y H'; Try Assumption.
-Red in H'.
-Elim H'; Intros H'0 H'1; Try Exact H'1; Clear H'.
-LApply (less_than_empty U Y); [Intro H'3; Try Exact H'3 | Assumption].
-Elim H'1; Auto with sets.
+intros P H'; try assumption.
+apply H'; auto with sets.
+clear H'; auto with sets.
+intros Y H'; try assumption.
+red in H'.
+elim H'; intros H'0 H'1; try exact H'1; clear H'.
+lapply (less_than_empty U Y); [ intro H'3; try exact H'3 | assumption ].
+elim H'1; auto with sets.
Qed.
-Hints Unfold not.
+Hint Unfold not.
-Lemma Generalized_induction_on_finite_sets:
- (P:(Ensemble U) ->Prop)
- ((X:(Ensemble U))
- (Finite U X) -> ((Y:(Ensemble U)) (Strict_Included U Y X) ->(P Y)) ->(P X)) ->
- (X:(Ensemble U)) (Finite U X) ->(P X).
+Lemma Generalized_induction_on_finite_sets :
+ forall P:Ensemble U -> Prop,
+ (forall X:Ensemble U,
+ Finite U X ->
+ (forall Y:Ensemble U, Strict_Included U Y X -> P Y) -> P X) ->
+ forall X:Ensemble U, Finite U X -> P X.
Proof.
-Intros P H'0 X H'1.
-Generalize P H'0; Clear H'0 P.
-Elim H'1.
-Intros P H'0.
-Apply G_aux; Auto with sets.
-Clear H'1 X.
-Intros A H' H'0 x H'1 P H'3.
-Cut (Y:(Ensemble U)) (Included U Y (Add U A x)) ->(P Y); Auto with sets.
-Generalize H'1.
-Apply H'0.
-Intros X K H'5 L Y H'6; Apply H'3; Auto with sets.
-Apply Finite_downward_closed with A := (Add U X x); Auto with sets.
-Intros Y0 H'7.
-Elim (Strict_inclusion_is_transitive_with_inclusion U Y0 Y (Add U X x)); Auto with sets.
-Intros H'2 H'4.
-Elim (Included_Add U Y0 X x);
- [Intro H'14 |
- Intro H'14; Elim H'14; Intros A' E; Elim E; Intros H'15 H'16; Clear E H'14 |
- Idtac]; Auto with sets.
-Elim (Included_Strict_Included U Y0 X); Auto with sets.
-Intro H'9; Apply H'5 with Y := Y0; Auto with sets.
-Intro H'9; Rewrite H'9.
-Apply H'3; Auto with sets.
-Intros Y1 H'8; Elim H'8.
-Intros H'10 H'11; Apply H'5 with Y := Y1; Auto with sets.
-Elim (Included_Strict_Included U A' X); Auto with sets.
-Intro H'8; Apply H'5 with Y := A'; Auto with sets.
-Rewrite <- H'15; Auto with sets.
-Intro H'8.
-Elim H'7.
-Intros H'9 H'10; Apply H'10 Orelse Elim H'10; Try Assumption.
-Generalize H'6.
-Rewrite <- H'8.
-Rewrite <- H'15; Auto with sets.
+intros P H'0 X H'1.
+generalize P H'0; clear H'0 P.
+elim H'1.
+intros P H'0.
+apply G_aux; auto with sets.
+clear H'1 X.
+intros A H' H'0 x H'1 P H'3.
+cut (forall Y:Ensemble U, Included U Y (Add U A x) -> P Y); auto with sets.
+generalize H'1.
+apply H'0.
+intros X K H'5 L Y H'6; apply H'3; auto with sets.
+apply Finite_downward_closed with (A := Add U X x); auto with sets.
+intros Y0 H'7.
+elim (Strict_inclusion_is_transitive_with_inclusion U Y0 Y (Add U X x));
+ auto with sets.
+intros H'2 H'4.
+elim (Included_Add U Y0 X x);
+ [ intro H'14
+ | intro H'14; elim H'14; intros A' E; elim E; intros H'15 H'16; clear E H'14
+ | idtac ]; auto with sets.
+elim (Included_Strict_Included U Y0 X); auto with sets.
+intro H'9; apply H'5 with (Y := Y0); auto with sets.
+intro H'9; rewrite H'9.
+apply H'3; auto with sets.
+intros Y1 H'8; elim H'8.
+intros H'10 H'11; apply H'5 with (Y := Y1); auto with sets.
+elim (Included_Strict_Included U A' X); auto with sets.
+intro H'8; apply H'5 with (Y := A'); auto with sets.
+rewrite <- H'15; auto with sets.
+intro H'8.
+elim H'7.
+intros H'9 H'10; apply H'10 || elim H'10; try assumption.
+generalize H'6.
+rewrite <- H'8.
+rewrite <- H'15; auto with sets.
Qed.
-End Finite_sets_facts.
+End Finite_sets_facts. \ No newline at end of file
diff --git a/theories/Sets/Image.v b/theories/Sets/Image.v
index d5f42e3f9..85b83d3ab 100755
--- a/theories/Sets/Image.v
+++ b/theories/Sets/Image.v
@@ -39,161 +39,167 @@ Require Export Le.
Require Export Finite_sets_facts.
Section Image.
-Variables U, V: Type.
+Variables U V : Type.
-Inductive Im [X:(Ensemble U); f:U -> V]: (Ensemble V) :=
- Im_intro: (x: U) (In ? X x) -> (y: V) y == (f x) -> (In ? (Im X f) y).
+Inductive Im (X:Ensemble U) (f:U -> V) : Ensemble V :=
+ Im_intro : forall x:U, In _ X x -> forall y:V, y = f x -> In _ (Im X f) y.
-Lemma Im_def:
- (X: (Ensemble U)) (f: U -> V) (x: U) (In ? X x) -> (In ? (Im X f) (f x)).
+Lemma Im_def :
+ forall (X:Ensemble U) (f:U -> V) (x:U), In _ X x -> In _ (Im X f) (f x).
Proof.
-Intros X f x H'; Try Assumption.
-Apply Im_intro with x := x; Auto with sets.
+intros X f x H'; try assumption.
+apply Im_intro with (x := x); auto with sets.
Qed.
-Hints Resolve Im_def.
+Hint Resolve Im_def.
-Lemma Im_add:
- (X: (Ensemble U)) (x: U) (f: U -> V)
- (Im (Add ? X x) f) == (Add ? (Im X f) (f x)).
+Lemma Im_add :
+ forall (X:Ensemble U) (x:U) (f:U -> V),
+ Im (Add _ X x) f = Add _ (Im X f) (f x).
Proof.
-Intros X x f.
-Apply Extensionality_Ensembles.
-Split; Red; Intros x0 H'.
-Elim H'; Intros.
-Rewrite H0.
-Elim Add_inv with U X x x1; Auto with sets.
-NewDestruct 1; Auto with sets.
-Elim Add_inv with V (Im X f) (f x) x0; Auto with sets.
-NewDestruct 1 as [x0 H y H0].
-Rewrite H0; Auto with sets.
-NewDestruct 1; Auto with sets.
+intros X x f.
+apply Extensionality_Ensembles.
+split; red in |- *; intros x0 H'.
+elim H'; intros.
+rewrite H0.
+elim Add_inv with U X x x1; auto with sets.
+destruct 1; auto with sets.
+elim Add_inv with V (Im X f) (f x) x0; auto with sets.
+destruct 1 as [x0 H y H0].
+rewrite H0; auto with sets.
+destruct 1; auto with sets.
Qed.
-Lemma image_empty: (f: U -> V) (Im (Empty_set U) f) == (Empty_set V).
+Lemma image_empty : forall f:U -> V, Im (Empty_set U) f = Empty_set V.
Proof.
-Intro f; Try Assumption.
-Apply Extensionality_Ensembles.
-Split; Auto with sets.
-Red.
-Intros x H'; Elim H'.
-Intros x0 H'0; Elim H'0; Auto with sets.
+intro f; try assumption.
+apply Extensionality_Ensembles.
+split; auto with sets.
+red in |- *.
+intros x H'; elim H'.
+intros x0 H'0; elim H'0; auto with sets.
Qed.
-Hints Resolve image_empty.
+Hint Resolve image_empty.
-Lemma finite_image:
- (X: (Ensemble U)) (f: U -> V) (Finite ? X) -> (Finite ? (Im X f)).
+Lemma finite_image :
+ forall (X:Ensemble U) (f:U -> V), Finite _ X -> Finite _ (Im X f).
Proof.
-Intros X f H'; Elim H'.
-Rewrite (image_empty f); Auto with sets.
-Intros A H'0 H'1 x H'2; Clear H' X.
-Rewrite (Im_add A x f); Auto with sets.
-Apply Add_preserves_Finite; Auto with sets.
+intros X f H'; elim H'.
+rewrite (image_empty f); auto with sets.
+intros A H'0 H'1 x H'2; clear H' X.
+rewrite (Im_add A x f); auto with sets.
+apply Add_preserves_Finite; auto with sets.
Qed.
-Hints Resolve finite_image.
+Hint Resolve finite_image.
-Lemma Im_inv:
- (X: (Ensemble U)) (f: U -> V) (y: V) (In ? (Im X f) y) ->
- (exT ? [x: U] (In ? X x) /\ (f x) == y).
+Lemma Im_inv :
+ forall (X:Ensemble U) (f:U -> V) (y:V),
+ In _ (Im X f) y -> exists x : U | In _ X x /\ f x = y.
Proof.
-Intros X f y H'; Elim H'.
-Intros x H'0 y0 H'1; Rewrite H'1.
-Exists x; Auto with sets.
+intros X f y H'; elim H'.
+intros x H'0 y0 H'1; rewrite H'1.
+exists x; auto with sets.
Qed.
-Definition injective := [f: U -> V] (x, y: U) (f x) == (f y) -> x == y.
+Definition injective (f:U -> V) := forall x y:U, f x = f y -> x = y.
-Lemma not_injective_elim:
- (f: U -> V) ~ (injective f) ->
- (EXT x | (EXT y | (f x) == (f y) /\ ~ x == y)).
+Lemma not_injective_elim :
+ forall f:U -> V,
+ ~ injective f -> exists x : _ | ( exists y : _ | f x = f y /\ x <> y).
Proof.
-Unfold injective; Intros f H.
-Cut (EXT x | ~ ((y: U) (f x) == (f y) -> x == y)).
-2: Apply not_all_ex_not with P:=[x:U](y: U) (f x) == (f y) -> x == y;
- Trivial with sets.
-NewDestruct 1 as [x C]; Exists x.
-Cut (EXT y | ~((f x)==(f y)->x==y)).
-2: Apply not_all_ex_not with P:=[y:U](f x)==(f y)->x==y; Trivial with sets.
-NewDestruct 1 as [y D]; Exists y.
-Apply imply_to_and; Trivial with sets.
+unfold injective in |- *; intros f H.
+cut ( exists x : _ | ~ (forall y:U, f x = f y -> x = y)).
+2: apply not_all_ex_not with (P := fun x:U => forall y:U, f x = f y -> x = y);
+ trivial with sets.
+destruct 1 as [x C]; exists x.
+cut ( exists y : _ | ~ (f x = f y -> x = y)).
+2: apply not_all_ex_not with (P := fun y:U => f x = f y -> x = y);
+ trivial with sets.
+destruct 1 as [y D]; exists y.
+apply imply_to_and; trivial with sets.
Qed.
-Lemma cardinal_Im_intro:
- (A: (Ensemble U)) (f: U -> V) (n: nat) (cardinal ? A n) ->
- (EX p: nat | (cardinal ? (Im A f) p)).
+Lemma cardinal_Im_intro :
+ forall (A:Ensemble U) (f:U -> V) (n:nat),
+ cardinal _ A n -> exists p : nat | cardinal _ (Im A f) p.
Proof.
-Intros.
-Apply finite_cardinal; Apply finite_image.
-Apply cardinal_finite with n; Trivial with sets.
+intros.
+apply finite_cardinal; apply finite_image.
+apply cardinal_finite with n; trivial with sets.
Qed.
-Lemma In_Image_elim:
- (A: (Ensemble U)) (f: U -> V) (injective f) ->
- (x: U) (In ? (Im A f) (f x)) -> (In ? A x).
+Lemma In_Image_elim :
+ forall (A:Ensemble U) (f:U -> V),
+ injective f -> forall x:U, In _ (Im A f) (f x) -> In _ A x.
Proof.
-Intros.
-Elim Im_inv with A f (f x); Trivial with sets.
-Intros z C; Elim C; Intros InAz E.
-Elim (H z x E); Trivial with sets.
+intros.
+elim Im_inv with A f (f x); trivial with sets.
+intros z C; elim C; intros InAz E.
+elim (H z x E); trivial with sets.
Qed.
-Lemma injective_preserves_cardinal:
- (A: (Ensemble U)) (f: U -> V) (n: nat) (injective f) -> (cardinal ? A n) ->
- (n': nat) (cardinal ? (Im A f) n') -> n' = n.
+Lemma injective_preserves_cardinal :
+ forall (A:Ensemble U) (f:U -> V) (n:nat),
+ injective f ->
+ cardinal _ A n -> forall n':nat, cardinal _ (Im A f) n' -> n' = n.
Proof.
-NewInduction 2 as [|A n H'0 H'1 x H'2]; Auto with sets.
-Rewrite (image_empty f).
-Intros n' CE.
-Apply cardinal_unicity with V (Empty_set V); Auto with sets.
-Intro n'.
-Rewrite (Im_add A x f).
-Intro H'3.
-Elim cardinal_Im_intro with A f n; Trivial with sets.
-Intros i CI.
-LApply (H'1 i); Trivial with sets.
-Cut ~ (In ? (Im A f) (f x)).
-Intros H0 H1.
-Apply cardinal_unicity with V (Add ? (Im A f) (f x)); Trivial with sets.
-Apply card_add; Auto with sets.
-Rewrite <- H1; Trivial with sets.
-Red; Intro; Apply H'2.
-Apply In_Image_elim with f; Trivial with sets.
+induction 2 as [| A n H'0 H'1 x H'2]; auto with sets.
+rewrite (image_empty f).
+intros n' CE.
+apply cardinal_unicity with V (Empty_set V); auto with sets.
+intro n'.
+rewrite (Im_add A x f).
+intro H'3.
+elim cardinal_Im_intro with A f n; trivial with sets.
+intros i CI.
+lapply (H'1 i); trivial with sets.
+cut (~ In _ (Im A f) (f x)).
+intros H0 H1.
+apply cardinal_unicity with V (Add _ (Im A f) (f x)); trivial with sets.
+apply card_add; auto with sets.
+rewrite <- H1; trivial with sets.
+red in |- *; intro; apply H'2.
+apply In_Image_elim with f; trivial with sets.
Qed.
-Lemma cardinal_decreases:
- (A: (Ensemble U)) (f: U -> V) (n: nat) (cardinal U A n) ->
- (n': nat) (cardinal V (Im A f) n') -> (le n' n).
+Lemma cardinal_decreases :
+ forall (A:Ensemble U) (f:U -> V) (n:nat),
+ cardinal U A n -> forall n':nat, cardinal V (Im A f) n' -> n' <= n.
Proof.
-NewInduction 1 as [|A n H'0 H'1 x H'2]; Auto with sets.
-Rewrite (image_empty f); Intros.
-Cut n' = O.
-Intro E; Rewrite E; Trivial with sets.
-Apply cardinal_unicity with V (Empty_set V); Auto with sets.
-Intro n'.
-Rewrite (Im_add A x f).
-Elim cardinal_Im_intro with A f n; Trivial with sets.
-Intros p C H'3.
-Apply le_trans with (S p).
-Apply card_Add_gen with V (Im A f) (f x); Trivial with sets.
-Apply le_n_S; Auto with sets.
+induction 1 as [| A n H'0 H'1 x H'2]; auto with sets.
+rewrite (image_empty f); intros.
+cut (n' = 0).
+intro E; rewrite E; trivial with sets.
+apply cardinal_unicity with V (Empty_set V); auto with sets.
+intro n'.
+rewrite (Im_add A x f).
+elim cardinal_Im_intro with A f n; trivial with sets.
+intros p C H'3.
+apply le_trans with (S p).
+apply card_Add_gen with V (Im A f) (f x); trivial with sets.
+apply le_n_S; auto with sets.
Qed.
-Theorem Pigeonhole:
- (A: (Ensemble U)) (f: U -> V) (n: nat) (cardinal U A n) ->
- (n': nat) (cardinal V (Im A f) n') -> (lt n' n) -> ~ (injective f).
+Theorem Pigeonhole :
+ forall (A:Ensemble U) (f:U -> V) (n:nat),
+ cardinal U A n ->
+ forall n':nat, cardinal V (Im A f) n' -> n' < n -> ~ injective f.
Proof.
-Unfold not; Intros A f n CAn n' CIfn' ltn'n I.
-Cut n' = n.
-Intro E; Generalize ltn'n; Rewrite E; Exact (lt_n_n n).
-Apply injective_preserves_cardinal with A := A f := f n := n; Trivial with sets.
+unfold not in |- *; intros A f n CAn n' CIfn' ltn'n I.
+cut (n' = n).
+intro E; generalize ltn'n; rewrite E; exact (lt_irrefl n).
+apply injective_preserves_cardinal with (A := A) (f := f) (n := n);
+ trivial with sets.
Qed.
-Lemma Pigeonhole_principle:
- (A: (Ensemble U)) (f: U -> V) (n: nat) (cardinal ? A n) ->
- (n': nat) (cardinal ? (Im A f) n') -> (lt n' n) ->
- (EXT x | (EXT y | (f x) == (f y) /\ ~ x == y)).
+Lemma Pigeonhole_principle :
+ forall (A:Ensemble U) (f:U -> V) (n:nat),
+ cardinal _ A n ->
+ forall n':nat,
+ cardinal _ (Im A f) n' ->
+ n' < n -> exists x : _ | ( exists y : _ | f x = f y /\ x <> y).
Proof.
-Intros; Apply not_injective_elim.
-Apply Pigeonhole with A n n'; Trivial with sets.
+intros; apply not_injective_elim.
+apply Pigeonhole with A n n'; trivial with sets.
Qed.
End Image.
-Hints Resolve Im_def image_empty finite_image : sets v62.
+Hint Resolve Im_def image_empty finite_image: sets v62. \ No newline at end of file
diff --git a/theories/Sets/Infinite_sets.v b/theories/Sets/Infinite_sets.v
index c6233453a..20ec73fa6 100755
--- a/theories/Sets/Infinite_sets.v
+++ b/theories/Sets/Infinite_sets.v
@@ -40,193 +40,205 @@ Require Export Finite_sets_facts.
Require Export Image.
Section Approx.
-Variable U: Type.
+Variable U : Type.
-Inductive Approximant [A, X:(Ensemble U)] : Prop :=
- Defn_of_Approximant: (Finite U X) -> (Included U X A) -> (Approximant A X).
+Inductive Approximant (A X:Ensemble U) : Prop :=
+ Defn_of_Approximant : Finite U X -> Included U X A -> Approximant A X.
End Approx.
-Hints Resolve Defn_of_Approximant.
+Hint Resolve Defn_of_Approximant.
Section Infinite_sets.
-Variable U: Type.
+Variable U : Type.
-Lemma make_new_approximant:
- (A: (Ensemble U)) (X: (Ensemble U)) ~ (Finite U A) -> (Approximant U A X) ->
- (Inhabited U (Setminus U A X)).
+Lemma make_new_approximant :
+ forall A X:Ensemble U,
+ ~ Finite U A -> Approximant U A X -> Inhabited U (Setminus U A X).
Proof.
-Intros A X H' H'0.
-Elim H'0; Intros H'1 H'2.
-Apply Strict_super_set_contains_new_element; Auto with sets.
-Red; Intro H'3; Apply H'.
-Rewrite <- H'3; Auto with sets.
+intros A X H' H'0.
+elim H'0; intros H'1 H'2.
+apply Strict_super_set_contains_new_element; auto with sets.
+red in |- *; intro H'3; apply H'.
+rewrite <- H'3; auto with sets.
Qed.
-Lemma approximants_grow:
- (A: (Ensemble U)) (X: (Ensemble U)) ~ (Finite U A) ->
- (n: nat) (cardinal U X n) -> (Included U X A) ->
- (EXT Y | (cardinal U Y (S n)) /\ (Included U Y A)).
+Lemma approximants_grow :
+ forall A X:Ensemble U,
+ ~ Finite U A ->
+ forall n:nat,
+ cardinal U X n ->
+ Included U X A -> exists Y : _ | cardinal U Y (S n) /\ Included U Y A.
Proof.
-Intros A X H' n H'0; Elim H'0; Auto with sets.
-Intro H'1.
-Cut (Inhabited U (Setminus U A (Empty_set U))).
-Intro H'2; Elim H'2.
-Intros x H'3.
-Exists (Add U (Empty_set U) x); Auto with sets.
-Split.
-Apply card_add; Auto with sets.
-Cut (In U A x).
-Intro H'4; Red; Auto with sets.
-Intros x0 H'5; Elim H'5; Auto with sets.
-Intros x1 H'6; Elim H'6; Auto with sets.
-Elim H'3; Auto with sets.
-Apply make_new_approximant; Auto with sets.
-Intros A0 n0 H'1 H'2 x H'3 H'5.
-LApply H'2; [Intro H'6; Elim H'6; Clear H'2 | Clear H'2]; Auto with sets.
-Intros x0 H'2; Try Assumption.
-Elim H'2; Intros H'7 H'8; Try Exact H'8; Clear H'2.
-Elim (make_new_approximant A x0); Auto with sets.
-Intros x1 H'2; Try Assumption.
-Exists (Add U x0 x1); Auto with sets.
-Split.
-Apply card_add; Auto with sets.
-Elim H'2; Auto with sets.
-Red.
-Intros x2 H'9; Elim H'9; Auto with sets.
-Intros x3 H'10; Elim H'10; Auto with sets.
-Elim H'2; Auto with sets.
-Auto with sets.
-Apply Defn_of_Approximant; Auto with sets.
-Apply cardinal_finite with n := (S n0); Auto with sets.
+intros A X H' n H'0; elim H'0; auto with sets.
+intro H'1.
+cut (Inhabited U (Setminus U A (Empty_set U))).
+intro H'2; elim H'2.
+intros x H'3.
+exists (Add U (Empty_set U) x); auto with sets.
+split.
+apply card_add; auto with sets.
+cut (In U A x).
+intro H'4; red in |- *; auto with sets.
+intros x0 H'5; elim H'5; auto with sets.
+intros x1 H'6; elim H'6; auto with sets.
+elim H'3; auto with sets.
+apply make_new_approximant; auto with sets.
+intros A0 n0 H'1 H'2 x H'3 H'5.
+lapply H'2; [ intro H'6; elim H'6; clear H'2 | clear H'2 ]; auto with sets.
+intros x0 H'2; try assumption.
+elim H'2; intros H'7 H'8; try exact H'8; clear H'2.
+elim (make_new_approximant A x0); auto with sets.
+intros x1 H'2; try assumption.
+exists (Add U x0 x1); auto with sets.
+split.
+apply card_add; auto with sets.
+elim H'2; auto with sets.
+red in |- *.
+intros x2 H'9; elim H'9; auto with sets.
+intros x3 H'10; elim H'10; auto with sets.
+elim H'2; auto with sets.
+auto with sets.
+apply Defn_of_Approximant; auto with sets.
+apply cardinal_finite with (n := S n0); auto with sets.
Qed.
-Lemma approximants_grow':
- (A: (Ensemble U)) (X: (Ensemble U)) ~ (Finite U A) ->
- (n: nat) (cardinal U X n) -> (Approximant U A X) ->
- (EXT Y | (cardinal U Y (S n)) /\ (Approximant U A Y)).
+Lemma approximants_grow' :
+ forall A X:Ensemble U,
+ ~ Finite U A ->
+ forall n:nat,
+ cardinal U X n ->
+ Approximant U A X ->
+ exists Y : _ | cardinal U Y (S n) /\ Approximant U A Y.
Proof.
-Intros A X H' n H'0 H'1; Try Assumption.
-Elim H'1.
-Intros H'2 H'3.
-ElimType (EXT Y | (cardinal U Y (S n)) /\ (Included U Y A)).
-Intros x H'4; Elim H'4; Intros H'5 H'6; Try Exact H'5; Clear H'4.
-Exists x; Auto with sets.
-Split; [Auto with sets | Idtac].
-Apply Defn_of_Approximant; Auto with sets.
-Apply cardinal_finite with n := (S n); Auto with sets.
-Apply approximants_grow with X := X; Auto with sets.
+intros A X H' n H'0 H'1; try assumption.
+elim H'1.
+intros H'2 H'3.
+elimtype ( exists Y : _ | cardinal U Y (S n) /\ Included U Y A).
+intros x H'4; elim H'4; intros H'5 H'6; try exact H'5; clear H'4.
+exists x; auto with sets.
+split; [ auto with sets | idtac ].
+apply Defn_of_Approximant; auto with sets.
+apply cardinal_finite with (n := S n); auto with sets.
+apply approximants_grow with (X := X); auto with sets.
Qed.
-Lemma approximant_can_be_any_size:
- (A: (Ensemble U)) (X: (Ensemble U)) ~ (Finite U A) ->
- (n: nat) (EXT Y | (cardinal U Y n) /\ (Approximant U A Y)).
+Lemma approximant_can_be_any_size :
+ forall A X:Ensemble U,
+ ~ Finite U A ->
+ forall n:nat, exists Y : _ | cardinal U Y n /\ Approximant U A Y.
Proof.
-Intros A H' H'0 n; Elim n.
-Exists (Empty_set U); Auto with sets.
-Intros n0 H'1; Elim H'1.
-Intros x H'2.
-Apply approximants_grow' with X := x; Tauto.
+intros A H' H'0 n; elim n.
+exists (Empty_set U); auto with sets.
+intros n0 H'1; elim H'1.
+intros x H'2.
+apply approximants_grow' with (X := x); tauto.
Qed.
-Variable V: Type.
+Variable V : Type.
-Theorem Image_set_continuous:
- (A: (Ensemble U))
- (f: U -> V) (X: (Ensemble V)) (Finite V X) -> (Included V X (Im U V A f)) ->
- (EX n |
- (EXT Y | ((cardinal U Y n) /\ (Included U Y A)) /\ (Im U V Y f) == X)).
+Theorem Image_set_continuous :
+ forall (A:Ensemble U) (f:U -> V) (X:Ensemble V),
+ Finite V X ->
+ Included V X (Im U V A f) ->
+ exists n : _
+ | ( exists Y : _ | (cardinal U Y n /\ Included U Y A) /\ Im U V Y f = X).
Proof.
-Intros A f X H'; Elim H'.
-Intro H'0; Exists O.
-Exists (Empty_set U); Auto with sets.
-Intros A0 H'0 H'1 x H'2 H'3; Try Assumption.
-LApply H'1;
- [Intro H'4; Elim H'4; Intros n E; Elim E; Clear H'4 H'1 | Clear H'1]; Auto with sets.
-Intros x0 H'1; Try Assumption.
-Exists (S n); Try Assumption.
-Elim H'1; Intros H'4 H'5; Elim H'4; Intros H'6 H'7; Try Exact H'6; Clear H'4 H'1.
-Clear E.
-Generalize H'2.
-Rewrite <- H'5.
-Intro H'1; Try Assumption.
-Red in H'3.
-Generalize (H'3 x).
-Intro H'4; LApply H'4; [Intro H'8; Try Exact H'8; Clear H'4 | Clear H'4]; Auto with sets.
-Specialize 5 Im_inv with U := U V:=V X := A f := f y := x; Intro H'11;
- LApply H'11; [Intro H'13; Elim H'11; Clear H'11 | Clear H'11]; Auto with sets.
-Intros x1 H'4; Try Assumption.
-Apply exT_intro with x := (Add U x0 x1).
-Split; [Split; [Try Assumption | Idtac] | Idtac].
-Apply card_add; Auto with sets.
-Red; Intro H'9; Try Exact H'9.
-Apply H'1.
-Elim H'4; Intros H'10 H'11; Rewrite <- H'11; Clear H'4; Auto with sets.
-Elim H'4; Intros H'9 H'10; Try Exact H'9; Clear H'4; Auto with sets.
-Red; Auto with sets.
-Intros x2 H'4; Elim H'4; Auto with sets.
-Intros x3 H'11; Elim H'11; Auto with sets.
-Elim H'4; Intros H'9 H'10; Rewrite <- H'10; Clear H'4; Auto with sets.
-Apply Im_add; Auto with sets.
+intros A f X H'; elim H'.
+intro H'0; exists 0.
+exists (Empty_set U); auto with sets.
+intros A0 H'0 H'1 x H'2 H'3; try assumption.
+lapply H'1;
+ [ intro H'4; elim H'4; intros n E; elim E; clear H'4 H'1 | clear H'1 ];
+ auto with sets.
+intros x0 H'1; try assumption.
+exists (S n); try assumption.
+elim H'1; intros H'4 H'5; elim H'4; intros H'6 H'7; try exact H'6;
+ clear H'4 H'1.
+clear E.
+generalize H'2.
+rewrite <- H'5.
+intro H'1; try assumption.
+red in H'3.
+generalize (H'3 x).
+intro H'4; lapply H'4; [ intro H'8; try exact H'8; clear H'4 | clear H'4 ];
+ auto with sets.
+specialize 5Im_inv with (U := U) (V := V) (X := A) (f := f) (y := x);
+ intro H'11; lapply H'11; [ intro H'13; elim H'11; clear H'11 | clear H'11 ];
+ auto with sets.
+intros x1 H'4; try assumption.
+apply ex_intro with (x := Add U x0 x1).
+split; [ split; [ try assumption | idtac ] | idtac ].
+apply card_add; auto with sets.
+red in |- *; intro H'9; try exact H'9.
+apply H'1.
+elim H'4; intros H'10 H'11; rewrite <- H'11; clear H'4; auto with sets.
+elim H'4; intros H'9 H'10; try exact H'9; clear H'4; auto with sets.
+red in |- *; auto with sets.
+intros x2 H'4; elim H'4; auto with sets.
+intros x3 H'11; elim H'11; auto with sets.
+elim H'4; intros H'9 H'10; rewrite <- H'10; clear H'4; auto with sets.
+apply Im_add; auto with sets.
Qed.
-Theorem Image_set_continuous':
- (A: (Ensemble U))
- (f: U -> V) (X: (Ensemble V)) (Approximant V (Im U V A f) X) ->
- (EXT Y | (Approximant U A Y) /\ (Im U V Y f) == X).
+Theorem Image_set_continuous' :
+ forall (A:Ensemble U) (f:U -> V) (X:Ensemble V),
+ Approximant V (Im U V A f) X ->
+ exists Y : _ | Approximant U A Y /\ Im U V Y f = X.
Proof.
-Intros A f X H'; Try Assumption.
-Cut (EX n | (EXT Y |
- ((cardinal U Y n) /\ (Included U Y A)) /\ (Im U V Y f) == X)).
-Intro H'0; Elim H'0; Intros n E; Elim E; Clear H'0.
-Intros x H'0; Try Assumption.
-Elim H'0; Intros H'1 H'2; Elim H'1; Intros H'3 H'4; Try Exact H'3;
- Clear H'1 H'0; Auto with sets.
-Exists x.
-Split; [Idtac | Try Assumption].
-Apply Defn_of_Approximant; Auto with sets.
-Apply cardinal_finite with n := n; Auto with sets.
-Apply Image_set_continuous; Auto with sets.
-Elim H'; Auto with sets.
-Elim H'; Auto with sets.
+intros A f X H'; try assumption.
+cut
+ ( exists n : _
+ | ( exists Y : _ | (cardinal U Y n /\ Included U Y A) /\ Im U V Y f = X)).
+intro H'0; elim H'0; intros n E; elim E; clear H'0.
+intros x H'0; try assumption.
+elim H'0; intros H'1 H'2; elim H'1; intros H'3 H'4; try exact H'3;
+ clear H'1 H'0; auto with sets.
+exists x.
+split; [ idtac | try assumption ].
+apply Defn_of_Approximant; auto with sets.
+apply cardinal_finite with (n := n); auto with sets.
+apply Image_set_continuous; auto with sets.
+elim H'; auto with sets.
+elim H'; auto with sets.
Qed.
-Theorem Pigeonhole_bis:
- (A: (Ensemble U)) (f: U -> V) ~ (Finite U A) -> (Finite V (Im U V A f)) ->
- ~ (injective U V f).
+Theorem Pigeonhole_bis :
+ forall (A:Ensemble U) (f:U -> V),
+ ~ Finite U A -> Finite V (Im U V A f) -> ~ injective U V f.
Proof.
-Intros A f H'0 H'1; Try Assumption.
-Elim (Image_set_continuous' A f (Im U V A f)); Auto with sets.
-Intros x H'2; Elim H'2; Intros H'3 H'4; Try Exact H'3; Clear H'2.
-Elim (make_new_approximant A x); Auto with sets.
-Intros x0 H'2; Elim H'2.
-Intros H'5 H'6.
-Elim (finite_cardinal V (Im U V A f)); Auto with sets.
-Intros n E.
-Elim (finite_cardinal U x); Auto with sets.
-Intros n0 E0.
-Apply Pigeonhole with A := (Add U x x0) n := (S n0) n' := n.
-Apply card_add; Auto with sets.
-Rewrite (Im_add U V x x0 f); Auto with sets.
-Cut (In V (Im U V x f) (f x0)).
-Intro H'8.
-Rewrite (Non_disjoint_union V (Im U V x f) (f x0)); Auto with sets.
-Rewrite H'4; Auto with sets.
-Elim (Extension V (Im U V x f) (Im U V A f)); Auto with sets.
-Apply le_lt_n_Sm.
-Apply cardinal_decreases with U := U V := V A := x f := f; Auto with sets.
-Rewrite H'4; Auto with sets.
-Elim H'3; Auto with sets.
+intros A f H'0 H'1; try assumption.
+elim (Image_set_continuous' A f (Im U V A f)); auto with sets.
+intros x H'2; elim H'2; intros H'3 H'4; try exact H'3; clear H'2.
+elim (make_new_approximant A x); auto with sets.
+intros x0 H'2; elim H'2.
+intros H'5 H'6.
+elim (finite_cardinal V (Im U V A f)); auto with sets.
+intros n E.
+elim (finite_cardinal U x); auto with sets.
+intros n0 E0.
+apply Pigeonhole with (A := Add U x x0) (n := S n0) (n' := n).
+apply card_add; auto with sets.
+rewrite (Im_add U V x x0 f); auto with sets.
+cut (In V (Im U V x f) (f x0)).
+intro H'8.
+rewrite (Non_disjoint_union V (Im U V x f) (f x0)); auto with sets.
+rewrite H'4; auto with sets.
+elim (Extension V (Im U V x f) (Im U V A f)); auto with sets.
+apply le_lt_n_Sm.
+apply cardinal_decreases with (U := U) (V := V) (A := x) (f := f);
+ auto with sets.
+rewrite H'4; auto with sets.
+elim H'3; auto with sets.
Qed.
-Theorem Pigeonhole_ter:
- (A: (Ensemble U))
- (f: U -> V) (n: nat) (injective U V f) -> (Finite V (Im U V A f)) ->
- (Finite U A).
+Theorem Pigeonhole_ter :
+ forall (A:Ensemble U) (f:U -> V) (n:nat),
+ injective U V f -> Finite V (Im U V A f) -> Finite U A.
Proof.
-Intros A f H' H'0 H'1.
-Apply NNPP.
-Red; Intro H'2.
-Elim (Pigeonhole_bis A f); Auto with sets.
+intros A f H' H'0 H'1.
+apply NNPP.
+red in |- *; intro H'2.
+elim (Pigeonhole_bis A f); auto with sets.
Qed.
-End Infinite_sets.
+End Infinite_sets. \ No newline at end of file
diff --git a/theories/Sets/Integers.v b/theories/Sets/Integers.v
index dbfc6b463..7f8e1695a 100755
--- a/theories/Sets/Integers.v
+++ b/theories/Sets/Integers.v
@@ -46,116 +46,118 @@ Require Export Cpo.
Section Integers_sect.
-Inductive Integers : (Ensemble nat) :=
- Integers_defn: (x: nat) (In nat Integers x).
-Hints Resolve Integers_defn.
+Inductive Integers : Ensemble nat :=
+ Integers_defn : forall x:nat, In nat Integers x.
+Hint Resolve Integers_defn.
-Lemma le_reflexive: (Reflexive nat le).
+Lemma le_reflexive : Reflexive nat le.
Proof.
-Red; Auto with arith.
+red in |- *; auto with arith.
Qed.
-Lemma le_antisym: (Antisymmetric nat le).
+Lemma le_antisym : Antisymmetric nat le.
Proof.
-Red; Intros x y H H';Rewrite (le_antisym x y);Auto.
+red in |- *; intros x y H H'; rewrite (le_antisym x y); auto.
Qed.
-Lemma le_trans: (Transitive nat le).
+Lemma le_trans : Transitive nat le.
Proof.
-Red; Intros; Apply le_trans with y;Auto.
+red in |- *; intros; apply le_trans with y; auto.
Qed.
-Hints Resolve le_reflexive le_antisym le_trans.
+Hint Resolve le_reflexive le_antisym le_trans.
-Lemma le_Order: (Order nat le).
+Lemma le_Order : Order nat le.
Proof.
-Auto with sets arith.
+auto with sets arith.
Qed.
-Hints Resolve le_Order.
+Hint Resolve le_Order.
-Lemma triv_nat: (n: nat) (In nat Integers n).
+Lemma triv_nat : forall n:nat, In nat Integers n.
Proof.
-Auto with sets arith.
+auto with sets arith.
Qed.
-Hints Resolve triv_nat.
+Hint Resolve triv_nat.
-Definition nat_po: (PO nat).
-Apply Definition_of_PO with Carrier_of := Integers Rel_of := le; Auto with sets arith.
-Apply Inhabited_intro with x := O; Auto with sets arith.
+Definition nat_po : PO nat.
+apply Definition_of_PO with (Carrier_of := Integers) (Rel_of := le);
+ auto with sets arith.
+apply Inhabited_intro with (x := 0); auto with sets arith.
Defined.
-Hints Unfold nat_po.
+Hint Unfold nat_po.
-Lemma le_total_order: (Totally_ordered nat nat_po Integers).
+Lemma le_total_order : Totally_ordered nat nat_po Integers.
Proof.
-Apply Totally_ordered_definition.
-Simpl.
-Intros H' x y H'0.
-Specialize 2 le_or_lt with n := x m := y; Intro H'2; Elim H'2.
-Intro H'1; Left; Auto with sets arith.
-Intro H'1; Right.
-Cut (le y x); Auto with sets arith.
+apply Totally_ordered_definition.
+simpl in |- *.
+intros H' x y H'0.
+specialize 2le_or_lt with (n := x) (m := y); intro H'2; elim H'2.
+intro H'1; left; auto with sets arith.
+intro H'1; right.
+cut (y <= x); auto with sets arith.
Qed.
-Hints Resolve le_total_order.
+Hint Resolve le_total_order.
-Lemma Finite_subset_has_lub:
- (X: (Ensemble nat)) (Finite nat X) ->
- (EXT m: nat | (Upper_Bound nat nat_po X m)).
+Lemma Finite_subset_has_lub :
+ forall X:Ensemble nat,
+ Finite nat X -> exists m : nat | Upper_Bound nat nat_po X m.
Proof.
-Intros X H'; Elim H'.
-Exists O.
-Apply Upper_Bound_definition; Auto with sets arith.
-Intros y H'0; Elim H'0; Auto with sets arith.
-Intros A H'0 H'1 x H'2; Try Assumption.
-Elim H'1; Intros x0 H'3; Clear H'1.
-Elim le_total_order.
-Simpl.
-Intro H'1; Try Assumption.
-LApply H'1; [Intro H'4; Idtac | Try Assumption]; Auto with sets arith.
-Generalize (H'4 x0 x).
-Clear H'4.
-Clear H'1.
-Intro H'1; LApply H'1;
- [Intro H'4; Elim H'4;
- [Intro H'5; Try Exact H'5; Clear H'4 H'1 | Intro H'5; Clear H'4 H'1] |
- Clear H'1].
-Exists x.
-Apply Upper_Bound_definition; Auto with sets arith; Simpl.
-Intros y H'1; Elim H'1.
-Generalize le_trans.
-Intro H'4; Red in H'4.
-Intros x1 H'6; Try Assumption.
-Apply H'4 with y := x0; Auto with sets arith.
-Elim H'3; Simpl; Auto with sets arith.
-Intros x1 H'4; Elim H'4; Auto with sets arith.
-Exists x0.
-Apply Upper_Bound_definition; Auto with sets arith; Simpl.
-Intros y H'1; Elim H'1.
-Intros x1 H'4; Try Assumption.
-Elim H'3; Simpl; Auto with sets arith.
-Intros x1 H'4; Elim H'4; Auto with sets arith.
-Red.
-Intros x1 H'1; Elim H'1; Auto with sets arith.
+intros X H'; elim H'.
+exists 0.
+apply Upper_Bound_definition; auto with sets arith.
+intros y H'0; elim H'0; auto with sets arith.
+intros A H'0 H'1 x H'2; try assumption.
+elim H'1; intros x0 H'3; clear H'1.
+elim le_total_order.
+simpl in |- *.
+intro H'1; try assumption.
+lapply H'1; [ intro H'4; idtac | try assumption ]; auto with sets arith.
+generalize (H'4 x0 x).
+clear H'4.
+clear H'1.
+intro H'1; lapply H'1;
+ [ intro H'4; elim H'4;
+ [ intro H'5; try exact H'5; clear H'4 H'1 | intro H'5; clear H'4 H'1 ]
+ | clear H'1 ].
+exists x.
+apply Upper_Bound_definition; auto with sets arith; simpl in |- *.
+intros y H'1; elim H'1.
+generalize le_trans.
+intro H'4; red in H'4.
+intros x1 H'6; try assumption.
+apply H'4 with (y := x0); auto with sets arith.
+elim H'3; simpl in |- *; auto with sets arith.
+intros x1 H'4; elim H'4; auto with sets arith.
+exists x0.
+apply Upper_Bound_definition; auto with sets arith; simpl in |- *.
+intros y H'1; elim H'1.
+intros x1 H'4; try assumption.
+elim H'3; simpl in |- *; auto with sets arith.
+intros x1 H'4; elim H'4; auto with sets arith.
+red in |- *.
+intros x1 H'1; elim H'1; auto with sets arith.
Qed.
-Lemma Integers_has_no_ub: ~ (EXT m:nat | (Upper_Bound nat nat_po Integers m)).
+Lemma Integers_has_no_ub :
+ ~ ( exists m : nat | Upper_Bound nat nat_po Integers m).
Proof.
-Red; Intro H'; Elim H'.
-Intros x H'0.
-Elim H'0; Intros H'1 H'2.
-Cut (In nat Integers (S x)).
-Intro H'3.
-Specialize 1 H'2 with y := (S x); Intro H'4; LApply H'4;
- [Intro H'5; Clear H'4 | Try Assumption; Clear H'4].
-Simpl in H'5.
-Absurd (le (S x) x); Auto with arith.
-Auto with sets arith.
+red in |- *; intro H'; elim H'.
+intros x H'0.
+elim H'0; intros H'1 H'2.
+cut (In nat Integers (S x)).
+intro H'3.
+specialize 1H'2 with (y := S x); intro H'4; lapply H'4;
+ [ intro H'5; clear H'4 | try assumption; clear H'4 ].
+simpl in H'5.
+absurd (S x <= x); auto with arith.
+auto with sets arith.
Qed.
-Lemma Integers_infinite: ~ (Finite nat Integers).
+Lemma Integers_infinite : ~ Finite nat Integers.
Proof.
-Generalize Integers_has_no_ub.
-Intro H'; Red; Intro H'0; Try Exact H'0.
-Apply H'.
-Apply Finite_subset_has_lub; Auto with sets arith.
+generalize Integers_has_no_ub.
+intro H'; red in |- *; intro H'0; try exact H'0.
+apply H'.
+apply Finite_subset_has_lub; auto with sets arith.
Qed.
End Integers_sect.
@@ -163,4 +165,3 @@ End Integers_sect.
-
diff --git a/theories/Sets/Multiset.v b/theories/Sets/Multiset.v
index 37fb47e27..a3ae98d0a 100755
--- a/theories/Sets/Multiset.v
+++ b/theories/Sets/Multiset.v
@@ -10,7 +10,7 @@
(* G. Huet 1-9-95 *)
-Require Permut.
+Require Import Permut.
Set Implicit Arguments.
@@ -18,155 +18,159 @@ Section multiset_defs.
Variable A : Set.
Variable eqA : A -> A -> Prop.
-Hypothesis Aeq_dec : (x,y:A){(eqA x y)}+{~(eqA x y)}.
+Hypothesis Aeq_dec : forall x y:A, {eqA x y} + {~ eqA x y}.
-Inductive multiset : Set :=
- Bag : (A->nat) -> multiset.
+Inductive multiset : Set :=
+ Bag : (A -> nat) -> multiset.
-Definition EmptyBag := (Bag [a:A]O).
-Definition SingletonBag := [a:A]
- (Bag [a':A]Cases (Aeq_dec a a') of
- (left _) => (S O)
- | (right _) => O
- end
- ).
+Definition EmptyBag := Bag (fun a:A => 0).
+Definition SingletonBag (a:A) :=
+ Bag (fun a':A => match Aeq_dec a a' with
+ | left _ => 1
+ | right _ => 0
+ end).
-Definition multiplicity : multiset -> A -> nat :=
- [m:multiset][a:A]let (f) = m in (f a).
+Definition multiplicity (m:multiset) (a:A) : nat := let (f) := m in f a.
(** multiset equality *)
-Definition meq := [m1,m2:multiset]
- (a:A)(multiplicity m1 a)=(multiplicity m2 a).
+Definition meq (m1 m2:multiset) :=
+ forall a:A, multiplicity m1 a = multiplicity m2 a.
-Hints Unfold meq multiplicity.
+Hint Unfold meq multiplicity.
-Lemma meq_refl : (x:multiset)(meq x x).
+Lemma meq_refl : forall x:multiset, meq x x.
Proof.
-NewDestruct x; Auto.
+destruct x; auto.
Qed.
-Hints Resolve meq_refl.
+Hint Resolve meq_refl.
-Lemma meq_trans : (x,y,z:multiset)(meq x y)->(meq y z)->(meq x z).
+Lemma meq_trans : forall x y z:multiset, meq x y -> meq y z -> meq x z.
Proof.
-Unfold meq.
-NewDestruct x; NewDestruct y; NewDestruct z.
-Intros; Rewrite H; Auto.
+unfold meq in |- *.
+destruct x; destruct y; destruct z.
+intros; rewrite H; auto.
Qed.
-Lemma meq_sym : (x,y:multiset)(meq x y)->(meq y x).
+Lemma meq_sym : forall x y:multiset, meq x y -> meq y x.
Proof.
-Unfold meq.
-NewDestruct x; NewDestruct y; Auto.
+unfold meq in |- *.
+destruct x; destruct y; auto.
Qed.
-Hints Immediate meq_sym.
+Hint Immediate meq_sym.
(** multiset union *)
-Definition munion := [m1,m2:multiset]
- (Bag [a:A](plus (multiplicity m1 a)(multiplicity m2 a))).
+Definition munion (m1 m2:multiset) :=
+ Bag (fun a:A => multiplicity m1 a + multiplicity m2 a).
-Lemma munion_empty_left :
- (x:multiset)(meq x (munion EmptyBag x)).
+Lemma munion_empty_left : forall x:multiset, meq x (munion EmptyBag x).
Proof.
-Unfold meq; Unfold munion; Simpl; Auto.
+unfold meq in |- *; unfold munion in |- *; simpl in |- *; auto.
Qed.
-Hints Resolve munion_empty_left.
+Hint Resolve munion_empty_left.
-Lemma munion_empty_right :
- (x:multiset)(meq x (munion x EmptyBag)).
+Lemma munion_empty_right : forall x:multiset, meq x (munion x EmptyBag).
Proof.
-Unfold meq; Unfold munion; Simpl; Auto.
+unfold meq in |- *; unfold munion in |- *; simpl in |- *; auto.
Qed.
-Require Plus. (* comm. and ass. of plus *)
+Require Import Plus. (* comm. and ass. of plus *)
-Lemma munion_comm : (x,y:multiset)(meq (munion x y) (munion y x)).
+Lemma munion_comm : forall x y:multiset, meq (munion x y) (munion y x).
Proof.
-Unfold meq; Unfold multiplicity; Unfold munion.
-NewDestruct x; NewDestruct y; Auto with arith.
+unfold meq in |- *; unfold multiplicity in |- *; unfold munion in |- *.
+destruct x; destruct y; auto with arith.
Qed.
-Hints Resolve munion_comm.
+Hint Resolve munion_comm.
-Lemma munion_ass :
- (x,y,z:multiset)(meq (munion (munion x y) z) (munion x (munion y z))).
+Lemma munion_ass :
+ forall x y z:multiset, meq (munion (munion x y) z) (munion x (munion y z)).
Proof.
-Unfold meq; Unfold munion; Unfold multiplicity.
-NewDestruct x; NewDestruct y; NewDestruct z; Auto with arith.
+unfold meq in |- *; unfold munion in |- *; unfold multiplicity in |- *.
+destruct x; destruct y; destruct z; auto with arith.
Qed.
-Hints Resolve munion_ass.
+Hint Resolve munion_ass.
-Lemma meq_left : (x,y,z:multiset)(meq x y)->(meq (munion x z) (munion y z)).
+Lemma meq_left :
+ forall x y z:multiset, meq x y -> meq (munion x z) (munion y z).
Proof.
-Unfold meq; Unfold munion; Unfold multiplicity.
-NewDestruct x; NewDestruct y; NewDestruct z.
-Intros; Elim H; Auto with arith.
+unfold meq in |- *; unfold munion in |- *; unfold multiplicity in |- *.
+destruct x; destruct y; destruct z.
+intros; elim H; auto with arith.
Qed.
-Hints Resolve meq_left.
+Hint Resolve meq_left.
-Lemma meq_right : (x,y,z:multiset)(meq x y)->(meq (munion z x) (munion z y)).
+Lemma meq_right :
+ forall x y z:multiset, meq x y -> meq (munion z x) (munion z y).
Proof.
-Unfold meq; Unfold munion; Unfold multiplicity.
-NewDestruct x; NewDestruct y; NewDestruct z.
-Intros; Elim H; Auto.
+unfold meq in |- *; unfold munion in |- *; unfold multiplicity in |- *.
+destruct x; destruct y; destruct z.
+intros; elim H; auto.
Qed.
-Hints Resolve meq_right.
+Hint Resolve meq_right.
(** Here we should make multiset an abstract datatype, by hiding [Bag],
[munion], [multiplicity]; all further properties are proved abstractly *)
Lemma munion_rotate :
- (x,y,z:multiset)(meq (munion x (munion y z)) (munion z (munion x y))).
+ forall x y z:multiset, meq (munion x (munion y z)) (munion z (munion x y)).
Proof.
-Intros; Apply (op_rotate multiset munion meq); Auto.
-Exact meq_trans.
+intros; apply (op_rotate multiset munion meq); auto.
+exact meq_trans.
Qed.
-Lemma meq_congr : (x,y,z,t:multiset)(meq x y)->(meq z t)->
- (meq (munion x z) (munion y t)).
+Lemma meq_congr :
+ forall x y z t:multiset, meq x y -> meq z t -> meq (munion x z) (munion y t).
Proof.
-Intros; Apply (cong_congr multiset munion meq); Auto.
-Exact meq_trans.
+intros; apply (cong_congr multiset munion meq); auto.
+exact meq_trans.
Qed.
Lemma munion_perm_left :
- (x,y,z:multiset)(meq (munion x (munion y z)) (munion y (munion x z))).
+ forall x y z:multiset, meq (munion x (munion y z)) (munion y (munion x z)).
Proof.
-Intros; Apply (perm_left multiset munion meq); Auto.
-Exact meq_trans.
+intros; apply (perm_left multiset munion meq); auto.
+exact meq_trans.
Qed.
-Lemma multiset_twist1 : (x,y,z,t:multiset)
- (meq (munion x (munion (munion y z) t)) (munion (munion y (munion x t)) z)).
+Lemma multiset_twist1 :
+ forall x y z t:multiset,
+ meq (munion x (munion (munion y z) t)) (munion (munion y (munion x t)) z).
Proof.
-Intros; Apply (twist multiset munion meq); Auto.
-Exact meq_trans.
+intros; apply (twist multiset munion meq); auto.
+exact meq_trans.
Qed.
-Lemma multiset_twist2 : (x,y,z,t:multiset)
- (meq (munion x (munion (munion y z) t)) (munion (munion y (munion x z)) t)).
+Lemma multiset_twist2 :
+ forall x y z t:multiset,
+ meq (munion x (munion (munion y z) t)) (munion (munion y (munion x z)) t).
Proof.
-Intros; Apply meq_trans with (munion (munion x (munion y z)) t).
-Apply meq_sym; Apply munion_ass.
-Apply meq_left; Apply munion_perm_left.
+intros; apply meq_trans with (munion (munion x (munion y z)) t).
+apply meq_sym; apply munion_ass.
+apply meq_left; apply munion_perm_left.
Qed.
(** specific for treesort *)
-Lemma treesort_twist1 : (x,y,z,t,u:multiset) (meq u (munion y z)) ->
- (meq (munion x (munion u t)) (munion (munion y (munion x t)) z)).
+Lemma treesort_twist1 :
+ forall x y z t u:multiset,
+ meq u (munion y z) ->
+ meq (munion x (munion u t)) (munion (munion y (munion x t)) z).
Proof.
-Intros; Apply meq_trans with (munion x (munion (munion y z) t)).
-Apply meq_right; Apply meq_left; Trivial.
-Apply multiset_twist1.
+intros; apply meq_trans with (munion x (munion (munion y z) t)).
+apply meq_right; apply meq_left; trivial.
+apply multiset_twist1.
Qed.
-Lemma treesort_twist2 : (x,y,z,t,u:multiset) (meq u (munion y z)) ->
- (meq (munion x (munion u t)) (munion (munion y (munion x z)) t)).
+Lemma treesort_twist2 :
+ forall x y z t u:multiset,
+ meq u (munion y z) ->
+ meq (munion x (munion u t)) (munion (munion y (munion x z)) t).
Proof.
-Intros; Apply meq_trans with (munion x (munion (munion y z) t)).
-Apply meq_right; Apply meq_left; Trivial.
-Apply multiset_twist2.
+intros; apply meq_trans with (munion x (munion (munion y z) t)).
+apply meq_right; apply meq_left; trivial.
+apply multiset_twist2.
Qed.
@@ -181,6 +185,7 @@ End multiset_defs.
Unset Implicit Arguments.
-Hints Unfold meq multiplicity : v62 datatypes.
-Hints Resolve munion_empty_right munion_comm munion_ass meq_left meq_right munion_empty_left : v62 datatypes.
-Hints Immediate meq_sym : v62 datatypes.
+Hint Unfold meq multiplicity: v62 datatypes.
+Hint Resolve munion_empty_right munion_comm munion_ass meq_left meq_right
+ munion_empty_left: v62 datatypes.
+Hint Immediate meq_sym: v62 datatypes. \ No newline at end of file
diff --git a/theories/Sets/Partial_Order.v b/theories/Sets/Partial_Order.v
index f3d692b85..5ef6bc9b0 100755
--- a/theories/Sets/Partial_Order.v
+++ b/theories/Sets/Partial_Order.v
@@ -30,71 +30,71 @@ Require Export Ensembles.
Require Export Relations_1.
Section Partial_orders.
-Variable U: Type.
+Variable U : Type.
-Definition Carrier := (Ensemble U).
+Definition Carrier := Ensemble U.
-Definition Rel := (Relation U).
+Definition Rel := Relation U.
-Record PO : Type := Definition_of_PO {
- Carrier_of: (Ensemble U);
- Rel_of: (Relation U);
- PO_cond1: (Inhabited U Carrier_of);
- PO_cond2: (Order U Rel_of) }.
-Variable p: PO.
+Record PO : Type := Definition_of_PO
+ {Carrier_of : Ensemble U;
+ Rel_of : Relation U;
+ PO_cond1 : Inhabited U Carrier_of;
+ PO_cond2 : Order U Rel_of}.
+Variable p : PO.
-Definition Strict_Rel_of : Rel := [x, y: U] (Rel_of p x y) /\ ~ x == y.
+Definition Strict_Rel_of : Rel := fun x y:U => Rel_of p x y /\ x <> y.
-Inductive covers [y, x:U]: Prop :=
- Definition_of_covers:
- (Strict_Rel_of x y) ->
- ~ (EXT z | (Strict_Rel_of x z) /\ (Strict_Rel_of z y)) ->
- (covers y x).
+Inductive covers (y x:U) : Prop :=
+ Definition_of_covers :
+ Strict_Rel_of x y ->
+ ~ ( exists z : _ | Strict_Rel_of x z /\ Strict_Rel_of z y) ->
+ covers y x.
End Partial_orders.
-Hints Unfold Carrier_of Rel_of Strict_Rel_of : sets v62.
-Hints Resolve Definition_of_covers : sets v62.
+Hint Unfold Carrier_of Rel_of Strict_Rel_of: sets v62.
+Hint Resolve Definition_of_covers: sets v62.
Section Partial_order_facts.
-Variable U:Type.
-Variable D:(PO U).
+Variable U : Type.
+Variable D : PO U.
-Lemma Strict_Rel_Transitive_with_Rel:
- (x:U) (y:U) (z:U) (Strict_Rel_of U D x y) -> (Rel_of U D y z) ->
- (Strict_Rel_of U D x z).
-Unfold 1 Strict_Rel_of.
-Red.
-Elim D; Simpl.
-Intros C R H' H'0; Elim H'0.
-Intros H'1 H'2 H'3 x y z H'4 H'5; Split.
-Apply H'2 with y := y; Tauto.
-Red; Intro H'6.
-Elim H'4; Intros H'7 H'8; Apply H'8; Clear H'4.
-Apply H'3; Auto.
-Rewrite H'6; Tauto.
+Lemma Strict_Rel_Transitive_with_Rel :
+ forall x y z:U,
+ Strict_Rel_of U D x y -> Rel_of U D y z -> Strict_Rel_of U D x z.
+unfold Strict_Rel_of at 1 in |- *.
+red in |- *.
+elim D; simpl in |- *.
+intros C R H' H'0; elim H'0.
+intros H'1 H'2 H'3 x y z H'4 H'5; split.
+apply H'2 with (y := y); tauto.
+red in |- *; intro H'6.
+elim H'4; intros H'7 H'8; apply H'8; clear H'4.
+apply H'3; auto.
+rewrite H'6; tauto.
Qed.
-Lemma Strict_Rel_Transitive_with_Rel_left:
- (x:U) (y:U) (z:U) (Rel_of U D x y) -> (Strict_Rel_of U D y z) ->
- (Strict_Rel_of U D x z).
-Unfold 1 Strict_Rel_of.
-Red.
-Elim D; Simpl.
-Intros C R H' H'0; Elim H'0.
-Intros H'1 H'2 H'3 x y z H'4 H'5; Split.
-Apply H'2 with y := y; Tauto.
-Red; Intro H'6.
-Elim H'5; Intros H'7 H'8; Apply H'8; Clear H'5.
-Apply H'3; Auto.
-Rewrite <- H'6; Auto.
+Lemma Strict_Rel_Transitive_with_Rel_left :
+ forall x y z:U,
+ Rel_of U D x y -> Strict_Rel_of U D y z -> Strict_Rel_of U D x z.
+unfold Strict_Rel_of at 1 in |- *.
+red in |- *.
+elim D; simpl in |- *.
+intros C R H' H'0; elim H'0.
+intros H'1 H'2 H'3 x y z H'4 H'5; split.
+apply H'2 with (y := y); tauto.
+red in |- *; intro H'6.
+elim H'5; intros H'7 H'8; apply H'8; clear H'5.
+apply H'3; auto.
+rewrite <- H'6; auto.
Qed.
-Lemma Strict_Rel_Transitive: (Transitive U (Strict_Rel_of U D)).
-Red.
-Intros x y z H' H'0.
-Apply Strict_Rel_Transitive_with_Rel with y := y;
- [ Intuition | Unfold Strict_Rel_of in H' H'0; Intuition ].
+Lemma Strict_Rel_Transitive : Transitive U (Strict_Rel_of U D).
+red in |- *.
+intros x y z H' H'0.
+apply Strict_Rel_Transitive_with_Rel with (y := y);
+ [ intuition | unfold Strict_Rel_of in H', H'0; intuition ].
Qed.
-End Partial_order_facts.
+End Partial_order_facts. \ No newline at end of file
diff --git a/theories/Sets/Permut.v b/theories/Sets/Permut.v
index 03a8b7428..c3a1da01c 100755
--- a/theories/Sets/Permut.v
+++ b/theories/Sets/Permut.v
@@ -15,77 +15,77 @@
Section Axiomatisation.
-Variable U: Set.
+Variable U : Set.
-Variable op: U -> U -> U.
+Variable op : U -> U -> U.
Variable cong : U -> U -> Prop.
-Hypothesis op_comm : (x,y:U)(cong (op x y) (op y x)).
-Hypothesis op_ass : (x,y,z:U)(cong (op (op x y) z) (op x (op y z))).
+Hypothesis op_comm : forall x y:U, cong (op x y) (op y x).
+Hypothesis op_ass : forall x y z:U, cong (op (op x y) z) (op x (op y z)).
-Hypothesis cong_left : (x,y,z:U)(cong x y)->(cong (op x z) (op y z)).
-Hypothesis cong_right : (x,y,z:U)(cong x y)->(cong (op z x) (op z y)).
-Hypothesis cong_trans : (x,y,z:U)(cong x y)->(cong y z)->(cong x z).
-Hypothesis cong_sym : (x,y:U)(cong x y)->(cong y x).
+Hypothesis cong_left : forall x y z:U, cong x y -> cong (op x z) (op y z).
+Hypothesis cong_right : forall x y z:U, cong x y -> cong (op z x) (op z y).
+Hypothesis cong_trans : forall x y z:U, cong x y -> cong y z -> cong x z.
+Hypothesis cong_sym : forall x y:U, cong x y -> cong y x.
(** Remark. we do not need: [Hypothesis cong_refl : (x:U)(cong x x)]. *)
Lemma cong_congr :
- (x,y,z,t:U)(cong x y)->(cong z t)->(cong (op x z) (op y t)).
+ forall x y z t:U, cong x y -> cong z t -> cong (op x z) (op y t).
Proof.
-Intros; Apply cong_trans with (op y z).
-Apply cong_left; Trivial.
-Apply cong_right; Trivial.
+intros; apply cong_trans with (op y z).
+apply cong_left; trivial.
+apply cong_right; trivial.
Qed.
-Lemma comm_right : (x,y,z:U)(cong (op x (op y z)) (op x (op z y))).
+Lemma comm_right : forall x y z:U, cong (op x (op y z)) (op x (op z y)).
Proof.
-Intros; Apply cong_right; Apply op_comm.
+intros; apply cong_right; apply op_comm.
Qed.
-Lemma comm_left : (x,y,z:U)(cong (op (op x y) z) (op (op y x) z)).
+Lemma comm_left : forall x y z:U, cong (op (op x y) z) (op (op y x) z).
Proof.
-Intros; Apply cong_left; Apply op_comm.
+intros; apply cong_left; apply op_comm.
Qed.
-Lemma perm_right : (x,y,z:U)(cong (op (op x y) z) (op (op x z) y)).
+Lemma perm_right : forall x y z:U, cong (op (op x y) z) (op (op x z) y).
Proof.
-Intros.
-Apply cong_trans with (op x (op y z)).
-Apply op_ass.
-Apply cong_trans with (op x (op z y)).
-Apply cong_right; Apply op_comm.
-Apply cong_sym; Apply op_ass.
+intros.
+apply cong_trans with (op x (op y z)).
+apply op_ass.
+apply cong_trans with (op x (op z y)).
+apply cong_right; apply op_comm.
+apply cong_sym; apply op_ass.
Qed.
-Lemma perm_left : (x,y,z:U)(cong (op x (op y z)) (op y (op x z))).
+Lemma perm_left : forall x y z:U, cong (op x (op y z)) (op y (op x z)).
Proof.
-Intros.
-Apply cong_trans with (op (op x y) z).
-Apply cong_sym; Apply op_ass.
-Apply cong_trans with (op (op y x) z).
-Apply cong_left; Apply op_comm.
-Apply op_ass.
+intros.
+apply cong_trans with (op (op x y) z).
+apply cong_sym; apply op_ass.
+apply cong_trans with (op (op y x) z).
+apply cong_left; apply op_comm.
+apply op_ass.
Qed.
-Lemma op_rotate : (x,y,z,t:U)(cong (op x (op y z)) (op z (op x y))).
+Lemma op_rotate : forall x y z t:U, cong (op x (op y z)) (op z (op x y)).
Proof.
-Intros; Apply cong_trans with (op (op x y) z).
-Apply cong_sym; Apply op_ass.
-Apply op_comm.
+intros; apply cong_trans with (op (op x y) z).
+apply cong_sym; apply op_ass.
+apply op_comm.
Qed.
(* Needed for treesort ... *)
-Lemma twist : (x,y,z,t:U)
- (cong (op x (op (op y z) t)) (op (op y (op x t)) z)).
+Lemma twist :
+ forall x y z t:U, cong (op x (op (op y z) t)) (op (op y (op x t)) z).
Proof.
-Intros.
-Apply cong_trans with (op x (op (op y t) z)).
-Apply cong_right; Apply perm_right.
-Apply cong_trans with (op (op x (op y t)) z).
-Apply cong_sym; Apply op_ass.
-Apply cong_left; Apply perm_left.
+intros.
+apply cong_trans with (op x (op (op y t) z)).
+apply cong_right; apply perm_right.
+apply cong_trans with (op (op x (op y t)) z).
+apply cong_sym; apply op_ass.
+apply cong_left; apply perm_left.
Qed.
-End Axiomatisation.
+End Axiomatisation. \ No newline at end of file
diff --git a/theories/Sets/Powerset.v b/theories/Sets/Powerset.v
index c9c7188b1..543702276 100755
--- a/theories/Sets/Powerset.v
+++ b/theories/Sets/Powerset.v
@@ -33,156 +33,158 @@ Require Export Partial_Order.
Require Export Cpo.
Section The_power_set_partial_order.
-Variable U: Type.
+Variable U : Type.
-Inductive Power_set [A:(Ensemble U)]: (Ensemble (Ensemble U)) :=
- Definition_of_Power_set:
- (X: (Ensemble U)) (Included U X A) -> (In (Ensemble U) (Power_set A) X).
-Hints Resolve Definition_of_Power_set.
+Inductive Power_set (A:Ensemble U) : Ensemble (Ensemble U) :=
+ Definition_of_Power_set :
+ forall X:Ensemble U, Included U X A -> In (Ensemble U) (Power_set A) X.
+Hint Resolve Definition_of_Power_set.
-Theorem Empty_set_minimal: (X: (Ensemble U)) (Included U (Empty_set U) X).
-Intro X; Red.
-Intros x H'; Elim H'.
+Theorem Empty_set_minimal : forall X:Ensemble U, Included U (Empty_set U) X.
+intro X; red in |- *.
+intros x H'; elim H'.
Qed.
-Hints Resolve Empty_set_minimal.
+Hint Resolve Empty_set_minimal.
-Theorem Power_set_Inhabited:
- (X: (Ensemble U)) (Inhabited (Ensemble U) (Power_set X)).
-Intro X.
-Apply Inhabited_intro with (Empty_set U); Auto with sets.
+Theorem Power_set_Inhabited :
+ forall X:Ensemble U, Inhabited (Ensemble U) (Power_set X).
+intro X.
+apply Inhabited_intro with (Empty_set U); auto with sets.
Qed.
-Hints Resolve Power_set_Inhabited.
+Hint Resolve Power_set_Inhabited.
-Theorem Inclusion_is_an_order: (Order (Ensemble U) (Included U)).
-Auto 6 with sets.
+Theorem Inclusion_is_an_order : Order (Ensemble U) (Included U).
+auto 6 with sets.
Qed.
-Hints Resolve Inclusion_is_an_order.
+Hint Resolve Inclusion_is_an_order.
-Theorem Inclusion_is_transitive: (Transitive (Ensemble U) (Included U)).
-Elim Inclusion_is_an_order; Auto with sets.
+Theorem Inclusion_is_transitive : Transitive (Ensemble U) (Included U).
+elim Inclusion_is_an_order; auto with sets.
Qed.
-Hints Resolve Inclusion_is_transitive.
+Hint Resolve Inclusion_is_transitive.
-Definition Power_set_PO: (Ensemble U) -> (PO (Ensemble U)).
-Intro A; Try Assumption.
-Apply Definition_of_PO with (Power_set A) (Included U); Auto with sets.
+Definition Power_set_PO : Ensemble U -> PO (Ensemble U).
+intro A; try assumption.
+apply Definition_of_PO with (Power_set A) (Included U); auto with sets.
Defined.
-Hints Unfold Power_set_PO.
+Hint Unfold Power_set_PO.
-Theorem Strict_Rel_is_Strict_Included:
- (same_relation
- (Ensemble U) (Strict_Included U)
- (Strict_Rel_of (Ensemble U) (Power_set_PO (Full_set U)))).
-Auto with sets.
+Theorem Strict_Rel_is_Strict_Included :
+ same_relation (Ensemble U) (Strict_Included U)
+ (Strict_Rel_of (Ensemble U) (Power_set_PO (Full_set U))).
+auto with sets.
Qed.
-Hints Resolve Strict_Rel_Transitive Strict_Rel_is_Strict_Included.
+Hint Resolve Strict_Rel_Transitive Strict_Rel_is_Strict_Included.
-Lemma Strict_inclusion_is_transitive_with_inclusion:
- (x, y, z:(Ensemble U)) (Strict_Included U x y) -> (Included U y z) ->
- (Strict_Included U x z).
-Intros x y z H' H'0; Try Assumption.
-Elim Strict_Rel_is_Strict_Included.
-Unfold contains.
-Intros H'1 H'2; Try Assumption.
-Apply H'1.
-Apply Strict_Rel_Transitive_with_Rel with y := y; Auto with sets.
+Lemma Strict_inclusion_is_transitive_with_inclusion :
+ forall x y z:Ensemble U,
+ Strict_Included U x y -> Included U y z -> Strict_Included U x z.
+intros x y z H' H'0; try assumption.
+elim Strict_Rel_is_Strict_Included.
+unfold contains in |- *.
+intros H'1 H'2; try assumption.
+apply H'1.
+apply Strict_Rel_Transitive_with_Rel with (y := y); auto with sets.
Qed.
-Lemma Strict_inclusion_is_transitive_with_inclusion_left:
- (x, y, z:(Ensemble U)) (Included U x y) -> (Strict_Included U y z) ->
- (Strict_Included U x z).
-Intros x y z H' H'0; Try Assumption.
-Elim Strict_Rel_is_Strict_Included.
-Unfold contains.
-Intros H'1 H'2; Try Assumption.
-Apply H'1.
-Apply Strict_Rel_Transitive_with_Rel_left with y := y; Auto with sets.
+Lemma Strict_inclusion_is_transitive_with_inclusion_left :
+ forall x y z:Ensemble U,
+ Included U x y -> Strict_Included U y z -> Strict_Included U x z.
+intros x y z H' H'0; try assumption.
+elim Strict_Rel_is_Strict_Included.
+unfold contains in |- *.
+intros H'1 H'2; try assumption.
+apply H'1.
+apply Strict_Rel_Transitive_with_Rel_left with (y := y); auto with sets.
Qed.
-Lemma Strict_inclusion_is_transitive:
- (Transitive (Ensemble U) (Strict_Included U)).
-Apply cong_transitive_same_relation
- with R := (Strict_Rel_of (Ensemble U) (Power_set_PO (Full_set U))); Auto with sets.
+Lemma Strict_inclusion_is_transitive :
+ Transitive (Ensemble U) (Strict_Included U).
+apply cong_transitive_same_relation with
+ (R := Strict_Rel_of (Ensemble U) (Power_set_PO (Full_set U)));
+ auto with sets.
Qed.
-Theorem Empty_set_is_Bottom:
- (A: (Ensemble U)) (Bottom (Ensemble U) (Power_set_PO A) (Empty_set U)).
-Intro A; Apply Bottom_definition; Simpl; Auto with sets.
+Theorem Empty_set_is_Bottom :
+ forall A:Ensemble U, Bottom (Ensemble U) (Power_set_PO A) (Empty_set U).
+intro A; apply Bottom_definition; simpl in |- *; auto with sets.
Qed.
-Hints Resolve Empty_set_is_Bottom.
+Hint Resolve Empty_set_is_Bottom.
-Theorem Union_minimal:
- (a, b, X: (Ensemble U)) (Included U a X) -> (Included U b X) ->
- (Included U (Union U a b) X).
-Intros a b X H' H'0; Red.
-Intros x H'1; Elim H'1; Auto with sets.
+Theorem Union_minimal :
+ forall a b X:Ensemble U,
+ Included U a X -> Included U b X -> Included U (Union U a b) X.
+intros a b X H' H'0; red in |- *.
+intros x H'1; elim H'1; auto with sets.
Qed.
-Hints Resolve Union_minimal.
+Hint Resolve Union_minimal.
-Theorem Intersection_maximal:
- (a, b, X: (Ensemble U)) (Included U X a) -> (Included U X b) ->
- (Included U X (Intersection U a b)).
-Auto with sets.
+Theorem Intersection_maximal :
+ forall a b X:Ensemble U,
+ Included U X a -> Included U X b -> Included U X (Intersection U a b).
+auto with sets.
Qed.
-Theorem Union_increases_l: (a, b: (Ensemble U)) (Included U a (Union U a b)).
-Auto with sets.
+Theorem Union_increases_l : forall a b:Ensemble U, Included U a (Union U a b).
+auto with sets.
Qed.
-Theorem Union_increases_r: (a, b: (Ensemble U)) (Included U b (Union U a b)).
-Auto with sets.
+Theorem Union_increases_r : forall a b:Ensemble U, Included U b (Union U a b).
+auto with sets.
Qed.
-Theorem Intersection_decreases_l:
- (a, b: (Ensemble U)) (Included U (Intersection U a b) a).
-Intros a b; Red.
-Intros x H'; Elim H'; Auto with sets.
+Theorem Intersection_decreases_l :
+ forall a b:Ensemble U, Included U (Intersection U a b) a.
+intros a b; red in |- *.
+intros x H'; elim H'; auto with sets.
Qed.
-Theorem Intersection_decreases_r:
- (a, b: (Ensemble U)) (Included U (Intersection U a b) b).
-Intros a b; Red.
-Intros x H'; Elim H'; Auto with sets.
+Theorem Intersection_decreases_r :
+ forall a b:Ensemble U, Included U (Intersection U a b) b.
+intros a b; red in |- *.
+intros x H'; elim H'; auto with sets.
Qed.
-Hints Resolve Union_increases_l Union_increases_r Intersection_decreases_l
- Intersection_decreases_r.
+Hint Resolve Union_increases_l Union_increases_r Intersection_decreases_l
+ Intersection_decreases_r.
-Theorem Union_is_Lub:
- (A: (Ensemble U)) (a, b: (Ensemble U)) (Included U a A) -> (Included U b A) ->
- (Lub (Ensemble U) (Power_set_PO A) (Couple (Ensemble U) a b) (Union U a b)).
-Intros A a b H' H'0.
-Apply Lub_definition; Simpl.
-Apply Upper_Bound_definition; Simpl; Auto with sets.
-Intros y H'1; Elim H'1; Auto with sets.
-Intros y H'1; Elim H'1; Simpl; Auto with sets.
+Theorem Union_is_Lub :
+ forall A a b:Ensemble U,
+ Included U a A ->
+ Included U b A ->
+ Lub (Ensemble U) (Power_set_PO A) (Couple (Ensemble U) a b) (Union U a b).
+intros A a b H' H'0.
+apply Lub_definition; simpl in |- *.
+apply Upper_Bound_definition; simpl in |- *; auto with sets.
+intros y H'1; elim H'1; auto with sets.
+intros y H'1; elim H'1; simpl in |- *; auto with sets.
Qed.
-Theorem Intersection_is_Glb:
- (A: (Ensemble U)) (a, b: (Ensemble U)) (Included U a A) -> (Included U b A) ->
- (Glb
- (Ensemble U)
- (Power_set_PO A)
- (Couple (Ensemble U) a b)
- (Intersection U a b)).
-Intros A a b H' H'0.
-Apply Glb_definition; Simpl.
-Apply Lower_Bound_definition; Simpl; Auto with sets.
-Apply Definition_of_Power_set.
-Generalize Inclusion_is_transitive; Intro IT; Red in IT; Apply IT with a; Auto with sets.
-Intros y H'1; Elim H'1; Auto with sets.
-Intros y H'1; Elim H'1; Simpl; Auto with sets.
+Theorem Intersection_is_Glb :
+ forall A a b:Ensemble U,
+ Included U a A ->
+ Included U b A ->
+ Glb (Ensemble U) (Power_set_PO A) (Couple (Ensemble U) a b)
+ (Intersection U a b).
+intros A a b H' H'0.
+apply Glb_definition; simpl in |- *.
+apply Lower_Bound_definition; simpl in |- *; auto with sets.
+apply Definition_of_Power_set.
+generalize Inclusion_is_transitive; intro IT; red in IT; apply IT with a;
+ auto with sets.
+intros y H'1; elim H'1; auto with sets.
+intros y H'1; elim H'1; simpl in |- *; auto with sets.
Qed.
End The_power_set_partial_order.
-Hints Resolve Empty_set_minimal : sets v62.
-Hints Resolve Power_set_Inhabited : sets v62.
-Hints Resolve Inclusion_is_an_order : sets v62.
-Hints Resolve Inclusion_is_transitive : sets v62.
-Hints Resolve Union_minimal : sets v62.
-Hints Resolve Union_increases_l : sets v62.
-Hints Resolve Union_increases_r : sets v62.
-Hints Resolve Intersection_decreases_l : sets v62.
-Hints Resolve Intersection_decreases_r : sets v62.
-Hints Resolve Empty_set_is_Bottom : sets v62.
-Hints Resolve Strict_inclusion_is_transitive : sets v62.
+Hint Resolve Empty_set_minimal: sets v62.
+Hint Resolve Power_set_Inhabited: sets v62.
+Hint Resolve Inclusion_is_an_order: sets v62.
+Hint Resolve Inclusion_is_transitive: sets v62.
+Hint Resolve Union_minimal: sets v62.
+Hint Resolve Union_increases_l: sets v62.
+Hint Resolve Union_increases_r: sets v62.
+Hint Resolve Intersection_decreases_l: sets v62.
+Hint Resolve Intersection_decreases_r: sets v62.
+Hint Resolve Empty_set_is_Bottom: sets v62.
+Hint Resolve Strict_inclusion_is_transitive: sets v62. \ No newline at end of file
diff --git a/theories/Sets/Powerset_Classical_facts.v b/theories/Sets/Powerset_Classical_facts.v
index 6b3443b7d..988bbd25a 100755
--- a/theories/Sets/Powerset_Classical_facts.v
+++ b/theories/Sets/Powerset_Classical_facts.v
@@ -39,300 +39,304 @@ Require Export Classical_sets.
Section Sets_as_an_algebra.
-Variable U: Type.
+Variable U : Type.
-Lemma sincl_add_x:
- (A, B: (Ensemble U))
- (x: U) ~ (In U A x) -> (Strict_Included U (Add U A x) (Add U B x)) ->
- (Strict_Included U A B).
+Lemma sincl_add_x :
+ forall (A B:Ensemble U) (x:U),
+ ~ In U A x ->
+ Strict_Included U (Add U A x) (Add U B x) -> Strict_Included U A B.
Proof.
-Intros A B x H' H'0; Red.
-LApply (Strict_Included_inv U (Add U A x) (Add U B x)); Auto with sets.
-Clear H'0; Intro H'0; Split.
-Apply incl_add_x with x := x; Tauto.
-Elim H'0; Intros H'1 H'2; Elim H'2; Clear H'0 H'2.
-Intros x0 H'0.
-Red; Intro H'2.
-Elim H'0; Clear H'0.
-Rewrite <- H'2; Auto with sets.
+intros A B x H' H'0; red in |- *.
+lapply (Strict_Included_inv U (Add U A x) (Add U B x)); auto with sets.
+clear H'0; intro H'0; split.
+apply incl_add_x with (x := x); tauto.
+elim H'0; intros H'1 H'2; elim H'2; clear H'0 H'2.
+intros x0 H'0.
+red in |- *; intro H'2.
+elim H'0; clear H'0.
+rewrite <- H'2; auto with sets.
Qed.
-Lemma incl_soustr_in:
- (X: (Ensemble U)) (x: U) (In U X x) -> (Included U (Subtract U X x) X).
+Lemma incl_soustr_in :
+ forall (X:Ensemble U) (x:U), In U X x -> Included U (Subtract U X x) X.
Proof.
-Intros X x H'; Red.
-Intros x0 H'0; Elim H'0; Auto with sets.
+intros X x H'; red in |- *.
+intros x0 H'0; elim H'0; auto with sets.
Qed.
-Hints Resolve incl_soustr_in : sets v62.
+Hint Resolve incl_soustr_in: sets v62.
-Lemma incl_soustr:
- (X, Y: (Ensemble U)) (x: U) (Included U X Y) ->
- (Included U (Subtract U X x) (Subtract U Y x)).
+Lemma incl_soustr :
+ forall (X Y:Ensemble U) (x:U),
+ Included U X Y -> Included U (Subtract U X x) (Subtract U Y x).
Proof.
-Intros X Y x H'; Red.
-Intros x0 H'0; Elim H'0.
-Intros H'1 H'2.
-Apply Subtract_intro; Auto with sets.
+intros X Y x H'; red in |- *.
+intros x0 H'0; elim H'0.
+intros H'1 H'2.
+apply Subtract_intro; auto with sets.
Qed.
-Hints Resolve incl_soustr : sets v62.
+Hint Resolve incl_soustr: sets v62.
-Lemma incl_soustr_add_l:
- (X: (Ensemble U)) (x: U) (Included U (Subtract U (Add U X x) x) X).
+Lemma incl_soustr_add_l :
+ forall (X:Ensemble U) (x:U), Included U (Subtract U (Add U X x) x) X.
Proof.
-Intros X x; Red.
-Intros x0 H'; Elim H'; Auto with sets.
-Intro H'0; Elim H'0; Auto with sets.
-Intros t H'1 H'2; Elim H'2; Auto with sets.
+intros X x; red in |- *.
+intros x0 H'; elim H'; auto with sets.
+intro H'0; elim H'0; auto with sets.
+intros t H'1 H'2; elim H'2; auto with sets.
Qed.
-Hints Resolve incl_soustr_add_l : sets v62.
+Hint Resolve incl_soustr_add_l: sets v62.
-Lemma incl_soustr_add_r:
- (X: (Ensemble U)) (x: U) ~ (In U X x) ->
- (Included U X (Subtract U (Add U X x) x)).
+Lemma incl_soustr_add_r :
+ forall (X:Ensemble U) (x:U),
+ ~ In U X x -> Included U X (Subtract U (Add U X x) x).
Proof.
-Intros X x H'; Red.
-Intros x0 H'0; Try Assumption.
-Apply Subtract_intro; Auto with sets.
-Red; Intro H'1; Apply H'; Rewrite H'1; Auto with sets.
+intros X x H'; red in |- *.
+intros x0 H'0; try assumption.
+apply Subtract_intro; auto with sets.
+red in |- *; intro H'1; apply H'; rewrite H'1; auto with sets.
Qed.
-Hints Resolve incl_soustr_add_r : sets v62.
+Hint Resolve incl_soustr_add_r: sets v62.
-Lemma add_soustr_2:
- (X: (Ensemble U)) (x: U) (In U X x) ->
- (Included U X (Add U (Subtract U X x) x)).
+Lemma add_soustr_2 :
+ forall (X:Ensemble U) (x:U),
+ In U X x -> Included U X (Add U (Subtract U X x) x).
Proof.
-Intros X x H'; Red.
-Intros x0 H'0; Try Assumption.
-Elim (classic x == x0); Intro K; Auto with sets.
-Elim K; Auto with sets.
+intros X x H'; red in |- *.
+intros x0 H'0; try assumption.
+elim (classic (x = x0)); intro K; auto with sets.
+elim K; auto with sets.
Qed.
-Lemma add_soustr_1:
- (X: (Ensemble U)) (x: U) (In U X x) ->
- (Included U (Add U (Subtract U X x) x) X).
+Lemma add_soustr_1 :
+ forall (X:Ensemble U) (x:U),
+ In U X x -> Included U (Add U (Subtract U X x) x) X.
Proof.
-Intros X x H'; Red.
-Intros x0 H'0; Elim H'0; Auto with sets.
-Intros y H'1; Elim H'1; Auto with sets.
-Intros t H'1; Try Assumption.
-Rewrite <- (Singleton_inv U x t); Auto with sets.
+intros X x H'; red in |- *.
+intros x0 H'0; elim H'0; auto with sets.
+intros y H'1; elim H'1; auto with sets.
+intros t H'1; try assumption.
+rewrite <- (Singleton_inv U x t); auto with sets.
Qed.
-Hints Resolve add_soustr_1 add_soustr_2 : sets v62.
+Hint Resolve add_soustr_1 add_soustr_2: sets v62.
-Lemma add_soustr_xy:
- (X: (Ensemble U)) (x, y: U) ~ x == y ->
- (Subtract U (Add U X x) y) == (Add U (Subtract U X y) x).
+Lemma add_soustr_xy :
+ forall (X:Ensemble U) (x y:U),
+ x <> y -> Subtract U (Add U X x) y = Add U (Subtract U X y) x.
Proof.
-Intros X x y H'; Apply Extensionality_Ensembles.
-Split; Red.
-Intros x0 H'0; Elim H'0; Auto with sets.
-Intro H'1; Elim H'1.
-Intros u H'2 H'3; Try Assumption.
-Apply Add_intro1.
-Apply Subtract_intro; Auto with sets.
-Intros t H'2 H'3; Try Assumption.
-Elim (Singleton_inv U x t); Auto with sets.
-Intros u H'2; Try Assumption.
-Elim (Add_inv U (Subtract U X y) x u); Auto with sets.
-Intro H'0; Elim H'0; Auto with sets.
-Intro H'0; Rewrite <- H'0; Auto with sets.
+intros X x y H'; apply Extensionality_Ensembles.
+split; red in |- *.
+intros x0 H'0; elim H'0; auto with sets.
+intro H'1; elim H'1.
+intros u H'2 H'3; try assumption.
+apply Add_intro1.
+apply Subtract_intro; auto with sets.
+intros t H'2 H'3; try assumption.
+elim (Singleton_inv U x t); auto with sets.
+intros u H'2; try assumption.
+elim (Add_inv U (Subtract U X y) x u); auto with sets.
+intro H'0; elim H'0; auto with sets.
+intro H'0; rewrite <- H'0; auto with sets.
Qed.
-Hints Resolve add_soustr_xy : sets v62.
+Hint Resolve add_soustr_xy: sets v62.
-Lemma incl_st_add_soustr:
- (X, Y: (Ensemble U)) (x: U) ~ (In U X x) ->
- (Strict_Included U (Add U X x) Y) ->
- (Strict_Included U X (Subtract U Y x)).
+Lemma incl_st_add_soustr :
+ forall (X Y:Ensemble U) (x:U),
+ ~ In U X x ->
+ Strict_Included U (Add U X x) Y -> Strict_Included U X (Subtract U Y x).
Proof.
-Intros X Y x H' H'0; Apply sincl_add_x with x := x; Auto with sets.
-Split.
-Elim H'0.
-Intros H'1 H'2.
-Generalize (Inclusion_is_transitive U).
-Intro H'4; Red in H'4.
-Apply H'4 with y := Y; Auto with sets.
-Red in H'0.
-Elim H'0; Intros H'1 H'2; Try Exact H'1; Clear H'0. (* PB *)
-Red; Intro H'0; Apply H'2.
-Rewrite H'0; Auto 8 with sets.
+intros X Y x H' H'0; apply sincl_add_x with (x := x); auto with sets.
+split.
+elim H'0.
+intros H'1 H'2.
+generalize (Inclusion_is_transitive U).
+intro H'4; red in H'4.
+apply H'4 with (y := Y); auto with sets.
+red in H'0.
+elim H'0; intros H'1 H'2; try exact H'1; clear H'0. (* PB *)
+red in |- *; intro H'0; apply H'2.
+rewrite H'0; auto 8 with sets.
Qed.
-Lemma Sub_Add_new:
- (X: (Ensemble U)) (x: U) ~ (In U X x) -> X == (Subtract U (Add U X x) x).
+Lemma Sub_Add_new :
+ forall (X:Ensemble U) (x:U), ~ In U X x -> X = Subtract U (Add U X x) x.
Proof.
-Auto with sets.
+auto with sets.
Qed.
-Lemma Simplify_add:
- (X, X0 : (Ensemble U)) (x: U)
- ~ (In U X x) -> ~ (In U X0 x) -> (Add U X x) == (Add U X0 x) -> X == X0.
+Lemma Simplify_add :
+ forall (X X0:Ensemble U) (x:U),
+ ~ In U X x -> ~ In U X0 x -> Add U X x = Add U X0 x -> X = X0.
Proof.
-Intros X X0 x H' H'0 H'1; Try Assumption.
-Rewrite (Sub_Add_new X x); Auto with sets.
-Rewrite (Sub_Add_new X0 x); Auto with sets.
-Rewrite H'1; Auto with sets.
+intros X X0 x H' H'0 H'1; try assumption.
+rewrite (Sub_Add_new X x); auto with sets.
+rewrite (Sub_Add_new X0 x); auto with sets.
+rewrite H'1; auto with sets.
Qed.
-Lemma Included_Add:
- (X, A: (Ensemble U)) (x: U) (Included U X (Add U A x)) ->
- (Included U X A) \/
- (EXT A' | X == (Add U A' x) /\ (Included U A' A)).
+Lemma Included_Add :
+ forall (X A:Ensemble U) (x:U),
+ Included U X (Add U A x) ->
+ Included U X A \/ ( exists A' : _ | X = Add U A' x /\ Included U A' A).
Proof.
-Intros X A x H'0; Try Assumption.
-Elim (classic (In U X x)).
-Intro H'1; Right; Try Assumption.
-Exists (Subtract U X x).
-Split; Auto with sets.
-Red in H'0.
-Red.
-Intros x0 H'2; Try Assumption.
-LApply (Subtract_inv U X x x0); Auto with sets.
-Intro H'3; Elim H'3; Intros K K'; Clear H'3.
-LApply (H'0 x0); Auto with sets.
-Intro H'3; Try Assumption.
-LApply (Add_inv U A x x0); Auto with sets.
-Intro H'4; Elim H'4;
- [Intro H'5; Try Exact H'5; Clear H'4 | Intro H'5; Clear H'4].
-Elim K'; Auto with sets.
-Intro H'1; Left; Try Assumption.
-Red in H'0.
-Red.
-Intros x0 H'2; Try Assumption.
-LApply (H'0 x0); Auto with sets.
-Intro H'3; Try Assumption.
-LApply (Add_inv U A x x0); Auto with sets.
-Intro H'4; Elim H'4;
- [Intro H'5; Try Exact H'5; Clear H'4 | Intro H'5; Clear H'4].
-Absurd (In U X x0); Auto with sets.
-Rewrite <- H'5; Auto with sets.
+intros X A x H'0; try assumption.
+elim (classic (In U X x)).
+intro H'1; right; try assumption.
+exists (Subtract U X x).
+split; auto with sets.
+red in H'0.
+red in |- *.
+intros x0 H'2; try assumption.
+lapply (Subtract_inv U X x x0); auto with sets.
+intro H'3; elim H'3; intros K K'; clear H'3.
+lapply (H'0 x0); auto with sets.
+intro H'3; try assumption.
+lapply (Add_inv U A x x0); auto with sets.
+intro H'4; elim H'4;
+ [ intro H'5; try exact H'5; clear H'4 | intro H'5; clear H'4 ].
+elim K'; auto with sets.
+intro H'1; left; try assumption.
+red in H'0.
+red in |- *.
+intros x0 H'2; try assumption.
+lapply (H'0 x0); auto with sets.
+intro H'3; try assumption.
+lapply (Add_inv U A x x0); auto with sets.
+intro H'4; elim H'4;
+ [ intro H'5; try exact H'5; clear H'4 | intro H'5; clear H'4 ].
+absurd (In U X x0); auto with sets.
+rewrite <- H'5; auto with sets.
Qed.
-Lemma setcover_inv:
- (A: (Ensemble U))
- (x, y: (Ensemble U)) (covers (Ensemble U) (Power_set_PO U A) y x) ->
- (Strict_Included U x y) /\
- ((z: (Ensemble U)) (Included U x z) -> (Included U z y) -> x == z \/ z == y).
+Lemma setcover_inv :
+ forall A x y:Ensemble U,
+ covers (Ensemble U) (Power_set_PO U A) y x ->
+ Strict_Included U x y /\
+ (forall z:Ensemble U, Included U x z -> Included U z y -> x = z \/ z = y).
Proof.
-Intros A x y H'; Elim H'.
-Unfold Strict_Rel_of; Simpl.
-Intros H'0 H'1; Split; [Auto with sets | Idtac].
-Intros z H'2 H'3; Try Assumption.
-Elim (classic x == z); Auto with sets.
-Intro H'4; Right; Try Assumption.
-Elim (classic z == y); Auto with sets.
-Intro H'5; Try Assumption.
-Elim H'1.
-Exists z; Auto with sets.
+intros A x y H'; elim H'.
+unfold Strict_Rel_of in |- *; simpl in |- *.
+intros H'0 H'1; split; [ auto with sets | idtac ].
+intros z H'2 H'3; try assumption.
+elim (classic (x = z)); auto with sets.
+intro H'4; right; try assumption.
+elim (classic (z = y)); auto with sets.
+intro H'5; try assumption.
+elim H'1.
+exists z; auto with sets.
Qed.
-Theorem Add_covers:
- (A: (Ensemble U)) (a: (Ensemble U)) (Included U a A) ->
- (x: U) (In U A x) -> ~ (In U a x) ->
- (covers (Ensemble U) (Power_set_PO U A) (Add U a x) a).
+Theorem Add_covers :
+ forall A a:Ensemble U,
+ Included U a A ->
+ forall x:U,
+ In U A x ->
+ ~ In U a x -> covers (Ensemble U) (Power_set_PO U A) (Add U a x) a.
Proof.
-Intros A a H' x H'0 H'1; Try Assumption.
-Apply setcover_intro; Auto with sets.
-Red.
-Split; [Idtac | Red; Intro H'2; Try Exact H'2]; Auto with sets.
-Apply H'1.
-Rewrite H'2; Auto with sets.
-Red; Intro H'2; Elim H'2; Clear H'2.
-Intros z H'2; Elim H'2; Intros H'3 H'4; Try Exact H'3; Clear H'2.
-LApply (Strict_Included_inv U a z); Auto with sets; Clear H'3.
-Intro H'2; Elim H'2; Intros H'3 H'5; Elim H'5; Clear H'2 H'5.
-Intros x0 H'2; Elim H'2.
-Intros H'5 H'6; Try Assumption.
-Generalize H'4; Intro K.
-Red in H'4.
-Elim H'4; Intros H'8 H'9; Red in H'8; Clear H'4.
-LApply (H'8 x0); Auto with sets.
-Intro H'7; Try Assumption.
-Elim (Add_inv U a x x0); Auto with sets.
-Intro H'15.
-Cut (Included U (Add U a x) z).
-Intro H'10; Try Assumption.
-Red in K.
-Elim K; Intros H'11 H'12; Apply H'12; Clear K; Auto with sets.
-Rewrite H'15.
-Red.
-Intros x1 H'10; Elim H'10; Auto with sets.
-Intros x2 H'11; Elim H'11; Auto with sets.
+intros A a H' x H'0 H'1; try assumption.
+apply setcover_intro; auto with sets.
+red in |- *.
+split; [ idtac | red in |- *; intro H'2; try exact H'2 ]; auto with sets.
+apply H'1.
+rewrite H'2; auto with sets.
+red in |- *; intro H'2; elim H'2; clear H'2.
+intros z H'2; elim H'2; intros H'3 H'4; try exact H'3; clear H'2.
+lapply (Strict_Included_inv U a z); auto with sets; clear H'3.
+intro H'2; elim H'2; intros H'3 H'5; elim H'5; clear H'2 H'5.
+intros x0 H'2; elim H'2.
+intros H'5 H'6; try assumption.
+generalize H'4; intro K.
+red in H'4.
+elim H'4; intros H'8 H'9; red in H'8; clear H'4.
+lapply (H'8 x0); auto with sets.
+intro H'7; try assumption.
+elim (Add_inv U a x x0); auto with sets.
+intro H'15.
+cut (Included U (Add U a x) z).
+intro H'10; try assumption.
+red in K.
+elim K; intros H'11 H'12; apply H'12; clear K; auto with sets.
+rewrite H'15.
+red in |- *.
+intros x1 H'10; elim H'10; auto with sets.
+intros x2 H'11; elim H'11; auto with sets.
Qed.
-Theorem covers_Add:
- (A: (Ensemble U))
- (a, a': (Ensemble U))
- (Included U a A) ->
- (Included U a' A) -> (covers (Ensemble U) (Power_set_PO U A) a' a) ->
- (EXT x | a' == (Add U a x) /\ ((In U A x) /\ ~ (In U a x))).
+Theorem covers_Add :
+ forall A a a':Ensemble U,
+ Included U a A ->
+ Included U a' A ->
+ covers (Ensemble U) (Power_set_PO U A) a' a ->
+ exists x : _ | a' = Add U a x /\ In U A x /\ ~ In U a x.
Proof.
-Intros A a a' H' H'0 H'1; Try Assumption.
-Elim (setcover_inv A a a'); Auto with sets.
-Intros H'6 H'7.
-Clear H'1.
-Elim (Strict_Included_inv U a a'); Auto with sets.
-Intros H'5 H'8; Elim H'8.
-Intros x H'1; Elim H'1.
-Intros H'2 H'3; Try Assumption.
-Exists x.
-Split; [Try Assumption | Idtac].
-Clear H'8 H'1.
-Elim (H'7 (Add U a x)); Auto with sets.
-Intro H'1.
-Absurd a ==(Add U a x); Auto with sets.
-Red; Intro H'8; Try Exact H'8.
-Apply H'3.
-Rewrite H'8; Auto with sets.
-Auto with sets.
-Red.
-Intros x0 H'1; Elim H'1; Auto with sets.
-Intros x1 H'8; Elim H'8; Auto with sets.
-Split; [Idtac | Try Assumption].
-Red in H'0; Auto with sets.
+intros A a a' H' H'0 H'1; try assumption.
+elim (setcover_inv A a a'); auto with sets.
+intros H'6 H'7.
+clear H'1.
+elim (Strict_Included_inv U a a'); auto with sets.
+intros H'5 H'8; elim H'8.
+intros x H'1; elim H'1.
+intros H'2 H'3; try assumption.
+exists x.
+split; [ try assumption | idtac ].
+clear H'8 H'1.
+elim (H'7 (Add U a x)); auto with sets.
+intro H'1.
+absurd (a = Add U a x); auto with sets.
+red in |- *; intro H'8; try exact H'8.
+apply H'3.
+rewrite H'8; auto with sets.
+auto with sets.
+red in |- *.
+intros x0 H'1; elim H'1; auto with sets.
+intros x1 H'8; elim H'8; auto with sets.
+split; [ idtac | try assumption ].
+red in H'0; auto with sets.
Qed.
-Theorem covers_is_Add:
- (A: (Ensemble U))
- (a, a': (Ensemble U)) (Included U a A) -> (Included U a' A) ->
- (iff
- (covers (Ensemble U) (Power_set_PO U A) a' a)
- (EXT x | a' == (Add U a x) /\ ((In U A x) /\ ~ (In U a x)))).
+Theorem covers_is_Add :
+ forall A a a':Ensemble U,
+ Included U a A ->
+ Included U a' A ->
+ (covers (Ensemble U) (Power_set_PO U A) a' a <->
+ ( exists x : _ | a' = Add U a x /\ In U A x /\ ~ In U a x)).
Proof.
-Intros A a a' H' H'0; Split; Intro K.
-Apply covers_Add with A := A; Auto with sets.
-Elim K.
-Intros x H'1; Elim H'1; Intros H'2 H'3; Rewrite H'2; Clear H'1.
-Apply Add_covers; Intuition.
+intros A a a' H' H'0; split; intro K.
+apply covers_Add with (A := A); auto with sets.
+elim K.
+intros x H'1; elim H'1; intros H'2 H'3; rewrite H'2; clear H'1.
+apply Add_covers; intuition.
Qed.
-Theorem Singleton_atomic:
- (x:U) (A:(Ensemble U)) (In U A x) ->
- (covers (Ensemble U) (Power_set_PO U A) (Singleton U x) (Empty_set U)).
-Intros x A H'.
-Rewrite <- (Empty_set_zero' U x).
-Apply Add_covers; Auto with sets.
+Theorem Singleton_atomic :
+ forall (x:U) (A:Ensemble U),
+ In U A x ->
+ covers (Ensemble U) (Power_set_PO U A) (Singleton U x) (Empty_set U).
+intros x A H'.
+rewrite <- (Empty_set_zero' U x).
+apply Add_covers; auto with sets.
Qed.
-Lemma less_than_singleton:
- (X:(Ensemble U)) (x:U) (Strict_Included U X (Singleton U x)) ->
- X ==(Empty_set U).
-Intros X x H'; Try Assumption.
-Red in H'.
-LApply (Singleton_atomic x (Full_set U));
- [Intro H'2; Try Exact H'2 | Apply Full_intro].
-Elim H'; Intros H'0 H'1; Try Exact H'1; Clear H'.
-Elim (setcover_inv (Full_set U) (Empty_set U) (Singleton U x));
- [Intros H'6 H'7; Try Exact H'7 | Idtac]; Auto with sets.
-Elim (H'7 X); [Intro H'5; Try Exact H'5 | Intro H'5 | Idtac | Idtac]; Auto with sets.
-Elim H'1; Auto with sets.
+Lemma less_than_singleton :
+ forall (X:Ensemble U) (x:U),
+ Strict_Included U X (Singleton U x) -> X = Empty_set U.
+intros X x H'; try assumption.
+red in H'.
+lapply (Singleton_atomic x (Full_set U));
+ [ intro H'2; try exact H'2 | apply Full_intro ].
+elim H'; intros H'0 H'1; try exact H'1; clear H'.
+elim (setcover_inv (Full_set U) (Empty_set U) (Singleton U x));
+ [ intros H'6 H'7; try exact H'7 | idtac ]; auto with sets.
+elim (H'7 X); [ intro H'5; try exact H'5 | intro H'5 | idtac | idtac ];
+ auto with sets.
+elim H'1; auto with sets.
Qed.
End Sets_as_an_algebra.
-Hints Resolve incl_soustr_in : sets v62.
-Hints Resolve incl_soustr : sets v62.
-Hints Resolve incl_soustr_add_l : sets v62.
-Hints Resolve incl_soustr_add_r : sets v62.
-Hints Resolve add_soustr_1 add_soustr_2 : sets v62.
-Hints Resolve add_soustr_xy : sets v62.
+Hint Resolve incl_soustr_in: sets v62.
+Hint Resolve incl_soustr: sets v62.
+Hint Resolve incl_soustr_add_l: sets v62.
+Hint Resolve incl_soustr_add_r: sets v62.
+Hint Resolve add_soustr_1 add_soustr_2: sets v62.
+Hint Resolve add_soustr_xy: sets v62. \ No newline at end of file
diff --git a/theories/Sets/Powerset_facts.v b/theories/Sets/Powerset_facts.v
index 3e1837078..c587744a3 100755
--- a/theories/Sets/Powerset_facts.v
+++ b/theories/Sets/Powerset_facts.v
@@ -35,242 +35,234 @@ Require Export Cpo.
Require Export Powerset.
Section Sets_as_an_algebra.
-Variable U: Type.
-Hints Unfold not.
+Variable U : Type.
+Hint Unfold not.
-Theorem Empty_set_zero :
- (X: (Ensemble U)) (Union U (Empty_set U) X) == X.
+Theorem Empty_set_zero : forall X:Ensemble U, Union U (Empty_set U) X = X.
Proof.
-Auto 6 with sets.
+auto 6 with sets.
Qed.
-Hints Resolve Empty_set_zero.
+Hint Resolve Empty_set_zero.
-Theorem Empty_set_zero' :
- (x: U) (Add U (Empty_set U) x) == (Singleton U x).
+Theorem Empty_set_zero' : forall x:U, Add U (Empty_set U) x = Singleton U x.
Proof.
-Unfold 1 Add; Auto with sets.
+unfold Add at 1 in |- *; auto with sets.
Qed.
-Hints Resolve Empty_set_zero'.
+Hint Resolve Empty_set_zero'.
Lemma less_than_empty :
- (X: (Ensemble U)) (Included U X (Empty_set U)) -> X == (Empty_set U).
+ forall X:Ensemble U, Included U X (Empty_set U) -> X = Empty_set U.
Proof.
-Auto with sets.
+auto with sets.
Qed.
-Hints Resolve less_than_empty.
+Hint Resolve less_than_empty.
-Theorem Union_commutative :
- (A,B: (Ensemble U)) (Union U A B) == (Union U B A).
+Theorem Union_commutative : forall A B:Ensemble U, Union U A B = Union U B A.
Proof.
-Auto with sets.
+auto with sets.
Qed.
Theorem Union_associative :
- (A, B, C: (Ensemble U))
- (Union U (Union U A B) C) == (Union U A (Union U B C)).
+ forall A B C:Ensemble U, Union U (Union U A B) C = Union U A (Union U B C).
Proof.
-Auto 9 with sets.
+auto 9 with sets.
Qed.
-Hints Resolve Union_associative.
+Hint Resolve Union_associative.
-Theorem Union_idempotent : (A: (Ensemble U)) (Union U A A) == A.
+Theorem Union_idempotent : forall A:Ensemble U, Union U A A = A.
Proof.
-Auto 7 with sets.
+auto 7 with sets.
Qed.
Lemma Union_absorbs :
- (A, B: (Ensemble U)) (Included U B A) -> (Union U A B) == A.
+ forall A B:Ensemble U, Included U B A -> Union U A B = A.
Proof.
-Auto 7 with sets.
+auto 7 with sets.
Qed.
-Theorem Couple_as_union:
- (x, y: U) (Union U (Singleton U x) (Singleton U y)) == (Couple U x y).
+Theorem Couple_as_union :
+ forall x y:U, Union U (Singleton U x) (Singleton U y) = Couple U x y.
Proof.
-Intros x y; Apply Extensionality_Ensembles; Split; Red.
-Intros x0 H'; Elim H'; (Intros x1 H'0; Elim H'0; Auto with sets).
-Intros x0 H'; Elim H'; Auto with sets.
+intros x y; apply Extensionality_Ensembles; split; red in |- *.
+intros x0 H'; elim H'; (intros x1 H'0; elim H'0; auto with sets).
+intros x0 H'; elim H'; auto with sets.
Qed.
Theorem Triple_as_union :
- (x, y, z: U)
- (Union U (Union U (Singleton U x) (Singleton U y)) (Singleton U z)) ==
- (Triple U x y z).
+ forall x y z:U,
+ Union U (Union U (Singleton U x) (Singleton U y)) (Singleton U z) =
+ Triple U x y z.
Proof.
-Intros x y z; Apply Extensionality_Ensembles; Split; Red.
-Intros x0 H'; Elim H'.
-Intros x1 H'0; Elim H'0; (Intros x2 H'1; Elim H'1; Auto with sets).
-Intros x1 H'0; Elim H'0; Auto with sets.
-Intros x0 H'; Elim H'; Auto with sets.
+intros x y z; apply Extensionality_Ensembles; split; red in |- *.
+intros x0 H'; elim H'.
+intros x1 H'0; elim H'0; (intros x2 H'1; elim H'1; auto with sets).
+intros x1 H'0; elim H'0; auto with sets.
+intros x0 H'; elim H'; auto with sets.
Qed.
-Theorem Triple_as_Couple : (x, y: U) (Couple U x y) == (Triple U x x y).
+Theorem Triple_as_Couple : forall x y:U, Couple U x y = Triple U x x y.
Proof.
-Intros x y.
-Rewrite <- (Couple_as_union x y).
-Rewrite <- (Union_idempotent (Singleton U x)).
-Apply Triple_as_union.
+intros x y.
+rewrite <- (Couple_as_union x y).
+rewrite <- (Union_idempotent (Singleton U x)).
+apply Triple_as_union.
Qed.
Theorem Triple_as_Couple_Singleton :
- (x, y, z: U) (Triple U x y z) == (Union U (Couple U x y) (Singleton U z)).
+ forall x y z:U, Triple U x y z = Union U (Couple U x y) (Singleton U z).
Proof.
-Intros x y z.
-Rewrite <- (Triple_as_union x y z).
-Rewrite <- (Couple_as_union x y); Auto with sets.
+intros x y z.
+rewrite <- (Triple_as_union x y z).
+rewrite <- (Couple_as_union x y); auto with sets.
Qed.
Theorem Intersection_commutative :
- (A,B: (Ensemble U)) (Intersection U A B) == (Intersection U B A).
+ forall A B:Ensemble U, Intersection U A B = Intersection U B A.
Proof.
-Intros A B.
-Apply Extensionality_Ensembles.
-Split; Red; Intros x H'; Elim H'; Auto with sets.
+intros A B.
+apply Extensionality_Ensembles.
+split; red in |- *; intros x H'; elim H'; auto with sets.
Qed.
Theorem Distributivity :
- (A, B, C: (Ensemble U))
- (Intersection U A (Union U B C)) ==
- (Union U (Intersection U A B) (Intersection U A C)).
+ forall A B C:Ensemble U,
+ Intersection U A (Union U B C) =
+ Union U (Intersection U A B) (Intersection U A C).
Proof.
-Intros A B C.
-Apply Extensionality_Ensembles.
-Split; Red; Intros x H'.
-Elim H'.
-Intros x0 H'0 H'1; Generalize H'0.
-Elim H'1; Auto with sets.
-Elim H'; Intros x0 H'0; Elim H'0; Auto with sets.
+intros A B C.
+apply Extensionality_Ensembles.
+split; red in |- *; intros x H'.
+elim H'.
+intros x0 H'0 H'1; generalize H'0.
+elim H'1; auto with sets.
+elim H'; intros x0 H'0; elim H'0; auto with sets.
Qed.
Theorem Distributivity' :
- (A, B, C: (Ensemble U))
- (Union U A (Intersection U B C)) ==
- (Intersection U (Union U A B) (Union U A C)).
+ forall A B C:Ensemble U,
+ Union U A (Intersection U B C) =
+ Intersection U (Union U A B) (Union U A C).
Proof.
-Intros A B C.
-Apply Extensionality_Ensembles.
-Split; Red; Intros x H'.
-Elim H'; Auto with sets.
-Intros x0 H'0; Elim H'0; Auto with sets.
-Elim H'.
-Intros x0 H'0; Elim H'0; Auto with sets.
-Intros x1 H'1 H'2; Try Exact H'2.
-Generalize H'1.
-Elim H'2; Auto with sets.
+intros A B C.
+apply Extensionality_Ensembles.
+split; red in |- *; intros x H'.
+elim H'; auto with sets.
+intros x0 H'0; elim H'0; auto with sets.
+elim H'.
+intros x0 H'0; elim H'0; auto with sets.
+intros x1 H'1 H'2; try exact H'2.
+generalize H'1.
+elim H'2; auto with sets.
Qed.
Theorem Union_add :
- (A, B: (Ensemble U)) (x: U)
- (Add U (Union U A B) x) == (Union U A (Add U B x)).
+ forall (A B:Ensemble U) (x:U), Add U (Union U A B) x = Union U A (Add U B x).
Proof.
-Unfold Add; Auto with sets.
+unfold Add in |- *; auto with sets.
Qed.
-Hints Resolve Union_add.
+Hint Resolve Union_add.
Theorem Non_disjoint_union :
- (X: (Ensemble U)) (x: U) (In U X x) -> (Add U X x) == X.
-Intros X x H'; Unfold Add.
-Apply Extensionality_Ensembles; Red.
-Split; Red; Auto with sets.
-Intros x0 H'0; Elim H'0; Auto with sets.
-Intros t H'1; Elim H'1; Auto with sets.
+ forall (X:Ensemble U) (x:U), In U X x -> Add U X x = X.
+intros X x H'; unfold Add in |- *.
+apply Extensionality_Ensembles; red in |- *.
+split; red in |- *; auto with sets.
+intros x0 H'0; elim H'0; auto with sets.
+intros t H'1; elim H'1; auto with sets.
Qed.
Theorem Non_disjoint_union' :
- (X: (Ensemble U)) (x: U) ~ (In U X x) -> (Subtract U X x) == X.
+ forall (X:Ensemble U) (x:U), ~ In U X x -> Subtract U X x = X.
Proof.
-Intros X x H'; Unfold Subtract.
-Apply Extensionality_Ensembles.
-Split; Red; Auto with sets.
-Intros x0 H'0; Elim H'0; Auto with sets.
-Intros x0 H'0; Apply Setminus_intro; Auto with sets.
-Red; Intro H'1; Elim H'1.
-LApply (Singleton_inv U x x0); Auto with sets.
-Intro H'4; Apply H'; Rewrite H'4; Auto with sets.
+intros X x H'; unfold Subtract in |- *.
+apply Extensionality_Ensembles.
+split; red in |- *; auto with sets.
+intros x0 H'0; elim H'0; auto with sets.
+intros x0 H'0; apply Setminus_intro; auto with sets.
+red in |- *; intro H'1; elim H'1.
+lapply (Singleton_inv U x x0); auto with sets.
+intro H'4; apply H'; rewrite H'4; auto with sets.
Qed.
-Lemma singlx : (x, y: U) (In U (Add U (Empty_set U) x) y) -> x == y.
+Lemma singlx : forall x y:U, In U (Add U (Empty_set U) x) y -> x = y.
Proof.
-Intro x; Rewrite (Empty_set_zero' x); Auto with sets.
+intro x; rewrite (Empty_set_zero' x); auto with sets.
Qed.
-Hints Resolve singlx.
+Hint Resolve singlx.
Lemma incl_add :
- (A, B: (Ensemble U)) (x: U) (Included U A B) ->
- (Included U (Add U A x) (Add U B x)).
+ forall (A B:Ensemble U) (x:U),
+ Included U A B -> Included U (Add U A x) (Add U B x).
Proof.
-Intros A B x H'; Red; Auto with sets.
-Intros x0 H'0.
-LApply (Add_inv U A x x0); Auto with sets.
-Intro H'1; Elim H'1;
- [Intro H'2; Clear H'1 | Intro H'2; Rewrite <- H'2; Clear H'1]; Auto with sets.
+intros A B x H'; red in |- *; auto with sets.
+intros x0 H'0.
+lapply (Add_inv U A x x0); auto with sets.
+intro H'1; elim H'1;
+ [ intro H'2; clear H'1 | intro H'2; rewrite <- H'2; clear H'1 ];
+ auto with sets.
Qed.
-Hints Resolve incl_add.
+Hint Resolve incl_add.
Lemma incl_add_x :
- (A, B: (Ensemble U))
- (x: U) ~ (In U A x) -> (Included U (Add U A x) (Add U B x)) ->
- (Included U A B).
+ forall (A B:Ensemble U) (x:U),
+ ~ In U A x -> Included U (Add U A x) (Add U B x) -> Included U A B.
Proof.
-Unfold Included.
-Intros A B x H' H'0 x0 H'1.
-LApply (H'0 x0); Auto with sets.
-Intro H'2; LApply (Add_inv U B x x0); Auto with sets.
-Intro H'3; Elim H'3;
- [Intro H'4; Try Exact H'4; Clear H'3 | Intro H'4; Clear H'3].
-Absurd (In U A x0); Auto with sets.
-Rewrite <- H'4; Auto with sets.
+unfold Included in |- *.
+intros A B x H' H'0 x0 H'1.
+lapply (H'0 x0); auto with sets.
+intro H'2; lapply (Add_inv U B x x0); auto with sets.
+intro H'3; elim H'3;
+ [ intro H'4; try exact H'4; clear H'3 | intro H'4; clear H'3 ].
+absurd (In U A x0); auto with sets.
+rewrite <- H'4; auto with sets.
Qed.
Lemma Add_commutative :
- (A: (Ensemble U)) (x, y: U) (Add U (Add U A x) y) == (Add U (Add U A y) x).
+ forall (A:Ensemble U) (x y:U), Add U (Add U A x) y = Add U (Add U A y) x.
Proof.
-Intros A x y.
-Unfold Add.
-Rewrite (Union_associative A (Singleton U x) (Singleton U y)).
-Rewrite (Union_commutative (Singleton U x) (Singleton U y)).
-Rewrite <- (Union_associative A (Singleton U y) (Singleton U x)); Auto with sets.
+intros A x y.
+unfold Add in |- *.
+rewrite (Union_associative A (Singleton U x) (Singleton U y)).
+rewrite (Union_commutative (Singleton U x) (Singleton U y)).
+rewrite <- (Union_associative A (Singleton U y) (Singleton U x));
+ auto with sets.
Qed.
Lemma Add_commutative' :
- (A: (Ensemble U)) (x, y, z: U)
- (Add U (Add U (Add U A x) y) z) == (Add U (Add U (Add U A z) x) y).
+ forall (A:Ensemble U) (x y z:U),
+ Add U (Add U (Add U A x) y) z = Add U (Add U (Add U A z) x) y.
Proof.
-Intros A x y z.
-Rewrite (Add_commutative (Add U A x) y z).
-Rewrite (Add_commutative A x z); Auto with sets.
+intros A x y z.
+rewrite (Add_commutative (Add U A x) y z).
+rewrite (Add_commutative A x z); auto with sets.
Qed.
Lemma Add_distributes :
- (A, B: (Ensemble U)) (x, y: U) (Included U B A) ->
- (Add U (Add U A x) y) == (Union U (Add U A x) (Add U B y)).
+ forall (A B:Ensemble U) (x y:U),
+ Included U B A -> Add U (Add U A x) y = Union U (Add U A x) (Add U B y).
Proof.
-Intros A B x y H'; Try Assumption.
-Rewrite <- (Union_add (Add U A x) B y).
-Unfold 4 Add.
-Rewrite (Union_commutative A (Singleton U x)).
-Rewrite Union_associative.
-Rewrite (Union_absorbs A B H').
-Rewrite (Union_commutative (Singleton U x) A).
-Auto with sets.
+intros A B x y H'; try assumption.
+rewrite <- (Union_add (Add U A x) B y).
+unfold Add at 4 in |- *.
+rewrite (Union_commutative A (Singleton U x)).
+rewrite Union_associative.
+rewrite (Union_absorbs A B H').
+rewrite (Union_commutative (Singleton U x) A).
+auto with sets.
Qed.
Lemma setcover_intro :
- (U: Type)
- (A: (Ensemble U))
- (x, y: (Ensemble U))
- (Strict_Included U x y) ->
- ~ (EXT z | (Strict_Included U x z)
- /\ (Strict_Included U z y)) ->
- (covers (Ensemble U) (Power_set_PO U A) y x).
+ forall (U:Type) (A x y:Ensemble U),
+ Strict_Included U x y ->
+ ~ ( exists z : _ | Strict_Included U x z /\ Strict_Included U z y) ->
+ covers (Ensemble U) (Power_set_PO U A) y x.
Proof.
-Intros; Apply Definition_of_covers; Auto with sets.
+intros; apply Definition_of_covers; auto with sets.
Qed.
-Hints Resolve setcover_intro.
+Hint Resolve setcover_intro.
End Sets_as_an_algebra.
-Hints Resolve Empty_set_zero Empty_set_zero' Union_associative Union_add
- singlx incl_add : sets v62.
-
+Hint Resolve Empty_set_zero Empty_set_zero' Union_associative Union_add
+ singlx incl_add: sets v62.
diff --git a/theories/Sets/Relations_1.v b/theories/Sets/Relations_1.v
index 74c031726..16a00740d 100755
--- a/theories/Sets/Relations_1.v
+++ b/theories/Sets/Relations_1.v
@@ -27,41 +27,41 @@
(*i $Id$ i*)
Section Relations_1.
- Variable U: Type.
+ Variable U : Type.
- Definition Relation := U -> U -> Prop.
- Variable R: Relation.
+ Definition Relation := U -> U -> Prop.
+ Variable R : Relation.
- Definition Reflexive : Prop := (x: U) (R x x).
+ Definition Reflexive : Prop := forall x:U, R x x.
- Definition Transitive : Prop := (x,y,z: U) (R x y) -> (R y z) -> (R x z).
+ Definition Transitive : Prop := forall x y z:U, R x y -> R y z -> R x z.
- Definition Symmetric : Prop := (x,y: U) (R x y) -> (R y x).
+ Definition Symmetric : Prop := forall x y:U, R x y -> R y x.
- Definition Antisymmetric : Prop :=
- (x: U) (y: U) (R x y) -> (R y x) -> x == y.
+ Definition Antisymmetric : Prop := forall x y:U, R x y -> R y x -> x = y.
- Definition contains : Relation -> Relation -> Prop :=
- [R,R': Relation] (x: U) (y: U) (R' x y) -> (R x y).
+ Definition contains (R R':Relation) : Prop :=
+ forall x y:U, R' x y -> R x y.
- Definition same_relation : Relation -> Relation -> Prop :=
- [R,R': Relation] (contains R R') /\ (contains R' R).
+ Definition same_relation (R R':Relation) : Prop :=
+ contains R R' /\ contains R' R.
Inductive Preorder : Prop :=
- Definition_of_preorder: Reflexive -> Transitive -> Preorder.
+ Definition_of_preorder : Reflexive -> Transitive -> Preorder.
Inductive Order : Prop :=
- Definition_of_order: Reflexive -> Transitive -> Antisymmetric -> Order.
+ Definition_of_order :
+ Reflexive -> Transitive -> Antisymmetric -> Order.
Inductive Equivalence : Prop :=
- Definition_of_equivalence:
- Reflexive -> Transitive -> Symmetric -> Equivalence.
+ Definition_of_equivalence :
+ Reflexive -> Transitive -> Symmetric -> Equivalence.
Inductive PER : Prop :=
- Definition_of_PER: Symmetric -> Transitive -> PER.
+ Definition_of_PER : Symmetric -> Transitive -> PER.
End Relations_1.
-Hints Unfold Reflexive Transitive Antisymmetric Symmetric contains
- same_relation : sets v62.
-Hints Resolve Definition_of_preorder Definition_of_order
- Definition_of_equivalence Definition_of_PER : sets v62.
+Hint Unfold Reflexive Transitive Antisymmetric Symmetric contains
+ same_relation: sets v62.
+Hint Resolve Definition_of_preorder Definition_of_order
+ Definition_of_equivalence Definition_of_PER: sets v62. \ No newline at end of file
diff --git a/theories/Sets/Relations_1_facts.v b/theories/Sets/Relations_1_facts.v
index b490fa7a0..61557aff7 100755
--- a/theories/Sets/Relations_1_facts.v
+++ b/theories/Sets/Relations_1_facts.v
@@ -28,82 +28,85 @@
Require Export Relations_1.
-Definition Complement : (U: Type) (Relation U) -> (Relation U) :=
- [U: Type] [R: (Relation U)] [x,y: U] ~ (R x y).
+Definition Complement (U:Type) (R:Relation U) : Relation U :=
+ fun x y:U => ~ R x y.
-Theorem Rsym_imp_notRsym: (U: Type) (R: (Relation U)) (Symmetric U R) ->
- (Symmetric U (Complement U R)).
+Theorem Rsym_imp_notRsym :
+ forall (U:Type) (R:Relation U),
+ Symmetric U R -> Symmetric U (Complement U R).
Proof.
-Unfold Symmetric Complement.
-Intros U R H' x y H'0; Red; Intro H'1; Apply H'0; Auto with sets.
+unfold Symmetric, Complement in |- *.
+intros U R H' x y H'0; red in |- *; intro H'1; apply H'0; auto with sets.
Qed.
Theorem Equiv_from_preorder :
- (U: Type) (R: (Relation U)) (Preorder U R) ->
- (Equivalence U [x,y: U] (R x y) /\ (R y x)).
+ forall (U:Type) (R:Relation U),
+ Preorder U R -> Equivalence U (fun x y:U => R x y /\ R y x).
Proof.
-Intros U R H'; Elim H'; Intros H'0 H'1.
-Apply Definition_of_equivalence.
-Red in H'0; Auto 10 with sets.
-2:Red; Intros x y h; Elim h; Intros H'3 H'4; Auto 10 with sets.
-Red in H'1; Red; Auto 10 with sets.
-Intros x y z h; Elim h; Intros H'3 H'4; Clear h.
-Intro h; Elim h; Intros H'5 H'6; Clear h.
-Split; Apply H'1 with y; Auto 10 with sets.
+intros U R H'; elim H'; intros H'0 H'1.
+apply Definition_of_equivalence.
+red in H'0; auto 10 with sets.
+2: red in |- *; intros x y h; elim h; intros H'3 H'4; auto 10 with sets.
+red in H'1; red in |- *; auto 10 with sets.
+intros x y z h; elim h; intros H'3 H'4; clear h.
+intro h; elim h; intros H'5 H'6; clear h.
+split; apply H'1 with y; auto 10 with sets.
Qed.
-Hints Resolve Equiv_from_preorder.
+Hint Resolve Equiv_from_preorder.
Theorem Equiv_from_order :
- (U: Type) (R: (Relation U)) (Order U R) ->
- (Equivalence U [x,y: U] (R x y) /\ (R y x)).
+ forall (U:Type) (R:Relation U),
+ Order U R -> Equivalence U (fun x y:U => R x y /\ R y x).
Proof.
-Intros U R H'; Elim H'; Auto 10 with sets.
+intros U R H'; elim H'; auto 10 with sets.
Qed.
-Hints Resolve Equiv_from_order.
+Hint Resolve Equiv_from_order.
Theorem contains_is_preorder :
- (U: Type) (Preorder (Relation U) (contains U)).
+ forall U:Type, Preorder (Relation U) (contains U).
Proof.
-Auto 10 with sets.
+auto 10 with sets.
Qed.
-Hints Resolve contains_is_preorder.
+Hint Resolve contains_is_preorder.
Theorem same_relation_is_equivalence :
- (U: Type) (Equivalence (Relation U) (same_relation U)).
+ forall U:Type, Equivalence (Relation U) (same_relation U).
Proof.
-Unfold 1 same_relation; Auto 10 with sets.
+unfold same_relation at 1 in |- *; auto 10 with sets.
Qed.
-Hints Resolve same_relation_is_equivalence.
+Hint Resolve same_relation_is_equivalence.
-Theorem cong_reflexive_same_relation:
- (U:Type) (R, R':(Relation U)) (same_relation U R R') -> (Reflexive U R) ->
- (Reflexive U R').
+Theorem cong_reflexive_same_relation :
+ forall (U:Type) (R R':Relation U),
+ same_relation U R R' -> Reflexive U R -> Reflexive U R'.
Proof.
-Unfold same_relation; Intuition.
+unfold same_relation in |- *; intuition.
Qed.
-Theorem cong_symmetric_same_relation:
- (U:Type) (R, R':(Relation U)) (same_relation U R R') -> (Symmetric U R) ->
- (Symmetric U R').
+Theorem cong_symmetric_same_relation :
+ forall (U:Type) (R R':Relation U),
+ same_relation U R R' -> Symmetric U R -> Symmetric U R'.
Proof.
- Compute;Intros;Elim H;Intros;Clear H;Apply (H3 y x (H0 x y (H2 x y H1))).
+ compute in |- *; intros; elim H; intros; clear H;
+ apply (H3 y x (H0 x y (H2 x y H1))).
(*Intuition.*)
Qed.
-Theorem cong_antisymmetric_same_relation:
- (U:Type) (R, R':(Relation U)) (same_relation U R R') ->
- (Antisymmetric U R) -> (Antisymmetric U R').
+Theorem cong_antisymmetric_same_relation :
+ forall (U:Type) (R R':Relation U),
+ same_relation U R R' -> Antisymmetric U R -> Antisymmetric U R'.
Proof.
- Compute;Intros;Elim H;Intros;Clear H;Apply (H0 x y (H3 x y H1) (H3 y x H2)).
+ compute in |- *; intros; elim H; intros; clear H;
+ apply (H0 x y (H3 x y H1) (H3 y x H2)).
(*Intuition.*)
Qed.
-Theorem cong_transitive_same_relation:
- (U:Type) (R, R':(Relation U)) (same_relation U R R') -> (Transitive U R) ->
- (Transitive U R').
+Theorem cong_transitive_same_relation :
+ forall (U:Type) (R R':Relation U),
+ same_relation U R R' -> Transitive U R -> Transitive U R'.
Proof.
-Intros U R R' H' H'0; Red.
-Elim H'.
-Intros H'1 H'2 x y z H'3 H'4; Apply H'2.
-Apply H'0 with y; Auto with sets.
-Qed.
+intros U R R' H' H'0; red in |- *.
+elim H'.
+intros H'1 H'2 x y z H'3 H'4; apply H'2.
+apply H'0 with y; auto with sets.
+Qed. \ No newline at end of file
diff --git a/theories/Sets/Relations_2.v b/theories/Sets/Relations_2.v
index 65363d816..d7ee68b66 100755
--- a/theories/Sets/Relations_2.v
+++ b/theories/Sets/Relations_2.v
@@ -29,28 +29,28 @@
Require Export Relations_1.
Section Relations_2.
-Variable U: Type.
-Variable R: (Relation U).
+Variable U : Type.
+Variable R : Relation U.
-Inductive Rstar : (Relation U) :=
- Rstar_0: (x: U) (Rstar x x)
- | Rstar_n: (x, y, z: U) (R x y) -> (Rstar y z) -> (Rstar x z).
+Inductive Rstar : Relation U :=
+ | Rstar_0 : forall x:U, Rstar x x
+ | Rstar_n : forall x y z:U, R x y -> Rstar y z -> Rstar x z.
-Inductive Rstar1 : (Relation U) :=
- Rstar1_0: (x: U) (Rstar1 x x)
- | Rstar1_1: (x: U) (y: U) (R x y) -> (Rstar1 x y)
- | Rstar1_n: (x, y, z: U) (Rstar1 x y) -> (Rstar1 y z) -> (Rstar1 x z).
+Inductive Rstar1 : Relation U :=
+ | Rstar1_0 : forall x:U, Rstar1 x x
+ | Rstar1_1 : forall x y:U, R x y -> Rstar1 x y
+ | Rstar1_n : forall x y z:U, Rstar1 x y -> Rstar1 y z -> Rstar1 x z.
-Inductive Rplus : (Relation U) :=
- Rplus_0: (x, y: U) (R x y) -> (Rplus x y)
- | Rplus_n: (x, y, z: U) (R x y) -> (Rplus y z) -> (Rplus x z).
+Inductive Rplus : Relation U :=
+ | Rplus_0 : forall x y:U, R x y -> Rplus x y
+ | Rplus_n : forall x y z:U, R x y -> Rplus y z -> Rplus x z.
Definition Strongly_confluent : Prop :=
- (x, a, b: U) (R x a) -> (R x b) -> (exT U [z: U] (R a z) /\ (R b z)).
+ forall x a b:U, R x a -> R x b -> ex (fun z:U => R a z /\ R b z).
End Relations_2.
-Hints Resolve Rstar_0 : sets v62.
-Hints Resolve Rstar1_0 : sets v62.
-Hints Resolve Rstar1_1 : sets v62.
-Hints Resolve Rplus_0 : sets v62.
+Hint Resolve Rstar_0: sets v62.
+Hint Resolve Rstar1_0: sets v62.
+Hint Resolve Rstar1_1: sets v62.
+Hint Resolve Rplus_0: sets v62. \ No newline at end of file
diff --git a/theories/Sets/Relations_2_facts.v b/theories/Sets/Relations_2_facts.v
index 588b7f431..4fda8d8e9 100755
--- a/theories/Sets/Relations_2_facts.v
+++ b/theories/Sets/Relations_2_facts.v
@@ -30,122 +30,124 @@ Require Export Relations_1.
Require Export Relations_1_facts.
Require Export Relations_2.
-Theorem Rstar_reflexive :
- (U: Type) (R: (Relation U)) (Reflexive U (Rstar U R)).
+Theorem Rstar_reflexive :
+ forall (U:Type) (R:Relation U), Reflexive U (Rstar U R).
Proof.
-Auto with sets.
+auto with sets.
Qed.
Theorem Rplus_contains_R :
- (U: Type) (R: (Relation U)) (contains U (Rplus U R) R).
+ forall (U:Type) (R:Relation U), contains U (Rplus U R) R.
Proof.
-Auto with sets.
+auto with sets.
Qed.
Theorem Rstar_contains_R :
- (U: Type) (R: (Relation U)) (contains U (Rstar U R) R).
+ forall (U:Type) (R:Relation U), contains U (Rstar U R) R.
Proof.
-Intros U R; Red; Intros x y H'; Apply Rstar_n with y; Auto with sets.
+intros U R; red in |- *; intros x y H'; apply Rstar_n with y; auto with sets.
Qed.
Theorem Rstar_contains_Rplus :
- (U: Type) (R: (Relation U)) (contains U (Rstar U R) (Rplus U R)).
+ forall (U:Type) (R:Relation U), contains U (Rstar U R) (Rplus U R).
Proof.
-Intros U R; Red.
-Intros x y H'; Elim H'.
-Generalize Rstar_contains_R; Intro T; Red in T; Auto with sets.
-Intros x0 y0 z H'0 H'1 H'2; Apply Rstar_n with y0; Auto with sets.
+intros U R; red in |- *.
+intros x y H'; elim H'.
+generalize Rstar_contains_R; intro T; red in T; auto with sets.
+intros x0 y0 z H'0 H'1 H'2; apply Rstar_n with y0; auto with sets.
Qed.
Theorem Rstar_transitive :
- (U: Type) (R: (Relation U)) (Transitive U (Rstar U R)).
+ forall (U:Type) (R:Relation U), Transitive U (Rstar U R).
Proof.
-Intros U R; Red.
-Intros x y z H'; Elim H'; Auto with sets.
-Intros x0 y0 z0 H'0 H'1 H'2 H'3; Apply Rstar_n with y0; Auto with sets.
+intros U R; red in |- *.
+intros x y z H'; elim H'; auto with sets.
+intros x0 y0 z0 H'0 H'1 H'2 H'3; apply Rstar_n with y0; auto with sets.
Qed.
Theorem Rstar_cases :
- (U: Type) (R: (Relation U)) (x, y: U) (Rstar U R x y) ->
- x == y \/ (EXT u | (R x u) /\ (Rstar U R u y)).
+ forall (U:Type) (R:Relation U) (x y:U),
+ Rstar U R x y -> x = y \/ ( exists u : _ | R x u /\ Rstar U R u y).
Proof.
-Intros U R x y H'; Elim H'; Auto with sets.
-Intros x0 y0 z H'0 H'1 H'2; Right; Exists y0; Auto with sets.
+intros U R x y H'; elim H'; auto with sets.
+intros x0 y0 z H'0 H'1 H'2; right; exists y0; auto with sets.
Qed.
Theorem Rstar_equiv_Rstar1 :
- (U: Type) (R: (Relation U)) (same_relation U (Rstar U R) (Rstar1 U R)).
+ forall (U:Type) (R:Relation U), same_relation U (Rstar U R) (Rstar1 U R).
Proof.
-Generalize Rstar_contains_R; Intro T; Red in T.
-Intros U R; Unfold same_relation contains.
-Split; Intros x y H'; Elim H'; Auto with sets.
-Generalize Rstar_transitive; Intro T1; Red in T1.
-Intros x0 y0 z H'0 H'1 H'2 H'3; Apply T1 with y0; Auto with sets.
-Intros x0 y0 z H'0 H'1 H'2; Apply Rstar1_n with y0; Auto with sets.
+generalize Rstar_contains_R; intro T; red in T.
+intros U R; unfold same_relation, contains in |- *.
+split; intros x y H'; elim H'; auto with sets.
+generalize Rstar_transitive; intro T1; red in T1.
+intros x0 y0 z H'0 H'1 H'2 H'3; apply T1 with y0; auto with sets.
+intros x0 y0 z H'0 H'1 H'2; apply Rstar1_n with y0; auto with sets.
Qed.
Theorem Rsym_imp_Rstarsym :
- (U: Type) (R: (Relation U)) (Symmetric U R) -> (Symmetric U (Rstar U R)).
+ forall (U:Type) (R:Relation U), Symmetric U R -> Symmetric U (Rstar U R).
Proof.
-Intros U R H'; Red.
-Intros x y H'0; Elim H'0; Auto with sets.
-Intros x0 y0 z H'1 H'2 H'3.
-Generalize Rstar_transitive; Intro T1; Red in T1.
-Apply T1 with y0; Auto with sets.
-Apply Rstar_n with x0; Auto with sets.
+intros U R H'; red in |- *.
+intros x y H'0; elim H'0; auto with sets.
+intros x0 y0 z H'1 H'2 H'3.
+generalize Rstar_transitive; intro T1; red in T1.
+apply T1 with y0; auto with sets.
+apply Rstar_n with x0; auto with sets.
Qed.
Theorem Sstar_contains_Rstar :
- (U: Type) (R, S: (Relation U)) (contains U (Rstar U S) R) ->
- (contains U (Rstar U S) (Rstar U R)).
+ forall (U:Type) (R S:Relation U),
+ contains U (Rstar U S) R -> contains U (Rstar U S) (Rstar U R).
Proof.
-Unfold contains.
-Intros U R S H' x y H'0; Elim H'0; Auto with sets.
-Generalize Rstar_transitive; Intro T1; Red in T1.
-Intros x0 y0 z H'1 H'2 H'3; Apply T1 with y0; Auto with sets.
+unfold contains in |- *.
+intros U R S H' x y H'0; elim H'0; auto with sets.
+generalize Rstar_transitive; intro T1; red in T1.
+intros x0 y0 z H'1 H'2 H'3; apply T1 with y0; auto with sets.
Qed.
Theorem star_monotone :
- (U: Type) (R, S: (Relation U)) (contains U S R) ->
- (contains U (Rstar U S) (Rstar U R)).
+ forall (U:Type) (R S:Relation U),
+ contains U S R -> contains U (Rstar U S) (Rstar U R).
Proof.
-Intros U R S H'.
-Apply Sstar_contains_Rstar; Auto with sets.
-Generalize (Rstar_contains_R U S); Auto with sets.
+intros U R S H'.
+apply Sstar_contains_Rstar; auto with sets.
+generalize (Rstar_contains_R U S); auto with sets.
Qed.
Theorem RstarRplus_RRstar :
- (U: Type) (R: (Relation U)) (x, y, z: U)
- (Rstar U R x y) -> (Rplus U R y z) ->
- (EXT u | (R x u) /\ (Rstar U R u z)).
+ forall (U:Type) (R:Relation U) (x y z:U),
+ Rstar U R x y -> Rplus U R y z -> exists u : _ | R x u /\ Rstar U R u z.
Proof.
-Generalize Rstar_contains_Rplus; Intro T; Red in T.
-Generalize Rstar_transitive; Intro T1; Red in T1.
-Intros U R x y z H'; Elim H'.
-Intros x0 H'0; Elim H'0.
-Intros x1 y0 H'1; Exists y0; Auto with sets.
-Intros x1 y0 z0 H'1 H'2 H'3; Exists y0; Auto with sets.
-Intros x0 y0 z0 H'0 H'1 H'2 H'3; Exists y0.
-Split; [Try Assumption | Idtac].
-Apply T1 with z0; Auto with sets.
+generalize Rstar_contains_Rplus; intro T; red in T.
+generalize Rstar_transitive; intro T1; red in T1.
+intros U R x y z H'; elim H'.
+intros x0 H'0; elim H'0.
+intros x1 y0 H'1; exists y0; auto with sets.
+intros x1 y0 z0 H'1 H'2 H'3; exists y0; auto with sets.
+intros x0 y0 z0 H'0 H'1 H'2 H'3; exists y0.
+split; [ try assumption | idtac ].
+apply T1 with z0; auto with sets.
Qed.
-Theorem Lemma1 :
- (U: Type) (R: (Relation U)) (Strongly_confluent U R) ->
- (x, b: U) (Rstar U R x b) ->
- (a: U) (R x a) -> (EXT z | (Rstar U R a z) /\ (R b z)).
+Theorem Lemma1 :
+ forall (U:Type) (R:Relation U),
+ Strongly_confluent U R ->
+ forall x b:U,
+ Rstar U R x b ->
+ forall a:U, R x a -> exists z : _ | Rstar U R a z /\ R b z.
Proof.
-Intros U R H' x b H'0; Elim H'0.
-Intros x0 a H'1; Exists a; Auto with sets.
-Intros x0 y z H'1 H'2 H'3 a H'4.
-Red in H'.
-Specialize 3 H' with x := x0 a := a b := y; Intro H'7; LApply H'7;
- [Intro H'8; LApply H'8;
- [Intro H'9; Try Exact H'9; Clear H'8 H'7 | Clear H'8 H'7] | Clear H'7]; Auto with sets.
-Elim H'9.
-Intros t H'5; Elim H'5; Intros H'6 H'7; Try Exact H'6; Clear H'5.
-Elim (H'3 t); Auto with sets.
-Intros z1 H'5; Elim H'5; Intros H'8 H'10; Try Exact H'8; Clear H'5.
-Exists z1; Split; [Idtac | Assumption].
-Apply Rstar_n with t; Auto with sets.
-Qed.
+intros U R H' x b H'0; elim H'0.
+intros x0 a H'1; exists a; auto with sets.
+intros x0 y z H'1 H'2 H'3 a H'4.
+red in H'.
+specialize 3H' with (x := x0) (a := a) (b := y); intro H'7; lapply H'7;
+ [ intro H'8; lapply H'8;
+ [ intro H'9; try exact H'9; clear H'8 H'7 | clear H'8 H'7 ]
+ | clear H'7 ]; auto with sets.
+elim H'9.
+intros t H'5; elim H'5; intros H'6 H'7; try exact H'6; clear H'5.
+elim (H'3 t); auto with sets.
+intros z1 H'5; elim H'5; intros H'8 H'10; try exact H'8; clear H'5.
+exists z1; split; [ idtac | assumption ].
+apply Rstar_n with t; auto with sets.
+Qed. \ No newline at end of file
diff --git a/theories/Sets/Relations_3.v b/theories/Sets/Relations_3.v
index 90c055775..1fe689002 100755
--- a/theories/Sets/Relations_3.v
+++ b/theories/Sets/Relations_3.v
@@ -30,34 +30,33 @@ Require Export Relations_1.
Require Export Relations_2.
Section Relations_3.
- Variable U: Type.
- Variable R: (Relation U).
+ Variable U : Type.
+ Variable R : Relation U.
- Definition coherent : U -> U -> Prop :=
- [x,y: U] (EXT z | (Rstar U R x z) /\ (Rstar U R y z)).
+ Definition coherent (x y:U) : Prop :=
+ exists z : _ | Rstar U R x z /\ Rstar U R y z.
- Definition locally_confluent : U -> Prop :=
- [x: U] (y,z: U) (R x y) -> (R x z) -> (coherent y z).
+ Definition locally_confluent (x:U) : Prop :=
+ forall y z:U, R x y -> R x z -> coherent y z.
- Definition Locally_confluent : Prop := (x: U) (locally_confluent x).
+ Definition Locally_confluent : Prop := forall x:U, locally_confluent x.
- Definition confluent : U -> Prop :=
- [x: U] (y,z: U) (Rstar U R x y) -> (Rstar U R x z) -> (coherent y z).
+ Definition confluent (x:U) : Prop :=
+ forall y z:U, Rstar U R x y -> Rstar U R x z -> coherent y z.
- Definition Confluent : Prop := (x: U) (confluent x).
+ Definition Confluent : Prop := forall x:U, confluent x.
- Inductive noetherian : U -> Prop :=
- definition_of_noetherian:
- (x: U) ((y: U) (R x y) -> (noetherian y)) -> (noetherian x).
+ Inductive noetherian : U -> Prop :=
+ definition_of_noetherian :
+ forall x:U, (forall y:U, R x y -> noetherian y) -> noetherian x.
- Definition Noetherian : Prop := (x: U) (noetherian x).
+ Definition Noetherian : Prop := forall x:U, noetherian x.
End Relations_3.
-Hints Unfold coherent : sets v62.
-Hints Unfold locally_confluent : sets v62.
-Hints Unfold confluent : sets v62.
-Hints Unfold Confluent : sets v62.
-Hints Resolve definition_of_noetherian : sets v62.
-Hints Unfold Noetherian : sets v62.
-
+Hint Unfold coherent: sets v62.
+Hint Unfold locally_confluent: sets v62.
+Hint Unfold confluent: sets v62.
+Hint Unfold Confluent: sets v62.
+Hint Resolve definition_of_noetherian: sets v62.
+Hint Unfold Noetherian: sets v62.
diff --git a/theories/Sets/Relations_3_facts.v b/theories/Sets/Relations_3_facts.v
index a57487d1e..5b1ce9e31 100755
--- a/theories/Sets/Relations_3_facts.v
+++ b/theories/Sets/Relations_3_facts.v
@@ -33,125 +33,139 @@ Require Export Relations_2_facts.
Require Export Relations_3.
Theorem Rstar_imp_coherent :
- (U: Type) (R: (Relation U)) (x: U) (y: U) (Rstar U R x y) ->
- (coherent U R x y).
+ forall (U:Type) (R:Relation U) (x y:U), Rstar U R x y -> coherent U R x y.
Proof.
-Intros U R x y H'; Red.
-Exists y; Auto with sets.
+intros U R x y H'; red in |- *.
+exists y; auto with sets.
Qed.
-Hints Resolve Rstar_imp_coherent.
+Hint Resolve Rstar_imp_coherent.
Theorem coherent_symmetric :
- (U: Type) (R: (Relation U)) (Symmetric U (coherent U R)).
+ forall (U:Type) (R:Relation U), Symmetric U (coherent U R).
Proof.
-Unfold 1 coherent.
-Intros U R; Red.
-Intros x y H'; Elim H'.
-Intros z H'0; Exists z; Tauto.
+unfold coherent at 1 in |- *.
+intros U R; red in |- *.
+intros x y H'; elim H'.
+intros z H'0; exists z; tauto.
Qed.
Theorem Strong_confluence :
- (U: Type) (R: (Relation U)) (Strongly_confluent U R) -> (Confluent U R).
+ forall (U:Type) (R:Relation U), Strongly_confluent U R -> Confluent U R.
Proof.
-Intros U R H'; Red.
-Intro x; Red; Intros a b H'0.
-Unfold 1 coherent.
-Generalize b; Clear b.
-Elim H'0; Clear H'0.
-Intros x0 b H'1; Exists b; Auto with sets.
-Intros x0 y z H'1 H'2 H'3 b H'4.
-Generalize (Lemma1 U R); Intro h; LApply h;
- [Intro H'0; Generalize (H'0 x0 b); Intro h0; LApply h0;
- [Intro H'5; Generalize (H'5 y); Intro h1; LApply h1;
- [Intro h2; Elim h2; Intros z0 h3; Elim h3; Intros H'6 H'7;
- Clear h h0 h1 h2 h3 | Clear h h0 h1] | Clear h h0] | Clear h]; Auto with sets.
-Generalize (H'3 z0); Intro h; LApply h;
- [Intro h0; Elim h0; Intros z1 h1; Elim h1; Intros H'8 H'9; Clear h h0 h1 |
- Clear h]; Auto with sets.
-Exists z1; Split; Auto with sets.
-Apply Rstar_n with z0; Auto with sets.
+intros U R H'; red in |- *.
+intro x; red in |- *; intros a b H'0.
+unfold coherent at 1 in |- *.
+generalize b; clear b.
+elim H'0; clear H'0.
+intros x0 b H'1; exists b; auto with sets.
+intros x0 y z H'1 H'2 H'3 b H'4.
+generalize (Lemma1 U R); intro h; lapply h;
+ [ intro H'0; generalize (H'0 x0 b); intro h0; lapply h0;
+ [ intro H'5; generalize (H'5 y); intro h1; lapply h1;
+ [ intro h2; elim h2; intros z0 h3; elim h3; intros H'6 H'7;
+ clear h h0 h1 h2 h3
+ | clear h h0 h1 ]
+ | clear h h0 ]
+ | clear h ]; auto with sets.
+generalize (H'3 z0); intro h; lapply h;
+ [ intro h0; elim h0; intros z1 h1; elim h1; intros H'8 H'9; clear h h0 h1
+ | clear h ]; auto with sets.
+exists z1; split; auto with sets.
+apply Rstar_n with z0; auto with sets.
Qed.
Theorem Strong_confluence_direct :
- (U: Type) (R: (Relation U)) (Strongly_confluent U R) -> (Confluent U R).
+ forall (U:Type) (R:Relation U), Strongly_confluent U R -> Confluent U R.
Proof.
-Intros U R H'; Red.
-Intro x; Red; Intros a b H'0.
-Unfold 1 coherent.
-Generalize b; Clear b.
-Elim H'0; Clear H'0.
-Intros x0 b H'1; Exists b; Auto with sets.
-Intros x0 y z H'1 H'2 H'3 b H'4.
-Cut (exT U [t: U] (Rstar U R y t) /\ (R b t)).
-Intro h; Elim h; Intros t h0; Elim h0; Intros H'0 H'5; Clear h h0.
-Generalize (H'3 t); Intro h; LApply h;
- [Intro h0; Elim h0; Intros z0 h1; Elim h1; Intros H'6 H'7; Clear h h0 h1 |
- Clear h]; Auto with sets.
-Exists z0; Split; [Assumption | Idtac].
-Apply Rstar_n with t; Auto with sets.
-Generalize H'1; Generalize y; Clear H'1.
-Elim H'4.
-Intros x1 y0 H'0; Exists y0; Auto with sets.
-Intros x1 y0 z0 H'0 H'1 H'5 y1 H'6.
-Red in H'.
-Generalize (H' x1 y0 y1); Intro h; LApply h;
- [Intro H'7; LApply H'7;
- [Intro h0; Elim h0; Intros z1 h1; Elim h1; Intros H'8 H'9; Clear h H'7 h0 h1 |
- Clear h] | Clear h]; Auto with sets.
-Generalize (H'5 z1); Intro h; LApply h;
- [Intro h0; Elim h0; Intros t h1; Elim h1; Intros H'7 H'10; Clear h h0 h1 |
- Clear h]; Auto with sets.
-Exists t; Split; Auto with sets.
-Apply Rstar_n with z1; Auto with sets.
+intros U R H'; red in |- *.
+intro x; red in |- *; intros a b H'0.
+unfold coherent at 1 in |- *.
+generalize b; clear b.
+elim H'0; clear H'0.
+intros x0 b H'1; exists b; auto with sets.
+intros x0 y z H'1 H'2 H'3 b H'4.
+cut (ex (fun t:U => Rstar U R y t /\ R b t)).
+intro h; elim h; intros t h0; elim h0; intros H'0 H'5; clear h h0.
+generalize (H'3 t); intro h; lapply h;
+ [ intro h0; elim h0; intros z0 h1; elim h1; intros H'6 H'7; clear h h0 h1
+ | clear h ]; auto with sets.
+exists z0; split; [ assumption | idtac ].
+apply Rstar_n with t; auto with sets.
+generalize H'1; generalize y; clear H'1.
+elim H'4.
+intros x1 y0 H'0; exists y0; auto with sets.
+intros x1 y0 z0 H'0 H'1 H'5 y1 H'6.
+red in H'.
+generalize (H' x1 y0 y1); intro h; lapply h;
+ [ intro H'7; lapply H'7;
+ [ intro h0; elim h0; intros z1 h1; elim h1; intros H'8 H'9;
+ clear h H'7 h0 h1
+ | clear h ]
+ | clear h ]; auto with sets.
+generalize (H'5 z1); intro h; lapply h;
+ [ intro h0; elim h0; intros t h1; elim h1; intros H'7 H'10; clear h h0 h1
+ | clear h ]; auto with sets.
+exists t; split; auto with sets.
+apply Rstar_n with z1; auto with sets.
Qed.
Theorem Noetherian_contains_Noetherian :
- (U: Type) (R, R': (Relation U)) (Noetherian U R) -> (contains U R R') ->
- (Noetherian U R').
+ forall (U:Type) (R R':Relation U),
+ Noetherian U R -> contains U R R' -> Noetherian U R'.
Proof.
-Unfold 2 Noetherian.
-Intros U R R' H' H'0 x.
-Elim (H' x); Auto with sets.
+unfold Noetherian at 2 in |- *.
+intros U R R' H' H'0 x.
+elim (H' x); auto with sets.
Qed.
Theorem Newman :
- (U: Type) (R: (Relation U)) (Noetherian U R) -> (Locally_confluent U R) ->
- (Confluent U R).
+ forall (U:Type) (R:Relation U),
+ Noetherian U R -> Locally_confluent U R -> Confluent U R.
Proof.
-Intros U R H' H'0; Red; Intro x.
-Elim (H' x); Unfold confluent.
-Intros x0 H'1 H'2 y z H'3 H'4.
-Generalize (Rstar_cases U R x0 y); Intro h; LApply h;
- [Intro h0; Elim h0;
- [Clear h h0; Intro h1 |
- Intro h1; Elim h1; Intros u h2; Elim h2; Intros H'5 H'6; Clear h h0 h1 h2] |
- Clear h]; Auto with sets.
-Elim h1; Auto with sets.
-Generalize (Rstar_cases U R x0 z); Intro h; LApply h;
- [Intro h0; Elim h0;
- [Clear h h0; Intro h1 |
- Intro h1; Elim h1; Intros v h2; Elim h2; Intros H'7 H'8; Clear h h0 h1 h2] |
- Clear h]; Auto with sets.
-Elim h1; Generalize coherent_symmetric; Intro t; Red in t; Auto with sets.
-Unfold Locally_confluent locally_confluent coherent in H'0.
-Generalize (H'0 x0 u v); Intro h; LApply h;
- [Intro H'9; LApply H'9;
- [Intro h0; Elim h0; Intros t h1; Elim h1; Intros H'10 H'11;
- Clear h H'9 h0 h1 | Clear h] | Clear h]; Auto with sets.
-Clear H'0.
-Unfold 1 coherent in H'2.
-Generalize (H'2 u); Intro h; LApply h;
- [Intro H'0; Generalize (H'0 y t); Intro h0; LApply h0;
- [Intro H'9; LApply H'9;
- [Intro h1; Elim h1; Intros y1 h2; Elim h2; Intros H'12 H'13;
- Clear h h0 H'9 h1 h2 | Clear h h0] | Clear h h0] | Clear h]; Auto with sets.
-Generalize Rstar_transitive; Intro T; Red in T.
-Generalize (H'2 v); Intro h; LApply h;
- [Intro H'9; Generalize (H'9 y1 z); Intro h0; LApply h0;
- [Intro H'14; LApply H'14;
- [Intro h1; Elim h1; Intros z1 h2; Elim h2; Intros H'15 H'16;
- Clear h h0 H'14 h1 h2 | Clear h h0] | Clear h h0] | Clear h]; Auto with sets.
-Red; (Exists z1; Split); Auto with sets.
-Apply T with y1; Auto with sets.
-Apply T with t; Auto with sets.
-Qed.
+intros U R H' H'0; red in |- *; intro x.
+elim (H' x); unfold confluent in |- *.
+intros x0 H'1 H'2 y z H'3 H'4.
+generalize (Rstar_cases U R x0 y); intro h; lapply h;
+ [ intro h0; elim h0;
+ [ clear h h0; intro h1
+ | intro h1; elim h1; intros u h2; elim h2; intros H'5 H'6;
+ clear h h0 h1 h2 ]
+ | clear h ]; auto with sets.
+elim h1; auto with sets.
+generalize (Rstar_cases U R x0 z); intro h; lapply h;
+ [ intro h0; elim h0;
+ [ clear h h0; intro h1
+ | intro h1; elim h1; intros v h2; elim h2; intros H'7 H'8;
+ clear h h0 h1 h2 ]
+ | clear h ]; auto with sets.
+elim h1; generalize coherent_symmetric; intro t; red in t; auto with sets.
+unfold Locally_confluent, locally_confluent, coherent in H'0.
+generalize (H'0 x0 u v); intro h; lapply h;
+ [ intro H'9; lapply H'9;
+ [ intro h0; elim h0; intros t h1; elim h1; intros H'10 H'11;
+ clear h H'9 h0 h1
+ | clear h ]
+ | clear h ]; auto with sets.
+clear H'0.
+unfold coherent at 1 in H'2.
+generalize (H'2 u); intro h; lapply h;
+ [ intro H'0; generalize (H'0 y t); intro h0; lapply h0;
+ [ intro H'9; lapply H'9;
+ [ intro h1; elim h1; intros y1 h2; elim h2; intros H'12 H'13;
+ clear h h0 H'9 h1 h2
+ | clear h h0 ]
+ | clear h h0 ]
+ | clear h ]; auto with sets.
+generalize Rstar_transitive; intro T; red in T.
+generalize (H'2 v); intro h; lapply h;
+ [ intro H'9; generalize (H'9 y1 z); intro h0; lapply h0;
+ [ intro H'14; lapply H'14;
+ [ intro h1; elim h1; intros z1 h2; elim h2; intros H'15 H'16;
+ clear h h0 H'14 h1 h2
+ | clear h h0 ]
+ | clear h h0 ]
+ | clear h ]; auto with sets.
+red in |- *; (exists z1; split); auto with sets.
+apply T with y1; auto with sets.
+apply T with t; auto with sets.
+Qed. \ No newline at end of file
diff --git a/theories/Sets/Uniset.v b/theories/Sets/Uniset.v
index 5b28d6c2b..e1ba00209 100644
--- a/theories/Sets/Uniset.v
+++ b/theories/Sets/Uniset.v
@@ -13,7 +13,7 @@
(* G. Huet 1-9-95 *)
(* Updated Papageno 12/98 *)
-Require Bool.
+Require Import Bool.
Set Implicit Arguments.
@@ -21,121 +21,118 @@ Section defs.
Variable A : Set.
Variable eqA : A -> A -> Prop.
-Hypothesis eqA_dec : (x,y:A){(eqA x y)}+{~(eqA x y)}.
+Hypothesis eqA_dec : forall x y:A, {eqA x y} + {~ eqA x y}.
-Inductive uniset : Set :=
- Charac : (A->bool) -> uniset.
+Inductive uniset : Set :=
+ Charac : (A -> bool) -> uniset.
-Definition charac : uniset -> A -> bool :=
- [s:uniset][a:A]Case s of [f:A->bool](f a) end.
+Definition charac (s:uniset) (a:A) : bool := let (f) := s in f a.
-Definition Emptyset := (Charac [a:A]false).
+Definition Emptyset := Charac (fun a:A => false).
-Definition Fullset := (Charac [a:A]true).
+Definition Fullset := Charac (fun a:A => true).
-Definition Singleton := [a:A](Charac [a':A]
- Case (eqA_dec a a') of
- [h:(eqA a a')] true
- [h: ~(eqA a a')] false end).
+Definition Singleton (a:A) :=
+ Charac
+ (fun a':A =>
+ match eqA_dec a a' with
+ | left h => true
+ | right h => false
+ end).
-Definition In : uniset -> A -> Prop :=
- [s:uniset][a:A](charac s a)=true.
-Hints Unfold In.
+Definition In (s:uniset) (a:A) : Prop := charac s a = true.
+Hint Unfold In.
(** uniset inclusion *)
-Definition incl := [s1,s2:uniset]
- (a:A)(leb (charac s1 a) (charac s2 a)).
-Hints Unfold incl.
+Definition incl (s1 s2:uniset) := forall a:A, leb (charac s1 a) (charac s2 a).
+Hint Unfold incl.
(** uniset equality *)
-Definition seq := [s1,s2:uniset]
- (a:A)(charac s1 a) = (charac s2 a).
-Hints Unfold seq.
+Definition seq (s1 s2:uniset) := forall a:A, charac s1 a = charac s2 a.
+Hint Unfold seq.
-Lemma leb_refl : (b:bool)(leb b b).
+Lemma leb_refl : forall b:bool, leb b b.
Proof.
-NewDestruct b; Simpl; Auto.
+destruct b; simpl in |- *; auto.
Qed.
-Hints Resolve leb_refl.
+Hint Resolve leb_refl.
-Lemma incl_left : (s1,s2:uniset)(seq s1 s2)->(incl s1 s2).
+Lemma incl_left : forall s1 s2:uniset, seq s1 s2 -> incl s1 s2.
Proof.
-Unfold incl; Intros s1 s2 E a; Elim (E a); Auto.
+unfold incl in |- *; intros s1 s2 E a; elim (E a); auto.
Qed.
-Lemma incl_right : (s1,s2:uniset)(seq s1 s2)->(incl s2 s1).
+Lemma incl_right : forall s1 s2:uniset, seq s1 s2 -> incl s2 s1.
Proof.
-Unfold incl; Intros s1 s2 E a; Elim (E a); Auto.
+unfold incl in |- *; intros s1 s2 E a; elim (E a); auto.
Qed.
-Lemma seq_refl : (x:uniset)(seq x x).
+Lemma seq_refl : forall x:uniset, seq x x.
Proof.
-NewDestruct x; Unfold seq; Auto.
+destruct x; unfold seq in |- *; auto.
Qed.
-Hints Resolve seq_refl.
+Hint Resolve seq_refl.
-Lemma seq_trans : (x,y,z:uniset)(seq x y)->(seq y z)->(seq x z).
+Lemma seq_trans : forall x y z:uniset, seq x y -> seq y z -> seq x z.
Proof.
-Unfold seq.
-NewDestruct x; NewDestruct y; NewDestruct z; Simpl; Intros.
-Rewrite H; Auto.
+unfold seq in |- *.
+destruct x; destruct y; destruct z; simpl in |- *; intros.
+rewrite H; auto.
Qed.
-Lemma seq_sym : (x,y:uniset)(seq x y)->(seq y x).
+Lemma seq_sym : forall x y:uniset, seq x y -> seq y x.
Proof.
-Unfold seq.
-NewDestruct x; NewDestruct y; Simpl; Auto.
+unfold seq in |- *.
+destruct x; destruct y; simpl in |- *; auto.
Qed.
(** uniset union *)
-Definition union := [m1,m2:uniset]
- (Charac [a:A](orb (charac m1 a)(charac m2 a))).
+Definition union (m1 m2:uniset) :=
+ Charac (fun a:A => orb (charac m1 a) (charac m2 a)).
-Lemma union_empty_left :
- (x:uniset)(seq x (union Emptyset x)).
+Lemma union_empty_left : forall x:uniset, seq x (union Emptyset x).
Proof.
-Unfold seq; Unfold union; Simpl; Auto.
+unfold seq in |- *; unfold union in |- *; simpl in |- *; auto.
Qed.
-Hints Resolve union_empty_left.
+Hint Resolve union_empty_left.
-Lemma union_empty_right :
- (x:uniset)(seq x (union x Emptyset)).
+Lemma union_empty_right : forall x:uniset, seq x (union x Emptyset).
Proof.
-Unfold seq; Unfold union; Simpl.
-Intros x a; Rewrite (orb_b_false (charac x a)); Auto.
+unfold seq in |- *; unfold union in |- *; simpl in |- *.
+intros x a; rewrite (orb_b_false (charac x a)); auto.
Qed.
-Hints Resolve union_empty_right.
+Hint Resolve union_empty_right.
-Lemma union_comm : (x,y:uniset)(seq (union x y) (union y x)).
+Lemma union_comm : forall x y:uniset, seq (union x y) (union y x).
Proof.
-Unfold seq; Unfold charac; Unfold union.
-NewDestruct x; NewDestruct y; Auto with bool.
+unfold seq in |- *; unfold charac in |- *; unfold union in |- *.
+destruct x; destruct y; auto with bool.
Qed.
-Hints Resolve union_comm.
+Hint Resolve union_comm.
-Lemma union_ass :
- (x,y,z:uniset)(seq (union (union x y) z) (union x (union y z))).
+Lemma union_ass :
+ forall x y z:uniset, seq (union (union x y) z) (union x (union y z)).
Proof.
-Unfold seq; Unfold union; Unfold charac.
-NewDestruct x; NewDestruct y; NewDestruct z; Auto with bool.
+unfold seq in |- *; unfold union in |- *; unfold charac in |- *.
+destruct x; destruct y; destruct z; auto with bool.
Qed.
-Hints Resolve union_ass.
+Hint Resolve union_ass.
-Lemma seq_left : (x,y,z:uniset)(seq x y)->(seq (union x z) (union y z)).
+Lemma seq_left : forall x y z:uniset, seq x y -> seq (union x z) (union y z).
Proof.
-Unfold seq; Unfold union; Unfold charac.
-NewDestruct x; NewDestruct y; NewDestruct z.
-Intros; Elim H; Auto.
+unfold seq in |- *; unfold union in |- *; unfold charac in |- *.
+destruct x; destruct y; destruct z.
+intros; elim H; auto.
Qed.
-Hints Resolve seq_left.
+Hint Resolve seq_left.
-Lemma seq_right : (x,y,z:uniset)(seq x y)->(seq (union z x) (union z y)).
+Lemma seq_right : forall x y z:uniset, seq x y -> seq (union z x) (union z y).
Proof.
-Unfold seq; Unfold union; Unfold charac.
-NewDestruct x; NewDestruct y; NewDestruct z.
-Intros; Elim H; Auto.
+unfold seq in |- *; unfold union in |- *; unfold charac in |- *.
+destruct x; destruct y; destruct z.
+intros; elim H; auto.
Qed.
-Hints Resolve seq_right.
+Hint Resolve seq_right.
(** All the proofs that follow duplicate [Multiset_of_A] *)
@@ -143,60 +140,66 @@ Hints Resolve seq_right.
(** Here we should make uniset an abstract datatype, by hiding [Charac],
[union], [charac]; all further properties are proved abstractly *)
-Require Permut.
+Require Import Permut.
Lemma union_rotate :
- (x,y,z:uniset)(seq (union x (union y z)) (union z (union x y))).
+ forall x y z:uniset, seq (union x (union y z)) (union z (union x y)).
Proof.
-Intros; Apply (op_rotate uniset union seq); Auto.
-Exact seq_trans.
+intros; apply (op_rotate uniset union seq); auto.
+exact seq_trans.
Qed.
-Lemma seq_congr : (x,y,z,t:uniset)(seq x y)->(seq z t)->
- (seq (union x z) (union y t)).
+Lemma seq_congr :
+ forall x y z t:uniset, seq x y -> seq z t -> seq (union x z) (union y t).
Proof.
-Intros; Apply (cong_congr uniset union seq); Auto.
-Exact seq_trans.
+intros; apply (cong_congr uniset union seq); auto.
+exact seq_trans.
Qed.
Lemma union_perm_left :
- (x,y,z:uniset)(seq (union x (union y z)) (union y (union x z))).
+ forall x y z:uniset, seq (union x (union y z)) (union y (union x z)).
Proof.
-Intros; Apply (perm_left uniset union seq); Auto.
-Exact seq_trans.
+intros; apply (perm_left uniset union seq); auto.
+exact seq_trans.
Qed.
-Lemma uniset_twist1 : (x,y,z,t:uniset)
- (seq (union x (union (union y z) t)) (union (union y (union x t)) z)).
+Lemma uniset_twist1 :
+ forall x y z t:uniset,
+ seq (union x (union (union y z) t)) (union (union y (union x t)) z).
Proof.
-Intros; Apply (twist uniset union seq); Auto.
-Exact seq_trans.
+intros; apply (twist uniset union seq); auto.
+exact seq_trans.
Qed.
-Lemma uniset_twist2 : (x,y,z,t:uniset)
- (seq (union x (union (union y z) t)) (union (union y (union x z)) t)).
+Lemma uniset_twist2 :
+ forall x y z t:uniset,
+ seq (union x (union (union y z) t)) (union (union y (union x z)) t).
Proof.
-Intros; Apply seq_trans with (union (union x (union y z)) t).
-Apply seq_sym; Apply union_ass.
-Apply seq_left; Apply union_perm_left.
+intros; apply seq_trans with (union (union x (union y z)) t).
+apply seq_sym; apply union_ass.
+apply seq_left; apply union_perm_left.
Qed.
(** specific for treesort *)
-Lemma treesort_twist1 : (x,y,z,t,u:uniset) (seq u (union y z)) ->
- (seq (union x (union u t)) (union (union y (union x t)) z)).
+Lemma treesort_twist1 :
+ forall x y z t u:uniset,
+ seq u (union y z) ->
+ seq (union x (union u t)) (union (union y (union x t)) z).
Proof.
-Intros; Apply seq_trans with (union x (union (union y z) t)).
-Apply seq_right; Apply seq_left; Trivial.
-Apply uniset_twist1.
+intros; apply seq_trans with (union x (union (union y z) t)).
+apply seq_right; apply seq_left; trivial.
+apply uniset_twist1.
Qed.
-Lemma treesort_twist2 : (x,y,z,t,u:uniset) (seq u (union y z)) ->
- (seq (union x (union u t)) (union (union y (union x z)) t)).
+Lemma treesort_twist2 :
+ forall x y z t u:uniset,
+ seq u (union y z) ->
+ seq (union x (union u t)) (union (union y (union x z)) t).
Proof.
-Intros; Apply seq_trans with (union x (union (union y z) t)).
-Apply seq_right; Apply seq_left; Trivial.
-Apply uniset_twist2.
+intros; apply seq_trans with (union x (union (union y z) t)).
+apply seq_right; apply seq_left; trivial.
+apply uniset_twist2.
Qed.
@@ -209,4 +212,4 @@ i*)
End defs.
-Unset Implicit Arguments.
+Unset Implicit Arguments. \ No newline at end of file
diff --git a/theories/Sorting/Heap.v b/theories/Sorting/Heap.v
index 31e3ac447..95a40ab12 100644
--- a/theories/Sorting/Heap.v
+++ b/theories/Sorting/Heap.v
@@ -12,103 +12,102 @@
(* G. Huet 1-9-95 uses Multiset *)
-Require PolyList.
-Require Multiset.
-Require Permutation.
-Require Relations.
-Require Sorting.
+Require Import List.
+Require Import Multiset.
+Require Import Permutation.
+Require Import Relations.
+Require Import Sorting.
Section defs.
Variable A : Set.
-Variable leA : (relation A).
-Variable eqA : (relation A).
+Variable leA : relation A.
+Variable eqA : relation A.
-Local gtA := [x,y:A]~(leA x y).
+Let gtA (x y:A) := ~ leA x y.
-Hypothesis leA_dec : (x,y:A){(leA x y)}+{(leA y x)}.
-Hypothesis eqA_dec : (x,y:A){(eqA x y)}+{~(eqA x y)}.
-Hypothesis leA_refl : (x,y:A) (eqA x y) -> (leA x y).
-Hypothesis leA_trans : (x,y,z:A) (leA x y) -> (leA y z) -> (leA x z).
-Hypothesis leA_antisym : (x,y:A)(leA x y) -> (leA y x) -> (eqA x y).
+Hypothesis leA_dec : forall x y:A, {leA x y} + {leA y x}.
+Hypothesis eqA_dec : forall x y:A, {eqA x y} + {~ eqA x y}.
+Hypothesis leA_refl : forall x y:A, eqA x y -> leA x y.
+Hypothesis leA_trans : forall x y z:A, leA x y -> leA y z -> leA x z.
+Hypothesis leA_antisym : forall x y:A, leA x y -> leA y x -> eqA x y.
-Hints Resolve leA_refl.
-Hints Immediate eqA_dec leA_dec leA_antisym.
+Hint Resolve leA_refl.
+Hint Immediate eqA_dec leA_dec leA_antisym.
-Local emptyBag := (EmptyBag A).
-Local singletonBag := (SingletonBag eqA_dec).
+Let emptyBag := EmptyBag A.
+Let singletonBag := SingletonBag _ eqA_dec.
Inductive Tree : Set :=
- Tree_Leaf : Tree
- | Tree_Node : A -> Tree -> Tree -> Tree.
+ | Tree_Leaf : Tree
+ | Tree_Node : A -> Tree -> Tree -> Tree.
(** [a] is lower than a Tree [T] if [T] is a Leaf
or [T] is a Node holding [b>a] *)
-Definition leA_Tree := [a:A; t:Tree]
- Cases t of
- Tree_Leaf => True
- | (Tree_Node b T1 T2) => (leA a b)
- end.
+Definition leA_Tree (a:A) (t:Tree) :=
+ match t with
+ | Tree_Leaf => True
+ | Tree_Node b T1 T2 => leA a b
+ end.
-Lemma leA_Tree_Leaf : (a:A)(leA_Tree a Tree_Leaf).
+Lemma leA_Tree_Leaf : forall a:A, leA_Tree a Tree_Leaf.
Proof.
-Simpl; Auto with datatypes.
+simpl in |- *; auto with datatypes.
Qed.
-Lemma leA_Tree_Node : (a,b:A)(G,D:Tree)(leA a b) ->
- (leA_Tree a (Tree_Node b G D)).
+Lemma leA_Tree_Node :
+ forall (a b:A) (G D:Tree), leA a b -> leA_Tree a (Tree_Node b G D).
Proof.
-Simpl; Auto with datatypes.
+simpl in |- *; auto with datatypes.
Qed.
-Hints Resolve leA_Tree_Leaf leA_Tree_Node.
+Hint Resolve leA_Tree_Leaf leA_Tree_Node.
(** The heap property *)
Inductive is_heap : Tree -> Prop :=
- nil_is_heap : (is_heap Tree_Leaf)
- | node_is_heap : (a:A)(T1,T2:Tree)
- (leA_Tree a T1) ->
- (leA_Tree a T2) ->
- (is_heap T1) -> (is_heap T2) ->
- (is_heap (Tree_Node a T1 T2)).
-
-Hint constr_is_heap := Constructors is_heap.
-
-Lemma invert_heap : (a:A)(T1,T2:Tree)(is_heap (Tree_Node a T1 T2))->
- (leA_Tree a T1) /\ (leA_Tree a T2) /\
- (is_heap T1) /\ (is_heap T2).
+ | nil_is_heap : is_heap Tree_Leaf
+ | node_is_heap :
+ forall (a:A) (T1 T2:Tree),
+ leA_Tree a T1 ->
+ leA_Tree a T2 ->
+ is_heap T1 -> is_heap T2 -> is_heap (Tree_Node a T1 T2).
+
+Hint Constructors is_heap.
+
+Lemma invert_heap :
+ forall (a:A) (T1 T2:Tree),
+ is_heap (Tree_Node a T1 T2) ->
+ leA_Tree a T1 /\ leA_Tree a T2 /\ is_heap T1 /\ is_heap T2.
Proof.
-Intros; Inversion H; Auto with datatypes.
+intros; inversion H; auto with datatypes.
Qed.
(* This lemma ought to be generated automatically by the Inversion tools *)
-Lemma is_heap_rec : (P:Tree->Set)
- (P Tree_Leaf)->
- ((a:A)
- (T1:Tree)
- (T2:Tree)
- (leA_Tree a T1)->
- (leA_Tree a T2)->
- (is_heap T1)->
- (P T1)->(is_heap T2)->(P T2)->(P (Tree_Node a T1 T2)))
- -> (T:Tree)(is_heap T) -> (P T).
+Lemma is_heap_rec :
+ forall P:Tree -> Set,
+ P Tree_Leaf ->
+ (forall (a:A) (T1 T2:Tree),
+ leA_Tree a T1 ->
+ leA_Tree a T2 ->
+ is_heap T1 -> P T1 -> is_heap T2 -> P T2 -> P (Tree_Node a T1 T2)) ->
+ forall T:Tree, is_heap T -> P T.
Proof.
-Induction T; Auto with datatypes.
-Intros a G PG D PD PN.
-Elim (invert_heap a G D); Auto with datatypes.
-Intros H1 H2; Elim H2; Intros H3 H4; Elim H4; Intros.
-Apply H0; Auto with datatypes.
+simple induction T; auto with datatypes.
+intros a G PG D PD PN.
+elim (invert_heap a G D); auto with datatypes.
+intros H1 H2; elim H2; intros H3 H4; elim H4; intros.
+apply H0; auto with datatypes.
Qed.
-Lemma low_trans :
- (T:Tree)(a,b:A)(leA a b) -> (leA_Tree b T) -> (leA_Tree a T).
+Lemma low_trans :
+ forall (T:Tree) (a b:A), leA a b -> leA_Tree b T -> leA_Tree a T.
Proof.
-Induction T; Auto with datatypes.
-Intros; Simpl; Apply leA_trans with b; Auto with datatypes.
+simple induction T; auto with datatypes.
+intros; simpl in |- *; apply leA_trans with b; auto with datatypes.
Qed.
(** contents of a tree as a multiset *)
@@ -117,107 +116,112 @@ Qed.
in not used. Actually, we could just take as postulate:
[Parameter SingletonBag : A->multiset]. *)
-Fixpoint contents [t:Tree] : (multiset A) :=
- Cases t of
- Tree_Leaf => emptyBag
- | (Tree_Node a t1 t2) => (munion (contents t1)
- (munion (contents t2) (singletonBag a)))
-end.
+Fixpoint contents (t:Tree) : multiset A :=
+ match t with
+ | Tree_Leaf => emptyBag
+ | Tree_Node a t1 t2 =>
+ munion (contents t1) (munion (contents t2) (singletonBag a))
+ end.
(** equivalence of two trees is equality of corresponding multisets *)
-Definition equiv_Tree := [t1,t2:Tree](meq (contents t1) (contents t2)).
+Definition equiv_Tree (t1 t2:Tree) := meq (contents t1) (contents t2).
(** specification of heap insertion *)
-Inductive insert_spec [a:A; T:Tree] : Set :=
- insert_exist : (T1:Tree)(is_heap T1) ->
- (meq (contents T1) (munion (contents T) (singletonBag a))) ->
- ((b:A)(leA b a)->(leA_Tree b T)->(leA_Tree b T1)) ->
- (insert_spec a T).
+Inductive insert_spec (a:A) (T:Tree) : Set :=
+ insert_exist :
+ forall T1:Tree,
+ is_heap T1 ->
+ meq (contents T1) (munion (contents T) (singletonBag a)) ->
+ (forall b:A, leA b a -> leA_Tree b T -> leA_Tree b T1) ->
+ insert_spec a T.
-Lemma insert : (T:Tree)(is_heap T) -> (a:A)(insert_spec a T).
+Lemma insert : forall T:Tree, is_heap T -> forall a:A, insert_spec a T.
Proof.
-Induction 1; Intros.
-Apply insert_exist with (Tree_Node a Tree_Leaf Tree_Leaf); Auto with datatypes.
-Simpl; Unfold meq munion; Auto with datatypes.
-Elim (leA_dec a a0); Intros.
-Elim (H3 a0); Intros.
-Apply insert_exist with (Tree_Node a T2 T0); Auto with datatypes.
-Simpl; Apply treesort_twist1; Trivial with datatypes.
-Elim (H3 a); Intros T3 HeapT3 ConT3 LeA.
-Apply insert_exist with (Tree_Node a0 T2 T3); Auto with datatypes.
-Apply node_is_heap; Auto with datatypes.
-Apply low_trans with a; Auto with datatypes.
-Apply LeA; Auto with datatypes.
-Apply low_trans with a; Auto with datatypes.
-Simpl; Apply treesort_twist2; Trivial with datatypes.
+simple induction 1; intros.
+apply insert_exist with (Tree_Node a Tree_Leaf Tree_Leaf);
+ auto with datatypes.
+simpl in |- *; unfold meq, munion in |- *; auto with datatypes.
+elim (leA_dec a a0); intros.
+elim (H3 a0); intros.
+apply insert_exist with (Tree_Node a T2 T0); auto with datatypes.
+simpl in |- *; apply treesort_twist1; trivial with datatypes.
+elim (H3 a); intros T3 HeapT3 ConT3 LeA.
+apply insert_exist with (Tree_Node a0 T2 T3); auto with datatypes.
+apply node_is_heap; auto with datatypes.
+apply low_trans with a; auto with datatypes.
+apply LeA; auto with datatypes.
+apply low_trans with a; auto with datatypes.
+simpl in |- *; apply treesort_twist2; trivial with datatypes.
Qed.
(** building a heap from a list *)
-Inductive build_heap [l:(list A)] : Set :=
- heap_exist : (T:Tree)(is_heap T) ->
- (meq (list_contents eqA_dec l)(contents T)) ->
- (build_heap l).
+Inductive build_heap (l:list A) : Set :=
+ heap_exist :
+ forall T:Tree,
+ is_heap T ->
+ meq (list_contents _ eqA_dec l) (contents T) -> build_heap l.
-Lemma list_to_heap : (l:(list A))(build_heap l).
+Lemma list_to_heap : forall l:list A, build_heap l.
Proof.
-Induction l.
-Apply (heap_exist (nil A) Tree_Leaf); Auto with datatypes.
-Simpl; Unfold meq; Auto with datatypes.
-Induction 1.
-Intros T i m; Elim (insert T i a).
-Intros; Apply heap_exist with T1; Simpl; Auto with datatypes.
-Apply meq_trans with (munion (contents T) (singletonBag a)).
-Apply meq_trans with (munion (singletonBag a) (contents T)).
-Apply meq_right; Trivial with datatypes.
-Apply munion_comm.
-Apply meq_sym; Trivial with datatypes.
+simple induction l.
+apply (heap_exist nil Tree_Leaf); auto with datatypes.
+simpl in |- *; unfold meq in |- *; auto with datatypes.
+simple induction 1.
+intros T i m; elim (insert T i a).
+intros; apply heap_exist with T1; simpl in |- *; auto with datatypes.
+apply meq_trans with (munion (contents T) (singletonBag a)).
+apply meq_trans with (munion (singletonBag a) (contents T)).
+apply meq_right; trivial with datatypes.
+apply munion_comm.
+apply meq_sym; trivial with datatypes.
Qed.
(** building the sorted list *)
-Inductive flat_spec [T:Tree] : Set :=
- flat_exist : (l:(list A))(sort leA l) ->
- ((a:A)(leA_Tree a T)->(lelistA leA a l)) ->
- (meq (contents T) (list_contents eqA_dec l)) ->
- (flat_spec T).
+Inductive flat_spec (T:Tree) : Set :=
+ flat_exist :
+ forall l:list A,
+ sort leA l ->
+ (forall a:A, leA_Tree a T -> lelistA leA a l) ->
+ meq (contents T) (list_contents _ eqA_dec l) -> flat_spec T.
-Lemma heap_to_list : (T:Tree)(is_heap T) -> (flat_spec T).
+Lemma heap_to_list : forall T:Tree, is_heap T -> flat_spec T.
Proof.
- Intros T h; Elim h; Intros.
- Apply flat_exist with (nil A); Auto with datatypes.
- Elim H2; Intros l1 s1 i1 m1; Elim H4; Intros l2 s2 i2 m2.
- Elim (merge leA_dec eqA_dec s1 s2); Intros.
- Apply flat_exist with (cons a l); Simpl; Auto with datatypes.
- Apply meq_trans with
- (munion (list_contents eqA_dec l1) (munion (list_contents eqA_dec l2)
- (singletonBag a))).
- Apply meq_congr; Auto with datatypes.
- Apply meq_trans with
- (munion (singletonBag a) (munion (list_contents eqA_dec l1)
- (list_contents eqA_dec l2))).
- Apply munion_rotate.
- Apply meq_right; Apply meq_sym; Trivial with datatypes.
+ intros T h; elim h; intros.
+ apply flat_exist with (nil (A:=A)); auto with datatypes.
+ elim H2; intros l1 s1 i1 m1; elim H4; intros l2 s2 i2 m2.
+ elim (merge _ leA_dec eqA_dec s1 s2); intros.
+ apply flat_exist with (a :: l); simpl in |- *; auto with datatypes.
+ apply meq_trans with
+ (munion (list_contents _ eqA_dec l1)
+ (munion (list_contents _ eqA_dec l2) (singletonBag a))).
+ apply meq_congr; auto with datatypes.
+ apply meq_trans with
+ (munion (singletonBag a)
+ (munion (list_contents _ eqA_dec l1) (list_contents _ eqA_dec l2))).
+ apply munion_rotate.
+ apply meq_right; apply meq_sym; trivial with datatypes.
Qed.
(** specification of treesort *)
-Theorem treesort : (l:(list A))
- {m:(list A) | (sort leA m) & (permutation eqA_dec l m)}.
+Theorem treesort :
+ forall l:list A, {m : list A | sort leA m & permutation _ eqA_dec l m}.
Proof.
- Intro l; Unfold permutation.
- Elim (list_to_heap l).
- Intros.
- Elim (heap_to_list T); Auto with datatypes.
- Intros.
- Exists l0; Auto with datatypes.
- Apply meq_trans with (contents T); Trivial with datatypes.
+ intro l; unfold permutation in |- *.
+ elim (list_to_heap l).
+ intros.
+ elim (heap_to_list T); auto with datatypes.
+ intros.
+ exists l0; auto with datatypes.
+ apply meq_trans with (contents T); trivial with datatypes.
Qed.
-End defs.
+End defs. \ No newline at end of file
diff --git a/theories/Sorting/Permutation.v b/theories/Sorting/Permutation.v
index 3702387a7..bfb42b7b9 100644
--- a/theories/Sorting/Permutation.v
+++ b/theories/Sorting/Permutation.v
@@ -8,104 +8,113 @@
(*i $Id$ i*)
-Require Relations.
-Require PolyList.
-Require Multiset.
+Require Import Relations.
+Require Import List.
+Require Import Multiset.
Set Implicit Arguments.
Section defs.
Variable A : Set.
-Variable leA : (relation A).
-Variable eqA : (relation A).
+Variable leA : relation A.
+Variable eqA : relation A.
-Local gtA := [x,y:A]~(leA x y).
+Let gtA (x y:A) := ~ leA x y.
-Hypothesis leA_dec : (x,y:A){(leA x y)}+{~(leA x y)}.
-Hypothesis eqA_dec : (x,y:A){(eqA x y)}+{~(eqA x y)}.
-Hypothesis leA_refl : (x,y:A) (eqA x y) -> (leA x y).
-Hypothesis leA_trans : (x,y,z:A) (leA x y) -> (leA y z) -> (leA x z).
-Hypothesis leA_antisym : (x,y:A)(leA x y) -> (leA y x) -> (eqA x y).
+Hypothesis leA_dec : forall x y:A, {leA x y} + {~ leA x y}.
+Hypothesis eqA_dec : forall x y:A, {eqA x y} + {~ eqA x y}.
+Hypothesis leA_refl : forall x y:A, eqA x y -> leA x y.
+Hypothesis leA_trans : forall x y z:A, leA x y -> leA y z -> leA x z.
+Hypothesis leA_antisym : forall x y:A, leA x y -> leA y x -> eqA x y.
-Hints Resolve leA_refl : default.
-Hints Immediate eqA_dec leA_dec leA_antisym : default.
+Hint Resolve leA_refl: default.
+Hint Immediate eqA_dec leA_dec leA_antisym: default.
-Local emptyBag := (EmptyBag A).
-Local singletonBag := (SingletonBag eqA_dec).
+Let emptyBag := EmptyBag A.
+Let singletonBag := SingletonBag _ eqA_dec.
(** contents of a list *)
-Fixpoint list_contents [l:(list A)] : (multiset A) :=
- Cases l of
- nil => emptyBag
- | (cons a l) => (munion (singletonBag a) (list_contents l))
- end.
+Fixpoint list_contents (l:list A) : multiset A :=
+ match l with
+ | nil => emptyBag
+ | a :: l => munion (singletonBag a) (list_contents l)
+ end.
-Lemma list_contents_app : (l,m:(list A))
- (meq (list_contents (app l m)) (munion (list_contents l) (list_contents m))).
+Lemma list_contents_app :
+ forall l m:list A,
+ meq (list_contents (l ++ m)) (munion (list_contents l) (list_contents m)).
Proof.
-Induction l; Simpl; Auto with datatypes.
-Intros.
-Apply meq_trans with
- (munion (singletonBag a) (munion (list_contents l0) (list_contents m))); Auto with datatypes.
+simple induction l; simpl in |- *; auto with datatypes.
+intros.
+apply meq_trans with
+ (munion (singletonBag a) (munion (list_contents l0) (list_contents m)));
+ auto with datatypes.
Qed.
-Hints Resolve list_contents_app.
+Hint Resolve list_contents_app.
-Definition permutation := [l,m:(list A)](meq (list_contents l) (list_contents m)).
+Definition permutation (l m:list A) :=
+ meq (list_contents l) (list_contents m).
-Lemma permut_refl : (l:(list A))(permutation l l).
+Lemma permut_refl : forall l:list A, permutation l l.
Proof.
-Unfold permutation; Auto with datatypes.
+unfold permutation in |- *; auto with datatypes.
Qed.
-Hints Resolve permut_refl.
+Hint Resolve permut_refl.
-Lemma permut_tran : (l,m,n:(list A))
- (permutation l m) -> (permutation m n) -> (permutation l n).
+Lemma permut_tran :
+ forall l m n:list A, permutation l m -> permutation m n -> permutation l n.
Proof.
-Unfold permutation; Intros.
-Apply meq_trans with (list_contents m); Auto with datatypes.
+unfold permutation in |- *; intros.
+apply meq_trans with (list_contents m); auto with datatypes.
Qed.
-Lemma permut_right : (l,m:(list A))
- (permutation l m) -> (a:A)(permutation (cons a l) (cons a m)).
+Lemma permut_right :
+ forall l m:list A,
+ permutation l m -> forall a:A, permutation (a :: l) (a :: m).
Proof.
-Unfold permutation; Simpl; Auto with datatypes.
+unfold permutation in |- *; simpl in |- *; auto with datatypes.
Qed.
-Hints Resolve permut_right.
+Hint Resolve permut_right.
-Lemma permut_app : (l,l',m,m':(list A))
- (permutation l l') -> (permutation m m') ->
- (permutation (app l m) (app l' m')).
+Lemma permut_app :
+ forall l l' m m':list A,
+ permutation l l' -> permutation m m' -> permutation (l ++ m) (l' ++ m').
Proof.
-Unfold permutation; Intros.
-Apply meq_trans with (munion (list_contents l) (list_contents m)); Auto with datatypes.
-Apply meq_trans with (munion (list_contents l') (list_contents m')); Auto with datatypes.
-Apply meq_trans with (munion (list_contents l') (list_contents m)); Auto with datatypes.
+unfold permutation in |- *; intros.
+apply meq_trans with (munion (list_contents l) (list_contents m));
+ auto with datatypes.
+apply meq_trans with (munion (list_contents l') (list_contents m'));
+ auto with datatypes.
+apply meq_trans with (munion (list_contents l') (list_contents m));
+ auto with datatypes.
Qed.
-Hints Resolve permut_app.
+Hint Resolve permut_app.
-Lemma permut_cons : (l,m:(list A))(permutation l m) ->
- (a:A)(permutation (cons a l) (cons a m)).
+Lemma permut_cons :
+ forall l m:list A,
+ permutation l m -> forall a:A, permutation (a :: l) (a :: m).
Proof.
-Intros l m H a.
-Change (permutation (app (cons a (nil A)) l) (app (cons a (nil A)) m)).
-Apply permut_app; Auto with datatypes.
+intros l m H a.
+change (permutation ((a :: nil) ++ l) ((a :: nil) ++ m)) in |- *.
+apply permut_app; auto with datatypes.
Qed.
-Hints Resolve permut_cons.
+Hint Resolve permut_cons.
-Lemma permut_middle : (l,m:(list A))
- (a:A)(permutation (cons a (app l m)) (app l (cons a m))).
+Lemma permut_middle :
+ forall (l m:list A) (a:A), permutation (a :: l ++ m) (l ++ a :: m).
Proof.
-Unfold permutation.
-Induction l; Simpl; Auto with datatypes.
-Intros.
-Apply meq_trans with (munion (singletonBag a)
- (munion (singletonBag a0) (list_contents (app l0 m)))); Auto with datatypes.
-Apply munion_perm_left; Auto with datatypes.
+unfold permutation in |- *.
+simple induction l; simpl in |- *; auto with datatypes.
+intros.
+apply meq_trans with
+ (munion (singletonBag a)
+ (munion (singletonBag a0) (list_contents (l0 ++ m))));
+ auto with datatypes.
+apply munion_perm_left; auto with datatypes.
Qed.
-Hints Resolve permut_middle.
+Hint Resolve permut_middle.
End defs.
Unset Implicit Arguments.
-
diff --git a/theories/Sorting/Sorting.v b/theories/Sorting/Sorting.v
index cad4e2019..b1986d4e7 100644
--- a/theories/Sorting/Sorting.v
+++ b/theories/Sorting/Sorting.v
@@ -8,110 +8,116 @@
(*i $Id$ i*)
-Require PolyList.
-Require Multiset.
-Require Permutation.
-Require Relations.
+Require Import List.
+Require Import Multiset.
+Require Import Permutation.
+Require Import Relations.
Set Implicit Arguments.
Section defs.
Variable A : Set.
-Variable leA : (relation A).
-Variable eqA : (relation A).
+Variable leA : relation A.
+Variable eqA : relation A.
-Local gtA := [x,y:A]~(leA x y).
+Let gtA (x y:A) := ~ leA x y.
-Hypothesis leA_dec : (x,y:A){(leA x y)}+{(leA y x)}.
-Hypothesis eqA_dec : (x,y:A){(eqA x y)}+{~(eqA x y)}.
-Hypothesis leA_refl : (x,y:A) (eqA x y) -> (leA x y).
-Hypothesis leA_trans : (x,y,z:A) (leA x y) -> (leA y z) -> (leA x z).
-Hypothesis leA_antisym : (x,y:A)(leA x y) -> (leA y x) -> (eqA x y).
+Hypothesis leA_dec : forall x y:A, {leA x y} + {leA y x}.
+Hypothesis eqA_dec : forall x y:A, {eqA x y} + {~ eqA x y}.
+Hypothesis leA_refl : forall x y:A, eqA x y -> leA x y.
+Hypothesis leA_trans : forall x y z:A, leA x y -> leA y z -> leA x z.
+Hypothesis leA_antisym : forall x y:A, leA x y -> leA y x -> eqA x y.
-Hints Resolve leA_refl.
-Hints Immediate eqA_dec leA_dec leA_antisym.
+Hint Resolve leA_refl.
+Hint Immediate eqA_dec leA_dec leA_antisym.
-Local emptyBag := (EmptyBag A).
-Local singletonBag := (SingletonBag eqA_dec).
+Let emptyBag := EmptyBag A.
+Let singletonBag := SingletonBag _ eqA_dec.
(** [lelistA] *)
-Inductive lelistA [a:A] : (list A) -> Prop :=
- nil_leA : (lelistA a (nil A))
- | cons_leA : (b:A)(l:(list A))(leA a b)->(lelistA a (cons b l)).
-Hint constr_lelistA := Constructors lelistA.
+Inductive lelistA (a:A) : list A -> Prop :=
+ | nil_leA : lelistA a nil
+ | cons_leA : forall (b:A) (l:list A), leA a b -> lelistA a (b :: l).
+Hint Constructors lelistA.
-Lemma lelistA_inv : (a,b:A)(l:(list A))
- (lelistA a (cons b l)) -> (leA a b).
+Lemma lelistA_inv : forall (a b:A) (l:list A), lelistA a (b :: l) -> leA a b.
Proof.
- Intros; Inversion H; Trivial with datatypes.
+ intros; inversion H; trivial with datatypes.
Qed.
(** definition for a list to be sorted *)
-Inductive sort : (list A) -> Prop :=
- nil_sort : (sort (nil A))
- | cons_sort : (a:A)(l:(list A))(sort l) -> (lelistA a l) -> (sort (cons a l)).
-Hint constr_sort := Constructors sort.
+Inductive sort : list A -> Prop :=
+ | nil_sort : sort nil
+ | cons_sort :
+ forall (a:A) (l:list A), sort l -> lelistA a l -> sort (a :: l).
+Hint Constructors sort.
-Lemma sort_inv : (a:A)(l:(list A))(sort (cons a l))->(sort l) /\ (lelistA a l).
+Lemma sort_inv :
+ forall (a:A) (l:list A), sort (a :: l) -> sort l /\ lelistA a l.
Proof.
-Intros; Inversion H; Auto with datatypes.
+intros; inversion H; auto with datatypes.
Qed.
-Lemma sort_rec : (P:(list A)->Set)
- (P (nil A)) ->
- ((a:A)(l:(list A))(sort l)->(P l)->(lelistA a l)->(P (cons a l))) ->
- (y:(list A))(sort y) -> (P y).
+Lemma sort_rec :
+ forall P:list A -> Set,
+ P nil ->
+ (forall (a:A) (l:list A), sort l -> P l -> lelistA a l -> P (a :: l)) ->
+ forall y:list A, sort y -> P y.
Proof.
-Induction y; Auto with datatypes.
-Intros; Elim (!sort_inv a l); Auto with datatypes.
+simple induction y; auto with datatypes.
+intros; elim (sort_inv (a:=a) (l:=l)); auto with datatypes.
Qed.
(** merging two sorted lists *)
-Inductive merge_lem [l1:(list A);l2:(list A)] : Set :=
- merge_exist : (l:(list A))(sort l) ->
- (meq (list_contents eqA_dec l)
- (munion (list_contents eqA_dec l1) (list_contents eqA_dec l2))) ->
- ((a:A)(lelistA a l1)->(lelistA a l2)->(lelistA a l)) ->
- (merge_lem l1 l2).
-
-Lemma merge : (l1:(list A))(sort l1)->(l2:(list A))(sort l2)->(merge_lem l1 l2).
+Inductive merge_lem (l1 l2:list A) : Set :=
+ merge_exist :
+ forall l:list A,
+ sort l ->
+ meq (list_contents _ eqA_dec l)
+ (munion (list_contents _ eqA_dec l1) (list_contents _ eqA_dec l2)) ->
+ (forall a:A, lelistA a l1 -> lelistA a l2 -> lelistA a l) ->
+ merge_lem l1 l2.
+
+Lemma merge :
+ forall l1:list A, sort l1 -> forall l2:list A, sort l2 -> merge_lem l1 l2.
Proof.
- Induction 1; Intros.
- Apply merge_exist with l2; Auto with datatypes.
- Elim H3; Intros.
- Apply merge_exist with (cons a l); Simpl; Auto with datatypes.
- Elim (leA_dec a a0); Intros.
+ simple induction 1; intros.
+ apply merge_exist with l2; auto with datatypes.
+ elim H3; intros.
+ apply merge_exist with (a :: l); simpl in |- *; auto with datatypes.
+ elim (leA_dec a a0); intros.
(* 1 (leA a a0) *)
- Cut (merge_lem l (cons a0 l0)); Auto with datatypes.
- Intros (l3, l3sorted, l3contents, Hrec).
- Apply merge_exist with (cons a l3); Simpl; Auto with datatypes.
- Apply meq_trans with (munion (singletonBag a)
- (munion (list_contents eqA_dec l)
- (list_contents eqA_dec (cons a0 l0)))).
- Apply meq_right; Trivial with datatypes.
- Apply meq_sym; Apply munion_ass.
- Intros; Apply cons_leA.
- Apply lelistA_inv with l; Trivial with datatypes.
+ cut (merge_lem l (a0 :: l0)); auto with datatypes.
+ intros [l3 l3sorted l3contents Hrec].
+ apply merge_exist with (a :: l3); simpl in |- *; auto with datatypes.
+ apply meq_trans with
+ (munion (singletonBag a)
+ (munion (list_contents _ eqA_dec l)
+ (list_contents _ eqA_dec (a0 :: l0)))).
+ apply meq_right; trivial with datatypes.
+ apply meq_sym; apply munion_ass.
+ intros; apply cons_leA.
+ apply lelistA_inv with l; trivial with datatypes.
(* 2 (leA a0 a) *)
- Elim H5; Simpl; Intros.
- Apply merge_exist with (cons a0 l3); Simpl; Auto with datatypes.
- Apply meq_trans with (munion (singletonBag a0)
- (munion (munion (singletonBag a)
- (list_contents eqA_dec l))
- (list_contents eqA_dec l0))).
- Apply meq_right; Trivial with datatypes.
- Apply munion_perm_left.
- Intros; Apply cons_leA; Apply lelistA_inv with l0; Trivial with datatypes.
+ elim H5; simpl in |- *; intros.
+ apply merge_exist with (a0 :: l3); simpl in |- *; auto with datatypes.
+ apply meq_trans with
+ (munion (singletonBag a0)
+ (munion (munion (singletonBag a) (list_contents _ eqA_dec l))
+ (list_contents _ eqA_dec l0))).
+ apply meq_right; trivial with datatypes.
+ apply munion_perm_left.
+ intros; apply cons_leA; apply lelistA_inv with l0; trivial with datatypes.
Qed.
End defs.
Unset Implicit Arguments.
-Hint constr_sort : datatypes v62 := Constructors sort.
-Hint constr_lelistA : datatypes v62 := Constructors lelistA.
+Hint Constructors sort: datatypes v62.
+Hint Constructors lelistA: datatypes v62. \ No newline at end of file
diff --git a/theories/Wellfounded/Disjoint_Union.v b/theories/Wellfounded/Disjoint_Union.v
index 44c2f8661..e702dbfde 100644
--- a/theories/Wellfounded/Disjoint_Union.v
+++ b/theories/Wellfounded/Disjoint_Union.v
@@ -12,45 +12,44 @@
From : Constructing Recursion Operators in Type Theory
L. Paulson JSC (1986) 2, 325-355 *)
-Require Relation_Operators.
+Require Import Relation_Operators.
Section Wf_Disjoint_Union.
-Variable A,B:Set.
-Variable leA: A->A->Prop.
-Variable leB: B->B->Prop.
+Variables A B : Set.
+Variable leA : A -> A -> Prop.
+Variable leB : B -> B -> Prop.
Notation Le_AsB := (le_AsB A B leA leB).
-Lemma acc_A_sum: (x:A)(Acc A leA x)->(Acc A+B Le_AsB (inl A B x)).
+Lemma acc_A_sum : forall x:A, Acc leA x -> Acc Le_AsB (inl B x).
Proof.
- NewInduction 1.
- Apply Acc_intro;Intros y H2.
- Inversion_clear H2.
- Auto with sets.
+ induction 1.
+ apply Acc_intro; intros y H2.
+ inversion_clear H2.
+ auto with sets.
Qed.
-Lemma acc_B_sum: (well_founded A leA) ->(x:B)(Acc B leB x)
- ->(Acc A+B Le_AsB (inr A B x)).
+Lemma acc_B_sum :
+ well_founded leA -> forall x:B, Acc leB x -> Acc Le_AsB (inr A x).
Proof.
- NewInduction 2.
- Apply Acc_intro;Intros y H3.
- Inversion_clear H3;Auto with sets.
- Apply acc_A_sum;Auto with sets.
+ induction 2.
+ apply Acc_intro; intros y H3.
+ inversion_clear H3; auto with sets.
+ apply acc_A_sum; auto with sets.
Qed.
-Lemma wf_disjoint_sum:
- (well_founded A leA)
- -> (well_founded B leB) -> (well_founded A+B Le_AsB).
+Lemma wf_disjoint_sum :
+ well_founded leA -> well_founded leB -> well_founded Le_AsB.
Proof.
- Intros.
- Unfold well_founded .
- NewDestruct a as [a|b].
- Apply (acc_A_sum a).
- Apply (H a).
-
- Apply (acc_B_sum H b).
- Apply (H0 b).
+ intros.
+ unfold well_founded in |- *.
+ destruct a as [a| b].
+ apply (acc_A_sum a).
+ apply (H a).
+
+ apply (acc_B_sum H b).
+ apply (H0 b).
Qed.
-End Wf_Disjoint_Union.
+End Wf_Disjoint_Union. \ No newline at end of file
diff --git a/theories/Wellfounded/Inclusion.v b/theories/Wellfounded/Inclusion.v
index 2038b34bf..2508011dc 100644
--- a/theories/Wellfounded/Inclusion.v
+++ b/theories/Wellfounded/Inclusion.v
@@ -10,24 +10,23 @@
(** Author: Bruno Barras *)
-Require Relation_Definitions.
+Require Import Relation_Definitions.
Section WfInclusion.
- Variable A:Set.
- Variable R1,R2:A->A->Prop.
+ Variable A : Set.
+ Variables R1 R2 : A -> A -> Prop.
- Lemma Acc_incl: (inclusion A R1 R2)->(z:A)(Acc A R2 z)->(Acc A R1 z).
+ Lemma Acc_incl : inclusion A R1 R2 -> forall z:A, Acc R2 z -> Acc R1 z.
Proof.
- NewInduction 2.
- Apply Acc_intro;Auto with sets.
+ induction 2.
+ apply Acc_intro; auto with sets.
Qed.
- Hints Resolve Acc_incl.
+ Hint Resolve Acc_incl.
- Theorem wf_incl:
- (inclusion A R1 R2)->(well_founded A R2)->(well_founded A R1).
+ Theorem wf_incl : inclusion A R1 R2 -> well_founded R2 -> well_founded R1.
Proof.
- Unfold well_founded ;Auto with sets.
+ unfold well_founded in |- *; auto with sets.
Qed.
-End WfInclusion.
+End WfInclusion. \ No newline at end of file
diff --git a/theories/Wellfounded/Inverse_Image.v b/theories/Wellfounded/Inverse_Image.v
index ac828ac1a..66a7f5b5b 100644
--- a/theories/Wellfounded/Inverse_Image.v
+++ b/theories/Wellfounded/Inverse_Image.v
@@ -12,47 +12,44 @@
Section Inverse_Image.
- Variables A,B:Set.
- Variable R : B->B->Prop.
- Variable f:A->B.
+ Variables A B : Set.
+ Variable R : B -> B -> Prop.
+ Variable f : A -> B.
- Local Rof : A->A->Prop := [x,y:A](R (f x) (f y)).
+ Let Rof (x y:A) : Prop := R (f x) (f y).
- Remark Acc_lemma : (y:B)(Acc B R y)->(x:A)(y=(f x))->(Acc A Rof x).
- NewInduction 1 as [y _ IHAcc]; Intros x H.
- Apply Acc_intro; Intros y0 H1.
- Apply (IHAcc (f y0)); Try Trivial.
- Rewrite H; Trivial.
+ Remark Acc_lemma : forall y:B, Acc R y -> forall x:A, y = f x -> Acc Rof x.
+ induction 1 as [y _ IHAcc]; intros x H.
+ apply Acc_intro; intros y0 H1.
+ apply (IHAcc (f y0)); try trivial.
+ rewrite H; trivial.
Qed.
- Lemma Acc_inverse_image : (x:A)(Acc B R (f x)) -> (Acc A Rof x).
- Intros; Apply (Acc_lemma (f x)); Trivial.
+ Lemma Acc_inverse_image : forall x:A, Acc R (f x) -> Acc Rof x.
+ intros; apply (Acc_lemma (f x)); trivial.
Qed.
- Theorem wf_inverse_image: (well_founded B R)->(well_founded A Rof).
- Red; Intros; Apply Acc_inverse_image; Auto.
+ Theorem wf_inverse_image : well_founded R -> well_founded Rof.
+ red in |- *; intros; apply Acc_inverse_image; auto.
Qed.
Variable F : A -> B -> Prop.
- Local RoF : A -> A -> Prop := [x,y]
- (EX b : B | (F x b) & (c:B)(F y c)->(R b c)).
+ Let RoF (x y:A) : Prop :=
+ exists2 b : B | F x b & (forall c:B, F y c -> R b c).
-Lemma Acc_inverse_rel :
- (b:B)(Acc B R b)->(x:A)(F x b)->(Acc A RoF x).
-NewInduction 1 as [x _ IHAcc]; Intros x0 H2.
-Constructor; Intros y H3.
-NewDestruct H3.
-Apply (IHAcc x1); Auto.
-Save.
+Lemma Acc_inverse_rel : forall b:B, Acc R b -> forall x:A, F x b -> Acc RoF x.
+induction 1 as [x _ IHAcc]; intros x0 H2.
+constructor; intros y H3.
+destruct H3.
+apply (IHAcc x1); auto.
+Qed.
-Theorem wf_inverse_rel :
- (well_founded B R)->(well_founded A RoF).
- Red; Constructor; Intros.
- Case H0; Intros.
- Apply (Acc_inverse_rel x); Auto.
-Save.
+Theorem wf_inverse_rel : well_founded R -> well_founded RoF.
+ red in |- *; constructor; intros.
+ case H0; intros.
+ apply (Acc_inverse_rel x); auto.
+Qed.
End Inverse_Image.
-
diff --git a/theories/Wellfounded/Lexicographic_Exponentiation.v b/theories/Wellfounded/Lexicographic_Exponentiation.v
index 8efa124c3..e8203c399 100644
--- a/theories/Wellfounded/Lexicographic_Exponentiation.v
+++ b/theories/Wellfounded/Lexicographic_Exponentiation.v
@@ -13,15 +13,14 @@
From : Constructing Recursion Operators in Type Theory
L. Paulson JSC (1986) 2, 325-355 *)
-Require Eqdep.
-Require PolyList.
-Require PolyListSyntax.
-Require Relation_Operators.
-Require Transitive_Closure.
+Require Import Eqdep.
+Require Import List.
+Require Import Relation_Operators.
+Require Import Transitive_Closure.
Section Wf_Lexicographic_Exponentiation.
-Variable A:Set.
-Variable leA: A->A->Prop.
+Variable A : Set.
+Variable leA : A -> A -> Prop.
Notation Power := (Pow A leA).
Notation Lex_Exp := (lex_exp A leA).
@@ -29,358 +28,347 @@ Notation ltl := (Ltl A leA).
Notation Descl := (Desc A leA).
Notation List := (list A).
-Notation Nil := (nil A).
+Notation Nil := (nil (A:=A)).
(* useless but symmetric *)
-Notation Cons := (cons 1!A).
-Notation "<< x , y >>" := (exist List Descl x y) (at level 0)
- V8only (at level 0, x,y at level 100).
-
-V7only[
-Syntax constr
- level 1:
- List [ (list A) ] -> ["List"]
- | Nil [ (nil A) ] -> ["Nil"]
- | Cons [ (cons A) ] -> ["Cons"]
- ;
- level 10:
- Cons2 [ (cons A $e $l) ] -> ["Cons " $e:L " " $l:L ].
-
-Syntax constr
- level 1:
- pair_sig [ (exist (list A) Desc $e $d) ] -> ["<<" $e:L "," $d:L ">>"].
-].
-Hints Resolve d_one d_nil t_step.
-
-Lemma left_prefix : (x,y,z:List)(ltl x^y z)-> (ltl x z).
+Notation Cons := (cons (A:=A)).
+Notation "<< x , y >>" := (exist Descl x y) (at level 0, x, y at level 100).
+
+Hint Resolve d_one d_nil t_step.
+
+Lemma left_prefix : forall x y z:List, ltl (x ++ y) z -> ltl x z.
Proof.
- Induction x.
- Induction z.
- Simpl;Intros H.
- Inversion_clear H.
- Simpl;Intros;Apply (Lt_nil A leA).
- Intros a l HInd.
- Simpl.
- Intros.
- Inversion_clear H.
- Apply (Lt_hd A leA);Auto with sets.
- Apply (Lt_tl A leA).
- Apply (HInd y y0);Auto with sets.
+ simple induction x.
+ simple induction z.
+ simpl in |- *; intros H.
+ inversion_clear H.
+ simpl in |- *; intros; apply (Lt_nil A leA).
+ intros a l HInd.
+ simpl in |- *.
+ intros.
+ inversion_clear H.
+ apply (Lt_hd A leA); auto with sets.
+ apply (Lt_tl A leA).
+ apply (HInd y y0); auto with sets.
Qed.
-Lemma right_prefix :
- (x,y,z:List)(ltl x y^z)-> (ltl x y) \/ (EX y':List | x=(y^y') /\ (ltl y' z)).
+Lemma right_prefix :
+ forall x y z:List,
+ ltl x (y ++ z) -> ltl x y \/ ( exists y' : List | x = y ++ y' /\ ltl y' z).
Proof.
- Intros x y;Generalize x.
- Elim y;Simpl.
- Right.
- Exists x0 ;Auto with sets.
- Intros.
- Inversion H0.
- Left;Apply (Lt_nil A leA).
- Left;Apply (Lt_hd A leA);Auto with sets.
- Generalize (H x1 z H3) .
- Induction 1.
- Left;Apply (Lt_tl A leA);Auto with sets.
- Induction 1.
- Induction 1;Intros.
- Rewrite -> H8.
- Right;Exists x2 ;Auto with sets.
+ intros x y; generalize x.
+ elim y; simpl in |- *.
+ right.
+ exists x0; auto with sets.
+ intros.
+ inversion H0.
+ left; apply (Lt_nil A leA).
+ left; apply (Lt_hd A leA); auto with sets.
+ generalize (H x1 z H3).
+ simple induction 1.
+ left; apply (Lt_tl A leA); auto with sets.
+ simple induction 1.
+ simple induction 1; intros.
+ rewrite H8.
+ right; exists x2; auto with sets.
Qed.
-Lemma desc_prefix: (x:List)(a:A)(Descl x^(Cons a Nil))->(Descl x).
+Lemma desc_prefix : forall (x:List) (a:A), Descl (x ++ Cons a Nil) -> Descl x.
Proof.
- Intros.
- Inversion H.
- Generalize (app_cons_not_nil H1); Induction 1.
- Cut (x^(Cons a Nil))=(Cons x0 Nil); Auto with sets.
- Intro.
- Generalize (app_eq_unit H0) .
- Induction 1; Induction 1; Intros.
- Rewrite -> H4; Auto with sets.
- Discriminate H5.
- Generalize (app_inj_tail H0) .
- Induction 1; Intros.
- Rewrite <- H4; Auto with sets.
+ intros.
+ inversion H.
+ generalize (app_cons_not_nil _ _ _ H1); simple induction 1.
+ cut (x ++ Cons a Nil = Cons x0 Nil); auto with sets.
+ intro.
+ generalize (app_eq_unit _ _ H0).
+ simple induction 1; simple induction 1; intros.
+ rewrite H4; auto with sets.
+ discriminate H5.
+ generalize (app_inj_tail _ _ _ _ H0).
+ simple induction 1; intros.
+ rewrite <- H4; auto with sets.
Qed.
-Lemma desc_tail: (x:List)(a,b:A)
- (Descl (Cons b (x^(Cons a Nil))))-> (clos_trans A leA a b).
+Lemma desc_tail :
+ forall (x:List) (a b:A),
+ Descl (Cons b (x ++ Cons a Nil)) -> clos_trans A leA a b.
Proof.
- Intro.
- Apply rev_ind with A:=A
- P:=[x:List](a,b:A)
- (Descl (Cons b (x^(Cons a Nil))))-> (clos_trans A leA a b).
- Intros.
-
- Inversion H.
- Cut (Cons b (Cons a Nil))= ((Nil^(Cons b Nil))^ (Cons a Nil)); Auto with sets; Intro.
- Generalize H0.
- Intro.
- Generalize (app_inj_tail 2!(l^(Cons y Nil)) 3!(Nil^(Cons b Nil)) H4);
- Induction 1.
- Intros.
-
- Generalize (app_inj_tail H6); Induction 1; Intros.
- Generalize H1.
- Rewrite <- H10; Rewrite <- H7; Intro.
- Apply (t_step A leA); Auto with sets.
-
-
-
- Intros.
- Inversion H0.
- Generalize (app_cons_not_nil H3); Intro.
- Elim H1.
-
- Generalize H0.
- Generalize (app_comm_cons (l^(Cons x0 Nil)) (Cons a Nil) b); Induction 1.
- Intro.
- Generalize (desc_prefix (Cons b (l^(Cons x0 Nil))) a H5); Intro.
- Generalize (H x0 b H6).
- Intro.
- Apply t_trans with A:=A y:=x0; Auto with sets.
-
- Apply t_step.
- Generalize H1.
- Rewrite -> H4; Intro.
-
- Generalize (app_inj_tail H8); Induction 1.
- Intros.
- Generalize H2; Generalize (app_comm_cons l (Cons x0 Nil) b).
- Intro.
- Generalize H10.
- Rewrite ->H12; Intro.
- Generalize (app_inj_tail H13); Induction 1.
- Intros.
- Rewrite <- H11; Rewrite <- H16; Auto with sets.
+ intro.
+ apply rev_ind with
+ (A := A)
+ (P := fun x:List =>
+ forall a b:A,
+ Descl (Cons b (x ++ Cons a Nil)) -> clos_trans A leA a b).
+ intros.
+
+ inversion H.
+ cut (Cons b (Cons a Nil) = (Nil ++ Cons b Nil) ++ Cons a Nil);
+ auto with sets; intro.
+ generalize H0.
+ intro.
+ generalize (app_inj_tail (l ++ Cons y Nil) (Nil ++ Cons b Nil) _ _ H4);
+ simple induction 1.
+ intros.
+
+ generalize (app_inj_tail _ _ _ _ H6); simple induction 1; intros.
+ generalize H1.
+ rewrite <- H10; rewrite <- H7; intro.
+ apply (t_step A leA); auto with sets.
+
+
+
+ intros.
+ inversion H0.
+ generalize (app_cons_not_nil _ _ _ H3); intro.
+ elim H1.
+
+ generalize H0.
+ generalize (app_comm_cons (l ++ Cons x0 Nil) (Cons a Nil) b);
+ simple induction 1.
+ intro.
+ generalize (desc_prefix (Cons b (l ++ Cons x0 Nil)) a H5); intro.
+ generalize (H x0 b H6).
+ intro.
+ apply t_trans with (A := A) (y := x0); auto with sets.
+
+ apply t_step.
+ generalize H1.
+ rewrite H4; intro.
+
+ generalize (app_inj_tail _ _ _ _ H8); simple induction 1.
+ intros.
+ generalize H2; generalize (app_comm_cons l (Cons x0 Nil) b).
+ intro.
+ generalize H10.
+ rewrite H12; intro.
+ generalize (app_inj_tail _ _ _ _ H13); simple induction 1.
+ intros.
+ rewrite <- H11; rewrite <- H16; auto with sets.
Qed.
-Lemma dist_aux : (z:List)(Descl z)->(x,y:List)z=(x^y)->(Descl x)/\ (Descl y).
+Lemma dist_aux :
+ forall z:List, Descl z -> forall x y:List, z = x ++ y -> Descl x /\ Descl y.
Proof.
- Intros z D.
- Elim D.
- Intros.
- Cut (x^y)=Nil;Auto with sets; Intro.
- Generalize (app_eq_nil H0) ; Induction 1.
- Intros.
- Rewrite -> H2;Rewrite -> H3; Split;Apply d_nil.
-
- Intros.
- Cut (x0^y)=(Cons x Nil); Auto with sets.
- Intros E.
- Generalize (app_eq_unit E); Induction 1.
- Induction 1;Intros.
- Rewrite -> H2;Rewrite -> H3; Split.
- Apply d_nil.
-
- Apply d_one.
-
- Induction 1; Intros.
- Rewrite -> H2;Rewrite -> H3; Split.
- Apply d_one.
-
- Apply d_nil.
-
- Do 5 Intro.
- Intros Hind.
- Do 2 Intro.
- Generalize x0 .
- Apply rev_ind with A:=A
- P:=[y0:List]
- (x0:List)
- ((l^(Cons y Nil))^(Cons x Nil))=(x0^y0)->(Descl x0)/\(Descl y0).
-
- Intro.
- Generalize (app_nil_end x1) ; Induction 1; Induction 1.
- Split. Apply d_conc; Auto with sets.
-
- Apply d_nil.
-
- Do 3 Intro.
- Generalize x1 .
- Apply rev_ind with
- A:=A
- P:=[l0:List]
- (x1:A)
- (x0:List)
- ((l^(Cons y Nil))^(Cons x Nil))=(x0^(l0^(Cons x1 Nil)))
- ->(Descl x0)/\(Descl (l0^(Cons x1 Nil))).
-
-
- Simpl.
- Split.
- Generalize (app_inj_tail H2) ;Induction 1.
- Induction 1;Auto with sets.
-
- Apply d_one.
- Do 5 Intro.
- Generalize (app_ass x4 (l1^(Cons x2 Nil)) (Cons x3 Nil)) .
- Induction 1.
- Generalize (app_ass x4 l1 (Cons x2 Nil)) ;Induction 1.
- Intro E.
- Generalize (app_inj_tail E) .
- Induction 1;Intros.
- Generalize (app_inj_tail H6) ;Induction 1;Intros.
- Rewrite <- H7; Rewrite <- H10; Generalize H6.
- Generalize (app_ass x4 l1 (Cons x2 Nil)); Intro E1.
- Rewrite -> E1.
- Intro.
- Generalize (Hind x4 (l1^(Cons x2 Nil)) H11) .
- Induction 1;Split.
- Auto with sets.
-
- Generalize H14.
- Rewrite <- H10; Intro.
- Apply d_conc;Auto with sets.
+ intros z D.
+ elim D.
+ intros.
+ cut (x ++ y = Nil); auto with sets; intro.
+ generalize (app_eq_nil _ _ H0); simple induction 1.
+ intros.
+ rewrite H2; rewrite H3; split; apply d_nil.
+
+ intros.
+ cut (x0 ++ y = Cons x Nil); auto with sets.
+ intros E.
+ generalize (app_eq_unit _ _ E); simple induction 1.
+ simple induction 1; intros.
+ rewrite H2; rewrite H3; split.
+ apply d_nil.
+
+ apply d_one.
+
+ simple induction 1; intros.
+ rewrite H2; rewrite H3; split.
+ apply d_one.
+
+ apply d_nil.
+
+ do 5 intro.
+ intros Hind.
+ do 2 intro.
+ generalize x0.
+ apply rev_ind with
+ (A := A)
+ (P := fun y0:List =>
+ forall x0:List,
+ (l ++ Cons y Nil) ++ Cons x Nil = x0 ++ y0 ->
+ Descl x0 /\ Descl y0).
+
+ intro.
+ generalize (app_nil_end x1); simple induction 1; simple induction 1.
+ split. apply d_conc; auto with sets.
+
+ apply d_nil.
+
+ do 3 intro.
+ generalize x1.
+ apply rev_ind with
+ (A := A)
+ (P := fun l0:List =>
+ forall (x1:A) (x0:List),
+ (l ++ Cons y Nil) ++ Cons x Nil = x0 ++ l0 ++ Cons x1 Nil ->
+ Descl x0 /\ Descl (l0 ++ Cons x1 Nil)).
+
+
+ simpl in |- *.
+ split.
+ generalize (app_inj_tail _ _ _ _ H2); simple induction 1.
+ simple induction 1; auto with sets.
+
+ apply d_one.
+ do 5 intro.
+ generalize (app_ass x4 (l1 ++ Cons x2 Nil) (Cons x3 Nil)).
+ simple induction 1.
+ generalize (app_ass x4 l1 (Cons x2 Nil)); simple induction 1.
+ intro E.
+ generalize (app_inj_tail _ _ _ _ E).
+ simple induction 1; intros.
+ generalize (app_inj_tail _ _ _ _ H6); simple induction 1; intros.
+ rewrite <- H7; rewrite <- H10; generalize H6.
+ generalize (app_ass x4 l1 (Cons x2 Nil)); intro E1.
+ rewrite E1.
+ intro.
+ generalize (Hind x4 (l1 ++ Cons x2 Nil) H11).
+ simple induction 1; split.
+ auto with sets.
+
+ generalize H14.
+ rewrite <- H10; intro.
+ apply d_conc; auto with sets.
Qed.
-Lemma dist_Desc_concat : (x,y:List)(Descl x^y)->(Descl x)/\(Descl y).
+Lemma dist_Desc_concat :
+ forall x y:List, Descl (x ++ y) -> Descl x /\ Descl y.
Proof.
- Intros.
- Apply (dist_aux (x^y) H x y); Auto with sets.
+ intros.
+ apply (dist_aux (x ++ y) H x y); auto with sets.
Qed.
-Lemma desc_end:(a,b:A)(x:List)
- (Descl x^(Cons a Nil)) /\ (ltl x^(Cons a Nil) (Cons b Nil))
- -> (clos_trans A leA a b).
+Lemma desc_end :
+ forall (a b:A) (x:List),
+ Descl (x ++ Cons a Nil) /\ ltl (x ++ Cons a Nil) (Cons b Nil) ->
+ clos_trans A leA a b.
Proof.
- Intros a b x.
- Case x.
- Simpl.
- Induction 1.
- Intros.
- Inversion H1;Auto with sets.
- Inversion H3.
-
- Induction 1.
- Generalize (app_comm_cons l (Cons a Nil) a0).
- Intros E; Rewrite <- E; Intros.
- Generalize (desc_tail l a a0 H0); Intro.
- Inversion H1.
- Apply t_trans with y:=a0 ;Auto with sets.
-
- Inversion H4.
+ intros a b x.
+ case x.
+ simpl in |- *.
+ simple induction 1.
+ intros.
+ inversion H1; auto with sets.
+ inversion H3.
+
+ simple induction 1.
+ generalize (app_comm_cons l (Cons a Nil) a0).
+ intros E; rewrite <- E; intros.
+ generalize (desc_tail l a a0 H0); intro.
+ inversion H1.
+ apply t_trans with (y := a0); auto with sets.
+
+ inversion H4.
Qed.
-Lemma ltl_unit: (x:List)(a,b:A)
- (Descl (x^(Cons a Nil))) -> (ltl x^(Cons a Nil) (Cons b Nil))
- -> (ltl x (Cons b Nil)).
+Lemma ltl_unit :
+ forall (x:List) (a b:A),
+ Descl (x ++ Cons a Nil) ->
+ ltl (x ++ Cons a Nil) (Cons b Nil) -> ltl x (Cons b Nil).
Proof.
- Intro.
- Case x.
- Intros;Apply (Lt_nil A leA).
+ intro.
+ case x.
+ intros; apply (Lt_nil A leA).
- Simpl;Intros.
- Inversion_clear H0.
- Apply (Lt_hd A leA a b);Auto with sets.
+ simpl in |- *; intros.
+ inversion_clear H0.
+ apply (Lt_hd A leA a b); auto with sets.
- Inversion_clear H1.
+ inversion_clear H1.
Qed.
-Lemma acc_app:
- (x1,x2:List)(y1:(Descl x1^x2))
- (Acc Power Lex_Exp (exist List Descl (x1^x2) y1))
- ->(x:List)
- (y:(Descl x))
- (ltl x (x1^x2))->(Acc Power Lex_Exp (exist List Descl x y)).
+Lemma acc_app :
+ forall (x1 x2:List) (y1:Descl (x1 ++ x2)),
+ Acc Lex_Exp << x1 ++ x2, y1 >> ->
+ forall (x:List) (y:Descl x), ltl x (x1 ++ x2) -> Acc Lex_Exp << x, y >>.
Proof.
- Intros.
- Apply (Acc_inv Power Lex_Exp (exist List Descl (x1^x2) y1)).
- Auto with sets.
+ intros.
+ apply (Acc_inv (R:=Lex_Exp) (x:=<< x1 ++ x2, y1 >>)).
+ auto with sets.
- Unfold lex_exp ;Simpl;Auto with sets.
+ unfold lex_exp in |- *; simpl in |- *; auto with sets.
Qed.
-Theorem wf_lex_exp :
- (well_founded A leA)->(well_founded Power Lex_Exp).
+Theorem wf_lex_exp : well_founded leA -> well_founded Lex_Exp.
Proof.
- Unfold 2 well_founded .
- Induction a;Intros x y.
- Apply Acc_intro.
- Induction y0.
- Unfold 1 lex_exp ;Simpl.
- Apply rev_ind with A:=A P:=[x:List]
- (x0:List)
- (y:(Descl x0))
- (ltl x0 x)
- ->(Acc Power Lex_Exp (exist List Descl x0 y)) .
- Intros.
- Inversion_clear H0.
-
- Intro.
- Generalize (well_founded_ind A (clos_trans A leA) (wf_clos_trans A leA H)).
- Intros GR.
- Apply GR with P:=[x0:A]
- (l:List)
- ((x1:List)
- (y:(Descl x1))
- (ltl x1 l)
- ->(Acc Power Lex_Exp (exist List Descl x1 y)))
- ->(x1:List)
- (y:(Descl x1))
- (ltl x1 (l^(Cons x0 Nil)))
- ->(Acc Power Lex_Exp (exist List Descl x1 y)) .
- Intro;Intros HInd; Intros.
- Generalize (right_prefix x2 l (Cons x1 Nil) H1) .
- Induction 1.
- Intro; Apply (H0 x2 y1 H3).
-
- Induction 1.
- Intro;Induction 1.
- Clear H4 H2.
- Intro;Generalize y1 ;Clear y1.
- Rewrite -> H2.
- Apply rev_ind with A:=A P:=[x3:List]
- (y1:(Descl (l^x3)))
- (ltl x3 (Cons x1 Nil))
- ->(Acc Power Lex_Exp
- (exist List Descl (l^x3) y1)) .
- Intros.
- Generalize (app_nil_end l) ;Intros Heq.
- Generalize y1 .
- Clear y1.
- Rewrite <- Heq.
- Intro.
- Apply Acc_intro.
- Induction y2.
- Unfold 1 lex_exp .
- Simpl;Intros x4 y3. Intros.
- Apply (H0 x4 y3);Auto with sets.
-
- Intros.
- Generalize (dist_Desc_concat l (l0^(Cons x4 Nil)) y1) .
- Induction 1.
- Intros.
- Generalize (desc_end x4 x1 l0 (conj ? ? H8 H5)) ; Intros.
- Generalize y1 .
- Rewrite <- (app_ass l l0 (Cons x4 Nil)); Intro.
- Generalize (HInd x4 H9 (l^l0)) ; Intros HInd2.
- Generalize (ltl_unit l0 x4 x1 H8 H5); Intro.
- Generalize (dist_Desc_concat (l^l0) (Cons x4 Nil) y2) .
- Induction 1;Intros.
- Generalize (H4 H12 H10); Intro.
- Generalize (Acc_inv Power Lex_Exp (exist List Descl (l^l0) H12) H14) .
- Generalize (acc_app l l0 H12 H14).
- Intros f g.
- Generalize (HInd2 f);Intro.
- Apply Acc_intro.
- Induction y3.
- Unfold 1 lex_exp ;Simpl; Intros.
- Apply H15;Auto with sets.
+ unfold well_founded at 2 in |- *.
+ simple induction a; intros x y.
+ apply Acc_intro.
+ simple induction y0.
+ unfold lex_exp at 1 in |- *; simpl in |- *.
+ apply rev_ind with
+ (A := A)
+ (P := fun x:List =>
+ forall (x0:List) (y:Descl x0), ltl x0 x -> Acc Lex_Exp << x0, y >>).
+ intros.
+ inversion_clear H0.
+
+ intro.
+ generalize (well_founded_ind (wf_clos_trans A leA H)).
+ intros GR.
+ apply GR with
+ (P := fun x0:A =>
+ forall l:List,
+ (forall (x1:List) (y:Descl x1),
+ ltl x1 l -> Acc Lex_Exp << x1, y >>) ->
+ forall (x1:List) (y:Descl x1),
+ ltl x1 (l ++ Cons x0 Nil) -> Acc Lex_Exp << x1, y >>).
+ intro; intros HInd; intros.
+ generalize (right_prefix x2 l (Cons x1 Nil) H1).
+ simple induction 1.
+ intro; apply (H0 x2 y1 H3).
+
+ simple induction 1.
+ intro; simple induction 1.
+ clear H4 H2.
+ intro; generalize y1; clear y1.
+ rewrite H2.
+ apply rev_ind with
+ (A := A)
+ (P := fun x3:List =>
+ forall y1:Descl (l ++ x3),
+ ltl x3 (Cons x1 Nil) -> Acc Lex_Exp << l ++ x3, y1 >>).
+ intros.
+ generalize (app_nil_end l); intros Heq.
+ generalize y1.
+ clear y1.
+ rewrite <- Heq.
+ intro.
+ apply Acc_intro.
+ simple induction y2.
+ unfold lex_exp at 1 in |- *.
+ simpl in |- *; intros x4 y3. intros.
+ apply (H0 x4 y3); auto with sets.
+
+ intros.
+ generalize (dist_Desc_concat l (l0 ++ Cons x4 Nil) y1).
+ simple induction 1.
+ intros.
+ generalize (desc_end x4 x1 l0 (conj H8 H5)); intros.
+ generalize y1.
+ rewrite <- (app_ass l l0 (Cons x4 Nil)); intro.
+ generalize (HInd x4 H9 (l ++ l0)); intros HInd2.
+ generalize (ltl_unit l0 x4 x1 H8 H5); intro.
+ generalize (dist_Desc_concat (l ++ l0) (Cons x4 Nil) y2).
+ simple induction 1; intros.
+ generalize (H4 H12 H10); intro.
+ generalize (Acc_inv H14).
+ generalize (acc_app l l0 H12 H14).
+ intros f g.
+ generalize (HInd2 f); intro.
+ apply Acc_intro.
+ simple induction y3.
+ unfold lex_exp at 1 in |- *; simpl in |- *; intros.
+ apply H15; auto with sets.
Qed.
-End Wf_Lexicographic_Exponentiation.
+End Wf_Lexicographic_Exponentiation. \ No newline at end of file
diff --git a/theories/Wellfounded/Lexicographic_Product.v b/theories/Wellfounded/Lexicographic_Product.v
index b8f74c9ff..d457e4190 100644
--- a/theories/Wellfounded/Lexicographic_Product.v
+++ b/theories/Wellfounded/Lexicographic_Product.v
@@ -10,64 +10,65 @@
(** Authors: Bruno Barras, Cristina Cornes *)
-Require Eqdep.
-Require Relation_Operators.
-Require Transitive_Closure.
+Require Import Eqdep.
+Require Import Relation_Operators.
+Require Import Transitive_Closure.
(** From : Constructing Recursion Operators in Type Theory
L. Paulson JSC (1986) 2, 325-355 *)
Section WfLexicographic_Product.
-Variable A:Set.
-Variable B:A->Set.
-Variable leA: A->A->Prop.
-Variable leB: (x:A)(B x)->(B x)->Prop.
+Variable A : Set.
+Variable B : A -> Set.
+Variable leA : A -> A -> Prop.
+Variable leB : forall x:A, B x -> B x -> Prop.
Notation LexProd := (lexprod A B leA leB).
-Hints Resolve t_step Acc_clos_trans wf_clos_trans.
+Hint Resolve t_step Acc_clos_trans wf_clos_trans.
-Lemma acc_A_B_lexprod : (x:A)(Acc A leA x)
- ->((x0:A)(clos_trans A leA x0 x)->(well_founded (B x0) (leB x0)))
- ->(y:(B x))(Acc (B x) (leB x) y)
- ->(Acc (sigS A B) LexProd (existS A B x y)).
+Lemma acc_A_B_lexprod :
+ forall x:A,
+ Acc leA x ->
+ (forall x0:A, clos_trans A leA x0 x -> well_founded (leB x0)) ->
+ forall y:B x, Acc (leB x) y -> Acc LexProd (existS B x y).
Proof.
- NewInduction 1 as [x _ IHAcc]; Intros H2 y.
- NewInduction 1 as [x0 H IHAcc0];Intros.
- Apply Acc_intro.
- NewDestruct y as [x2 y1]; Intro H6.
- Simple Inversion H6; Intro.
- Cut (leA x2 x);Intros.
- Apply IHAcc;Auto with sets.
- Intros.
- Apply H2.
- Apply t_trans with x2 ;Auto with sets.
-
- Red in H2.
- Apply H2.
- Auto with sets.
-
- Injection H1.
- NewDestruct 2.
- Injection H3.
- NewDestruct 2;Auto with sets.
-
- Rewrite <- H1.
- Injection H3; Intros _ Hx1.
- Subst x1.
- Apply IHAcc0.
- Elim inj_pair2 with A B x y' x0; Assumption.
+ induction 1 as [x _ IHAcc]; intros H2 y.
+ induction 1 as [x0 H IHAcc0]; intros.
+ apply Acc_intro.
+ destruct y as [x2 y1]; intro H6.
+ simple inversion H6; intro.
+ cut (leA x2 x); intros.
+ apply IHAcc; auto with sets.
+ intros.
+ apply H2.
+ apply t_trans with x2; auto with sets.
+
+ red in H2.
+ apply H2.
+ auto with sets.
+
+ injection H1.
+ destruct 2.
+ injection H3.
+ destruct 2; auto with sets.
+
+ rewrite <- H1.
+ injection H3; intros _ Hx1.
+ subst x1.
+ apply IHAcc0.
+ elim inj_pair2 with A B x y' x0; assumption.
Qed.
-Theorem wf_lexprod:
- (well_founded A leA) ->((x:A) (well_founded (B x) (leB x)))
- -> (well_founded (sigS A B) LexProd).
+Theorem wf_lexprod :
+ well_founded leA ->
+ (forall x:A, well_founded (leB x)) -> well_founded LexProd.
Proof.
- Intros wfA wfB;Unfold well_founded .
- NewDestruct a.
- Apply acc_A_B_lexprod;Auto with sets;Intros.
- Red in wfB.
- Auto with sets.
+ intros wfA wfB; unfold well_founded in |- *.
+ destruct a.
+ apply acc_A_B_lexprod; auto with sets; intros.
+ red in wfB.
+ auto with sets.
Qed.
@@ -75,10 +76,10 @@ End WfLexicographic_Product.
Section Wf_Symmetric_Product.
- Variable A:Set.
- Variable B:Set.
- Variable leA: A->A->Prop.
- Variable leB: B->B->Prop.
+ Variable A : Set.
+ Variable B : Set.
+ Variable leA : A -> A -> Prop.
+ Variable leB : B -> B -> Prop.
Notation Symprod := (symprod A B leA leB).
@@ -101,24 +102,24 @@ Proof.
Qed.
i*)
- Lemma Acc_symprod: (x:A)(Acc A leA x)->(y:B)(Acc B leB y)
- ->(Acc (A*B) Symprod (x,y)).
+ Lemma Acc_symprod :
+ forall x:A, Acc leA x -> forall y:B, Acc leB y -> Acc Symprod (x, y).
Proof.
- NewInduction 1 as [x _ IHAcc]; Intros y H2.
- NewInduction H2 as [x1 H3 IHAcc1].
- Apply Acc_intro;Intros y H5.
- Inversion_clear H5;Auto with sets.
- Apply IHAcc; Auto.
- Apply Acc_intro;Trivial.
+ induction 1 as [x _ IHAcc]; intros y H2.
+ induction H2 as [x1 H3 IHAcc1].
+ apply Acc_intro; intros y H5.
+ inversion_clear H5; auto with sets.
+ apply IHAcc; auto.
+ apply Acc_intro; trivial.
Qed.
-Lemma wf_symprod: (well_founded A leA)->(well_founded B leB)
- ->(well_founded (A*B) Symprod).
+Lemma wf_symprod :
+ well_founded leA -> well_founded leB -> well_founded Symprod.
Proof.
- Red.
- NewDestruct a.
- Apply Acc_symprod;Auto with sets.
+ red in |- *.
+ destruct a.
+ apply Acc_symprod; auto with sets.
Qed.
End Wf_Symmetric_Product.
@@ -126,66 +127,66 @@ End Wf_Symmetric_Product.
Section Swap.
- Variable A:Set.
- Variable R:A->A->Prop.
+ Variable A : Set.
+ Variable R : A -> A -> Prop.
- Notation SwapProd :=(swapprod A R).
+ Notation SwapProd := (swapprod A R).
- Lemma swap_Acc: (x,y:A)(Acc A*A SwapProd (x,y))->(Acc A*A SwapProd (y,x)).
+ Lemma swap_Acc : forall x y:A, Acc SwapProd (x, y) -> Acc SwapProd (y, x).
Proof.
- Intros.
- Inversion_clear H.
- Apply Acc_intro.
- NewDestruct y0;Intros.
- Inversion_clear H;Inversion_clear H1;Apply H0.
- Apply sp_swap.
- Apply right_sym;Auto with sets.
-
- Apply sp_swap.
- Apply left_sym;Auto with sets.
-
- Apply sp_noswap.
- Apply right_sym;Auto with sets.
-
- Apply sp_noswap.
- Apply left_sym;Auto with sets.
+ intros.
+ inversion_clear H.
+ apply Acc_intro.
+ destruct y0; intros.
+ inversion_clear H; inversion_clear H1; apply H0.
+ apply sp_swap.
+ apply right_sym; auto with sets.
+
+ apply sp_swap.
+ apply left_sym; auto with sets.
+
+ apply sp_noswap.
+ apply right_sym; auto with sets.
+
+ apply sp_noswap.
+ apply left_sym; auto with sets.
Qed.
- Lemma Acc_swapprod: (x,y:A)(Acc A R x)->(Acc A R y)
- ->(Acc A*A SwapProd (x,y)).
+ Lemma Acc_swapprod :
+ forall x y:A, Acc R x -> Acc R y -> Acc SwapProd (x, y).
Proof.
- NewInduction 1 as [x0 _ IHAcc0];Intros H2.
- Cut (y0:A)(R y0 x0)->(Acc ? SwapProd (y0,y)).
- Clear IHAcc0.
- NewInduction H2 as [x1 _ IHAcc1]; Intros H4.
- Cut (y:A)(R y x1)->(Acc ? SwapProd (x0,y)).
- Clear IHAcc1.
- Intro.
- Apply Acc_intro.
- NewDestruct y; Intro H5.
- Inversion_clear H5.
- Inversion_clear H0;Auto with sets.
-
- Apply swap_Acc.
- Inversion_clear H0;Auto with sets.
-
- Intros.
- Apply IHAcc1;Auto with sets;Intros.
- Apply Acc_inv with (y0,x1) ;Auto with sets.
- Apply sp_noswap.
- Apply right_sym;Auto with sets.
-
- Auto with sets.
+ induction 1 as [x0 _ IHAcc0]; intros H2.
+ cut (forall y0:A, R y0 x0 -> Acc SwapProd (y0, y)).
+ clear IHAcc0.
+ induction H2 as [x1 _ IHAcc1]; intros H4.
+ cut (forall y:A, R y x1 -> Acc SwapProd (x0, y)).
+ clear IHAcc1.
+ intro.
+ apply Acc_intro.
+ destruct y; intro H5.
+ inversion_clear H5.
+ inversion_clear H0; auto with sets.
+
+ apply swap_Acc.
+ inversion_clear H0; auto with sets.
+
+ intros.
+ apply IHAcc1; auto with sets; intros.
+ apply Acc_inv with (y0, x1); auto with sets.
+ apply sp_noswap.
+ apply right_sym; auto with sets.
+
+ auto with sets.
Qed.
- Lemma wf_swapprod: (well_founded A R)->(well_founded A*A SwapProd).
+ Lemma wf_swapprod : well_founded R -> well_founded SwapProd.
Proof.
- Red.
- NewDestruct a;Intros.
- Apply Acc_swapprod;Auto with sets.
+ red in |- *.
+ destruct a; intros.
+ apply Acc_swapprod; auto with sets.
Qed.
-End Swap.
+End Swap. \ No newline at end of file
diff --git a/theories/Wellfounded/Transitive_Closure.v b/theories/Wellfounded/Transitive_Closure.v
index c650d4675..b2af4dd85 100644
--- a/theories/Wellfounded/Transitive_Closure.v
+++ b/theories/Wellfounded/Transitive_Closure.v
@@ -10,38 +10,38 @@
(** Author: Bruno Barras *)
-Require Relation_Definitions.
-Require Relation_Operators.
+Require Import Relation_Definitions.
+Require Import Relation_Operators.
Section Wf_Transitive_Closure.
- Variable A: Set.
- Variable R: (relation A).
+ Variable A : Set.
+ Variable R : relation A.
Notation trans_clos := (clos_trans A R).
- Lemma incl_clos_trans: (inclusion A R trans_clos).
- Red;Auto with sets.
+ Lemma incl_clos_trans : inclusion A R trans_clos.
+ red in |- *; auto with sets.
Qed.
- Lemma Acc_clos_trans: (x:A)(Acc A R x)->(Acc A trans_clos x).
- NewInduction 1 as [x0 _ H1].
- Apply Acc_intro.
- Intros y H2.
- NewInduction H2;Auto with sets.
- Apply Acc_inv with y ;Auto with sets.
+ Lemma Acc_clos_trans : forall x:A, Acc R x -> Acc trans_clos x.
+ induction 1 as [x0 _ H1].
+ apply Acc_intro.
+ intros y H2.
+ induction H2; auto with sets.
+ apply Acc_inv with y; auto with sets.
Qed.
- Hints Resolve Acc_clos_trans.
+ Hint Resolve Acc_clos_trans.
- Lemma Acc_inv_trans: (x,y:A)(trans_clos y x)->(Acc A R x)->(Acc A R y).
+ Lemma Acc_inv_trans : forall x y:A, trans_clos y x -> Acc R x -> Acc R y.
Proof.
- NewInduction 1 as [|x y];Auto with sets.
- Intro; Apply Acc_inv with y; Assumption.
+ induction 1 as [| x y]; auto with sets.
+ intro; apply Acc_inv with y; assumption.
Qed.
- Theorem wf_clos_trans: (well_founded A R) ->(well_founded A trans_clos).
+ Theorem wf_clos_trans : well_founded R -> well_founded trans_clos.
Proof.
- Unfold well_founded;Auto with sets.
+ unfold well_founded in |- *; auto with sets.
Qed.
-End Wf_Transitive_Closure.
+End Wf_Transitive_Closure. \ No newline at end of file
diff --git a/theories/Wellfounded/Union.v b/theories/Wellfounded/Union.v
index ee45a9476..d7f241dd0 100644
--- a/theories/Wellfounded/Union.v
+++ b/theories/Wellfounded/Union.v
@@ -10,65 +10,68 @@
(** Author: Bruno Barras *)
-Require Relation_Operators.
-Require Relation_Definitions.
-Require Transitive_Closure.
+Require Import Relation_Operators.
+Require Import Relation_Definitions.
+Require Import Transitive_Closure.
Section WfUnion.
- Variable A: Set.
- Variable R1,R2: (relation A).
+ Variable A : Set.
+ Variables R1 R2 : relation A.
Notation Union := (union A R1 R2).
- Hints Resolve Acc_clos_trans wf_clos_trans.
+ Hint Resolve Acc_clos_trans wf_clos_trans.
-Remark strip_commut:
- (commut A R1 R2)->(x,y:A)(clos_trans A R1 y x)->(z:A)(R2 z y)
- ->(EX y':A | (R2 y' x) & (clos_trans A R1 z y')).
+Remark strip_commut :
+ commut A R1 R2 ->
+ forall x y:A,
+ clos_trans A R1 y x ->
+ forall z:A, R2 z y -> exists2 y' : A | R2 y' x & clos_trans A R1 z y'.
Proof.
- NewInduction 2 as [x y|x y z H0 IH1 H1 IH2]; Intros.
- Elim H with y x z ;Auto with sets;Intros x0 H2 H3.
- Exists x0;Auto with sets.
+ induction 2 as [x y| x y z H0 IH1 H1 IH2]; intros.
+ elim H with y x z; auto with sets; intros x0 H2 H3.
+ exists x0; auto with sets.
- Elim IH1 with z0 ;Auto with sets;Intros.
- Elim IH2 with x0 ;Auto with sets;Intros.
- Exists x1;Auto with sets.
- Apply t_trans with x0; Auto with sets.
+ elim IH1 with z0; auto with sets; intros.
+ elim IH2 with x0; auto with sets; intros.
+ exists x1; auto with sets.
+ apply t_trans with x0; auto with sets.
Qed.
- Lemma Acc_union: (commut A R1 R2)->((x:A)(Acc A R2 x)->(Acc A R1 x))
- ->(a:A)(Acc A R2 a)->(Acc A Union a).
+ Lemma Acc_union :
+ commut A R1 R2 ->
+ (forall x:A, Acc R2 x -> Acc R1 x) -> forall a:A, Acc R2 a -> Acc Union a.
Proof.
- NewInduction 3 as [x H1 H2].
- Apply Acc_intro;Intros.
- Elim H3;Intros;Auto with sets.
- Cut (clos_trans A R1 y x);Auto with sets.
- ElimType (Acc A (clos_trans A R1) y);Intros.
- Apply Acc_intro;Intros.
- Elim H8;Intros.
- Apply H6;Auto with sets.
- Apply t_trans with x0 ;Auto with sets.
+ induction 3 as [x H1 H2].
+ apply Acc_intro; intros.
+ elim H3; intros; auto with sets.
+ cut (clos_trans A R1 y x); auto with sets.
+ elimtype (Acc (clos_trans A R1) y); intros.
+ apply Acc_intro; intros.
+ elim H8; intros.
+ apply H6; auto with sets.
+ apply t_trans with x0; auto with sets.
- Elim strip_commut with x x0 y0 ;Auto with sets;Intros.
- Apply Acc_inv_trans with x1 ;Auto with sets.
- Unfold union .
- Elim H11;Auto with sets;Intros.
- Apply t_trans with y1 ;Auto with sets.
+ elim strip_commut with x x0 y0; auto with sets; intros.
+ apply Acc_inv_trans with x1; auto with sets.
+ unfold union in |- *.
+ elim H11; auto with sets; intros.
+ apply t_trans with y1; auto with sets.
- Apply (Acc_clos_trans A).
- Apply Acc_inv with x ;Auto with sets.
- Apply H0.
- Apply Acc_intro;Auto with sets.
+ apply (Acc_clos_trans A).
+ apply Acc_inv with x; auto with sets.
+ apply H0.
+ apply Acc_intro; auto with sets.
Qed.
- Theorem wf_union: (commut A R1 R2)->(well_founded A R1)->(well_founded A R2)
- ->(well_founded A Union).
+ Theorem wf_union :
+ commut A R1 R2 -> well_founded R1 -> well_founded R2 -> well_founded Union.
Proof.
- Unfold well_founded .
- Intros.
- Apply Acc_union;Auto with sets.
+ unfold well_founded in |- *.
+ intros.
+ apply Acc_union; auto with sets.
Qed.
-End WfUnion.
+End WfUnion. \ No newline at end of file
diff --git a/theories/Wellfounded/Well_Ordering.v b/theories/Wellfounded/Well_Ordering.v
index 49595dd2b..c4c7daa98 100644
--- a/theories/Wellfounded/Well_Ordering.v
+++ b/theories/Wellfounded/Well_Ordering.v
@@ -12,36 +12,36 @@
From: Constructing Recursion Operators in Type Theory
L. Paulson JSC (1986) 2, 325-355 *)
-Require Eqdep.
+Require Import Eqdep.
Section WellOrdering.
-Variable A:Set.
-Variable B:A->Set.
+Variable A : Set.
+Variable B : A -> Set.
Inductive WO : Set :=
- sup : (a:A)(f:(B a)->WO)WO.
+ sup : forall (a:A) (f:B a -> WO), WO.
-Inductive le_WO : WO->WO->Prop :=
- le_sup : (a:A)(f:(B a)->WO)(v:(B a)) (le_WO (f v) (sup a f)).
+Inductive le_WO : WO -> WO -> Prop :=
+ le_sup : forall (a:A) (f:B a -> WO) (v:B a), le_WO (f v) (sup a f).
-Theorem wf_WO : (well_founded WO le_WO ).
+Theorem wf_WO : well_founded le_WO.
Proof.
- Unfold well_founded ;Intro.
- Apply Acc_intro.
- Elim a.
- Intros.
- Inversion H0.
- Apply Acc_intro.
- Generalize H4 ;Generalize H1 ;Generalize f0 ;Generalize v.
- Rewrite -> H3.
- Intros.
- Apply (H v0 y0).
- Cut (eq ? f f1).
- Intros E;Rewrite -> E;Auto.
- Symmetry.
- Apply (inj_pair2 A [a0:A](B a0)->WO a0 f1 f H5).
+ unfold well_founded in |- *; intro.
+ apply Acc_intro.
+ elim a.
+ intros.
+ inversion H0.
+ apply Acc_intro.
+ generalize H4; generalize H1; generalize f0; generalize v.
+ rewrite H3.
+ intros.
+ apply (H v0 y0).
+ cut (f = f1).
+ intros E; rewrite E; auto.
+ symmetry in |- *.
+ apply (inj_pair2 A (fun a0:A => B a0 -> WO) a0 f1 f H5).
Qed.
End WellOrdering.
@@ -53,20 +53,20 @@ Section Characterisation_wf_relations.
(* in course of development *)
-Variable A:Set.
-Variable leA:A->A->Prop.
+Variable A : Set.
+Variable leA : A -> A -> Prop.
-Definition B:= [a:A] {x:A | (leA x a)}.
+Definition B (a:A) := {x : A | leA x a}.
-Definition wof: (well_founded A leA)-> A-> (WO A B).
+Definition wof : well_founded leA -> A -> WO A B.
Proof.
- Intros.
- Apply (well_founded_induction A leA H [a:A](WO A B));Auto.
- Intros.
- Apply (sup A B x).
- Unfold 1 B .
- NewDestruct 1 as [x0].
- Apply (H1 x0);Auto.
+ intros.
+ apply (well_founded_induction H (fun a:A => WO A B)); auto.
+ intros.
+ apply (sup A B x).
+ unfold B at 1 in |- *.
+ destruct 1 as [x0].
+ apply (H1 x0); auto.
Qed.
-End Characterisation_wf_relations.
+End Characterisation_wf_relations. \ No newline at end of file
diff --git a/theories/Wellfounded/Wellfounded.v b/theories/Wellfounded/Wellfounded.v
index 10fca099c..65218643f 100644
--- a/theories/Wellfounded/Wellfounded.v
+++ b/theories/Wellfounded/Wellfounded.v
@@ -17,4 +17,3 @@ Require Export Transitive_Closure.
Require Export Union.
Require Export Well_Ordering.
-
diff --git a/theories/ZArith/BinInt.v b/theories/ZArith/BinInt.v
index 81cf64770..b6980123a 100644
--- a/theories/ZArith/BinInt.v
+++ b/theories/ZArith/BinInt.v
@@ -14,176 +14,179 @@
Require Export BinPos.
Require Export Pnat.
-Require BinNat.
-Require Plus.
-Require Mult.
+Require Import BinNat.
+Require Import Plus.
+Require Import Mult.
(**********************************************************************)
(** Binary integer numbers *)
-Inductive Z : Set :=
- ZERO : Z | POS : positive -> Z | NEG : positive -> Z.
+Inductive Z : Set :=
+ | Z0 : Z
+ | Zpos : positive -> Z
+ | Zneg : positive -> Z.
(** Declare Scope Z_scope with Key Z *)
-Delimits Scope Z_scope with Z.
+Delimit Scope Z_scope with Z.
(** Automatically open scope positive_scope for the constructors of Z *)
Bind Scope Z_scope with Z.
-Arguments Scope POS [ positive_scope ].
-Arguments Scope NEG [ positive_scope ].
+Arguments Scope Zpos [positive_scope].
+Arguments Scope Zneg [positive_scope].
(** Subtraction of positive into Z *)
-Definition Zdouble_plus_one [x:Z] :=
- Cases x of
- | ZERO => (POS xH)
- | (POS p) => (POS (xI p))
- | (NEG p) => (NEG (double_moins_un p))
+Definition Zdouble_plus_one (x:Z) :=
+ match x with
+ | Z0 => Zpos 1
+ | Zpos p => Zpos (xI p)
+ | Zneg p => Zneg (Pdouble_minus_one p)
end.
-Definition Zdouble_minus_one [x:Z] :=
- Cases x of
- | ZERO => (NEG xH)
- | (NEG p) => (NEG (xI p))
- | (POS p) => (POS (double_moins_un p))
+Definition Zdouble_minus_one (x:Z) :=
+ match x with
+ | Z0 => Zneg 1
+ | Zneg p => Zneg (xI p)
+ | Zpos p => Zpos (Pdouble_minus_one p)
end.
-Definition Zdouble [x:Z] :=
- Cases x of
- | ZERO => ZERO
- | (POS p) => (POS (xO p))
- | (NEG p) => (NEG (xO p))
- end.
-
-Fixpoint ZPminus [x,y:positive] : Z :=
- Cases x y of
- | (xI x') (xI y') => (Zdouble (ZPminus x' y'))
- | (xI x') (xO y') => (Zdouble_plus_one (ZPminus x' y'))
- | (xI x') xH => (POS (xO x'))
- | (xO x') (xI y') => (Zdouble_minus_one (ZPminus x' y'))
- | (xO x') (xO y') => (Zdouble (ZPminus x' y'))
- | (xO x') xH => (POS (double_moins_un x'))
- | xH (xI y') => (NEG (xO y'))
- | xH (xO y') => (NEG (double_moins_un y'))
- | xH xH => ZERO
+Definition Zdouble (x:Z) :=
+ match x with
+ | Z0 => Z0
+ | Zpos p => Zpos (xO p)
+ | Zneg p => Zneg (xO p)
+ end.
+
+Fixpoint ZPminus (x y:positive) {struct y} : Z :=
+ match x, y with
+ | xI x', xI y' => Zdouble (ZPminus x' y')
+ | xI x', xO y' => Zdouble_plus_one (ZPminus x' y')
+ | xI x', xH => Zpos (xO x')
+ | xO x', xI y' => Zdouble_minus_one (ZPminus x' y')
+ | xO x', xO y' => Zdouble (ZPminus x' y')
+ | xO x', xH => Zpos (Pdouble_minus_one x')
+ | xH, xI y' => Zneg (xO y')
+ | xH, xO y' => Zneg (Pdouble_minus_one y')
+ | xH, xH => Z0
end.
(** Addition on integers *)
-Definition Zplus := [x,y:Z]
- Cases x y of
- ZERO y => y
- | x ZERO => x
- | (POS x') (POS y') => (POS (add x' y'))
- | (POS x') (NEG y') =>
- Cases (compare x' y' EGAL) of
- | EGAL => ZERO
- | INFERIEUR => (NEG (true_sub y' x'))
- | SUPERIEUR => (POS (true_sub x' y'))
+Definition Zplus (x y:Z) :=
+ match x, y with
+ | Z0, y => y
+ | x, Z0 => x
+ | Zpos x', Zpos y' => Zpos (x' + y')
+ | Zpos x', Zneg y' =>
+ match (x' ?= y')%positive Eq with
+ | Eq => Z0
+ | Lt => Zneg (y' - x')
+ | Gt => Zpos (x' - y')
end
- | (NEG x') (POS y') =>
- Cases (compare x' y' EGAL) of
- | EGAL => ZERO
- | INFERIEUR => (POS (true_sub y' x'))
- | SUPERIEUR => (NEG (true_sub x' y'))
+ | Zneg x', Zpos y' =>
+ match (x' ?= y')%positive Eq with
+ | Eq => Z0
+ | Lt => Zpos (y' - x')
+ | Gt => Zneg (x' - y')
end
- | (NEG x') (NEG y') => (NEG (add x' y'))
+ | Zneg x', Zneg y' => Zneg (x' + y')
end.
-V8Infix "+" Zplus : Z_scope.
+Infix "+" := Zplus : Z_scope.
(** Opposite *)
-Definition Zopp := [x:Z]
- Cases x of
- ZERO => ZERO
- | (POS x) => (NEG x)
- | (NEG x) => (POS x)
- end.
+Definition Zopp (x:Z) :=
+ match x with
+ | Z0 => Z0
+ | Zpos x => Zneg x
+ | Zneg x => Zpos x
+ end.
-V8Notation "- x" := (Zopp x) : Z_scope.
+Notation "- x" := (Zopp x) : Z_scope.
(** Successor on integers *)
-Definition Zs := [x:Z](Zplus x (POS xH)).
+Definition Zsucc (x:Z) := (x + Zpos 1)%Z.
(** Predecessor on integers *)
-Definition Zpred := [x:Z](Zplus x (NEG xH)).
+Definition Zpred (x:Z) := (x + Zneg 1)%Z.
(** Subtraction on integers *)
-Definition Zminus := [m,n:Z](Zplus m (Zopp n)).
+Definition Zminus (m n:Z) := (m + - n)%Z.
-V8Infix "-" Zminus : Z_scope.
+Infix "-" := Zminus : Z_scope.
(** Multiplication on integers *)
-Definition Zmult := [x,y:Z]
- Cases x y of
- | ZERO _ => ZERO
- | _ ZERO => ZERO
- | (POS x') (POS y') => (POS (times x' y'))
- | (POS x') (NEG y') => (NEG (times x' y'))
- | (NEG x') (POS y') => (NEG (times x' y'))
- | (NEG x') (NEG y') => (POS (times x' y'))
+Definition Zmult (x y:Z) :=
+ match x, y with
+ | Z0, _ => Z0
+ | _, Z0 => Z0
+ | Zpos x', Zpos y' => Zpos (x' * y')
+ | Zpos x', Zneg y' => Zneg (x' * y')
+ | Zneg x', Zpos y' => Zneg (x' * y')
+ | Zneg x', Zneg y' => Zpos (x' * y')
end.
-V8Infix "*" Zmult : Z_scope.
+Infix "*" := Zmult : Z_scope.
(** Comparison of integers *)
-Definition Zcompare := [x,y:Z]
- Cases x y of
- | ZERO ZERO => EGAL
- | ZERO (POS y') => INFERIEUR
- | ZERO (NEG y') => SUPERIEUR
- | (POS x') ZERO => SUPERIEUR
- | (POS x') (POS y') => (compare x' y' EGAL)
- | (POS x') (NEG y') => SUPERIEUR
- | (NEG x') ZERO => INFERIEUR
- | (NEG x') (POS y') => INFERIEUR
- | (NEG x') (NEG y') => (Op (compare x' y' EGAL))
+Definition Zcompare (x y:Z) :=
+ match x, y with
+ | Z0, Z0 => Eq
+ | Z0, Zpos y' => Lt
+ | Z0, Zneg y' => Gt
+ | Zpos x', Z0 => Gt
+ | Zpos x', Zpos y' => (x' ?= y')%positive Eq
+ | Zpos x', Zneg y' => Gt
+ | Zneg x', Z0 => Lt
+ | Zneg x', Zpos y' => Lt
+ | Zneg x', Zneg y' => CompOpp ((x' ?= y')%positive Eq)
end.
-V8Infix "?=" Zcompare (at level 70, no associativity) : Z_scope.
+Infix "?=" := Zcompare (at level 70, no associativity) : Z_scope.
-Tactic Definition ElimCompare com1 com2:=
- Case (Dcompare (Zcompare com1 com2)); [ Idtac |
- Let x = FreshId "H" In Intro x; Case x; Clear x ].
+Ltac elim_compare com1 com2 :=
+ case (Dcompare (com1 ?= com2)%Z);
+ [ idtac | let x := fresh "H" in
+ (intro x; case x; clear x) ].
(** Sign function *)
-Definition Zsgn [z:Z] : Z :=
- Cases z of
- ZERO => ZERO
- | (POS p) => (POS xH)
- | (NEG p) => (NEG xH)
+Definition Zsgn (z:Z) : Z :=
+ match z with
+ | Z0 => Z0
+ | Zpos p => Zpos 1
+ | Zneg p => Zneg 1
end.
(** Direct, easier to handle variants of successor and addition *)
-Definition Zsucc' [x:Z] :=
- Cases x of
- | ZERO => (POS xH)
- | (POS x') => (POS (add_un x'))
- | (NEG x') => (ZPminus xH x')
+Definition Zsucc' (x:Z) :=
+ match x with
+ | Z0 => Zpos 1
+ | Zpos x' => Zpos (Psucc x')
+ | Zneg x' => ZPminus 1 x'
end.
-Definition Zpred' [x:Z] :=
- Cases x of
- | ZERO => (NEG xH)
- | (POS x') => (ZPminus x' xH)
- | (NEG x') => (NEG (add_un x'))
+Definition Zpred' (x:Z) :=
+ match x with
+ | Z0 => Zneg 1
+ | Zpos x' => ZPminus x' 1
+ | Zneg x' => Zneg (Psucc x')
end.
-Definition Zplus' := [x,y:Z]
- Cases x y of
- ZERO y => y
- | x ZERO => x
- | (POS x') (POS y') => (POS (add x' y'))
- | (POS x') (NEG y') => (ZPminus x' y')
- | (NEG x') (POS y') => (ZPminus y' x')
- | (NEG x') (NEG y') => (NEG (add x' y'))
+Definition Zplus' (x y:Z) :=
+ match x, y with
+ | Z0, y => y
+ | x, Z0 => x
+ | Zpos x', Zpos y' => Zpos (x' + y')
+ | Zpos x', Zneg y' => ZPminus x' y'
+ | Zneg x', Zpos y' => ZPminus y' x'
+ | Zneg x', Zneg y' => Zneg (x' + y')
end.
Open Local Scope Z_scope.
@@ -191,74 +194,83 @@ Open Local Scope Z_scope.
(**********************************************************************)
(** Inductive specification of Z *)
-Theorem Zind : (P:(Z ->Prop))
- (P ZERO) -> ((x:Z)(P x) ->(P (Zsucc' x))) -> ((x:Z)(P x) ->(P (Zpred' x))) ->
- (z:Z)(P z).
+Theorem Zind :
+ forall P:Z -> Prop,
+ P Z0 ->
+ (forall x:Z, P x -> P (Zsucc' x)) ->
+ (forall x:Z, P x -> P (Zpred' x)) -> forall n:Z, P n.
Proof.
-Intros P H0 Hs Hp z; NewDestruct z.
- Assumption.
- Apply Pind with P:=[p](P (POS p)).
- Change (P (Zsucc' ZERO)); Apply Hs; Apply H0.
- Intro n; Exact (Hs (POS n)).
- Apply Pind with P:=[p](P (NEG p)).
- Change (P (Zpred' ZERO)); Apply Hp; Apply H0.
- Intro n; Exact (Hp (NEG n)).
+intros P H0 Hs Hp z; destruct z.
+ assumption.
+ apply Pind with (P := fun p => P (Zpos p)).
+ change (P (Zsucc' Z0)) in |- *; apply Hs; apply H0.
+ intro n; exact (Hs (Zpos n)).
+ apply Pind with (P := fun p => P (Zneg p)).
+ change (P (Zpred' Z0)) in |- *; apply Hp; apply H0.
+ intro n; exact (Hp (Zneg n)).
Qed.
(**********************************************************************)
(** Properties of opposite on binary integer numbers *)
-Theorem Zopp_NEG : (x:positive) (Zopp (NEG x)) = (POS x).
+Theorem Zopp_neg : forall p:positive, - Zneg p = Zpos p.
Proof.
-Reflexivity.
+reflexivity.
Qed.
(** [opp] is involutive *)
-Theorem Zopp_Zopp: (x:Z) (Zopp (Zopp x)) = x.
+Theorem Zopp_involutive : forall n:Z, - - n = n.
Proof.
-Intro x; NewDestruct x; Reflexivity.
+intro x; destruct x; reflexivity.
Qed.
(** Injectivity of the opposite *)
-Theorem Zopp_intro : (x,y:Z) (Zopp x) = (Zopp y) -> x = y.
+Theorem Zopp_inj : forall n m:Z, - n = - m -> n = m.
Proof.
-Intros x y;Case x;Case y;Simpl;Intros; [
- Trivial | Discriminate H | Discriminate H | Discriminate H
-| Simplify_eq H; Intro E; Rewrite E; Trivial
-| Discriminate H | Discriminate H | Discriminate H
-| Simplify_eq H; Intro E; Rewrite E; Trivial ].
+intros x y; case x; case y; simpl in |- *; intros;
+ [ trivial
+ | discriminate H
+ | discriminate H
+ | discriminate H
+ | simplify_eq H; intro E; rewrite E; trivial
+ | discriminate H
+ | discriminate H
+ | discriminate H
+ | simplify_eq H; intro E; rewrite E; trivial ].
Qed.
(**********************************************************************)
(* Properties of the direct definition of successor and predecessor *)
-Lemma Zpred'_succ' : (x:Z)(Zpred' (Zsucc' x))=x.
+Lemma Zpred'_succ' : forall n:Z, Zpred' (Zsucc' n) = n.
Proof.
-Intro x; NewDestruct x; Simpl.
- Reflexivity.
-NewDestruct p; Simpl; Try Rewrite double_moins_un_add_un_xI; Reflexivity.
-NewDestruct p; Simpl; Try Rewrite is_double_moins_un; Reflexivity.
+intro x; destruct x; simpl in |- *.
+ reflexivity.
+destruct p; simpl in |- *; try rewrite Pdouble_minus_one_o_succ_eq_xI;
+ reflexivity.
+destruct p; simpl in |- *; try rewrite Psucc_o_double_minus_one_eq_xO;
+ reflexivity.
Qed.
-Lemma Zsucc'_discr : (x:Z)x<>(Zsucc' x).
+Lemma Zsucc'_discr : forall n:Z, n <> Zsucc' n.
Proof.
-Intro x; NewDestruct x; Simpl.
- Discriminate.
- Injection; Apply add_un_discr.
- NewDestruct p; Simpl.
- Discriminate.
- Intro H; Symmetry in H; Injection H; Apply double_moins_un_xO_discr.
- Discriminate.
+intro x; destruct x; simpl in |- *.
+ discriminate.
+ injection; apply Psucc_discr.
+ destruct p; simpl in |- *.
+ discriminate.
+ intro H; symmetry in H; injection H; apply double_moins_un_xO_discr.
+ discriminate.
Qed.
(**********************************************************************)
(** Other properties of binary integer numbers *)
-Lemma ZL0 : (S (S O))=(plus (S O) (S O)).
+Lemma ZL0 : 2%nat = (1 + 1)%nat.
Proof.
-Reflexivity.
+reflexivity.
Qed.
(**********************************************************************)
@@ -266,740 +278,761 @@ Qed.
(** zero is left neutral for addition *)
-Theorem Zero_left: (x:Z) (Zplus ZERO x) = x.
+Theorem Zplus_0_l : forall n:Z, Z0 + n = n.
Proof.
-Intro x; NewDestruct x; Reflexivity.
+intro x; destruct x; reflexivity.
Qed.
(** zero is right neutral for addition *)
-Theorem Zero_right: (x:Z) (Zplus x ZERO) = x.
+Theorem Zplus_0_r : forall n:Z, n + Z0 = n.
Proof.
-Intro x; NewDestruct x; Reflexivity.
+intro x; destruct x; reflexivity.
Qed.
(** addition is commutative *)
-Theorem Zplus_sym: (x,y:Z) (Zplus x y) = (Zplus y x).
+Theorem Zplus_comm : forall n m:Z, n + m = m + n.
Proof.
-Intro x;NewInduction x as [|p|p];Intro y; NewDestruct y as [|q|q];Simpl;Try Reflexivity.
- Rewrite add_sym; Reflexivity.
- Rewrite ZC4; NewDestruct (compare q p EGAL); Reflexivity.
- Rewrite ZC4; NewDestruct (compare q p EGAL); Reflexivity.
- Rewrite add_sym; Reflexivity.
+intro x; induction x as [| p| p]; intro y; destruct y as [| q| q];
+ simpl in |- *; try reflexivity.
+ rewrite Pplus_comm; reflexivity.
+ rewrite ZC4; destruct ((q ?= p)%positive Eq); reflexivity.
+ rewrite ZC4; destruct ((q ?= p)%positive Eq); reflexivity.
+ rewrite Pplus_comm; reflexivity.
Qed.
(** opposite distributes over addition *)
-Theorem Zopp_Zplus:
- (x,y:Z) (Zopp (Zplus x y)) = (Zplus (Zopp x) (Zopp y)).
+Theorem Zopp_plus_distr : forall n m:Z, - (n + m) = - n + - m.
Proof.
-Intro x; NewDestruct x as [|p|p]; Intro y; NewDestruct y as [|q|q]; Simpl;
- Reflexivity Orelse NewDestruct (compare p q EGAL); Reflexivity.
+intro x; destruct x as [| p| p]; intro y; destruct y as [| q| q];
+ simpl in |- *; reflexivity || destruct ((p ?= q)%positive Eq);
+ reflexivity.
Qed.
(** opposite is inverse for addition *)
-Theorem Zplus_inverse_r: (x:Z) (Zplus x (Zopp x)) = ZERO.
+Theorem Zplus_opp_r : forall n:Z, n + - n = Z0.
Proof.
-Intro x; NewDestruct x as [|p|p]; Simpl; [
- Reflexivity
-| Rewrite (convert_compare_EGAL p); Reflexivity
-| Rewrite (convert_compare_EGAL p); Reflexivity ].
+intro x; destruct x as [| p| p]; simpl in |- *;
+ [ reflexivity
+ | rewrite (Pcompare_refl p); reflexivity
+ | rewrite (Pcompare_refl p); reflexivity ].
Qed.
-Theorem Zplus_inverse_l: (x:Z) (Zplus (Zopp x) x) = ZERO.
+Theorem Zplus_opp_l : forall n:Z, - n + n = Z0.
Proof.
-Intro; Rewrite Zplus_sym; Apply Zplus_inverse_r.
+intro; rewrite Zplus_comm; apply Zplus_opp_r.
Qed.
-Hints Local Resolve Zero_left Zero_right.
+Hint Local Resolve Zplus_0_l Zplus_0_r.
(** addition is associative *)
Lemma weak_assoc :
- (x,y:positive)(z:Z) (Zplus (POS x) (Zplus (POS y) z))=
- (Zplus (Zplus (POS x) (POS y)) z).
-Proof.
-Intros x y z';Case z'; [
- Auto with arith
-| Intros z;Simpl; Rewrite add_assoc;Auto with arith
-| Intros z; Simpl; ElimPcompare y z;
- Intros E0;Rewrite E0;
- ElimPcompare '(add x y) 'z;Intros E1;Rewrite E1; [
- Absurd (compare (add x y) z EGAL)=EGAL; [ (* Case 1 *)
- Rewrite convert_compare_SUPERIEUR; [
- Discriminate
- | Rewrite convert_add; Rewrite (compare_convert_EGAL y z E0);
- Elim (ZL4 x);Intros k E2;Rewrite E2; Simpl; Unfold gt lt; Apply le_n_S;
- Apply le_plus_r ]
- | Assumption ]
- | Absurd (compare (add x y) z EGAL)=INFERIEUR; [ (* Case 2 *)
- Rewrite convert_compare_SUPERIEUR; [
- Discriminate
- | Rewrite convert_add; Rewrite (compare_convert_EGAL y z E0);
- Elim (ZL4 x);Intros k E2;Rewrite E2; Simpl; Unfold gt lt; Apply le_n_S;
- Apply le_plus_r]
- | Assumption ]
- | Rewrite (compare_convert_EGAL y z E0); (* Case 3 *)
- Elim (sub_pos_SUPERIEUR (add x z) z);[
- Intros t H; Elim H;Intros H1 H2;Elim H2;Intros H3 H4;
- Unfold true_sub; Rewrite H1; Cut x=t; [
- Intros E;Rewrite E;Auto with arith
- | Apply simpl_add_r with z:=z; Rewrite <- H3; Rewrite add_sym; Trivial with arith ]
- | Pattern 1 z; Rewrite <- (compare_convert_EGAL y z E0); Assumption ]
- | Elim (sub_pos_SUPERIEUR z y); [ (* Case 4 *)
- Intros k H;Elim H;Intros H1 H2;Elim H2;Intros H3 H4; Unfold 1 true_sub;
- Rewrite H1; Cut x=k; [
- Intros E;Rewrite E; Rewrite (convert_compare_EGAL k); Trivial with arith
- | Apply simpl_add_r with z:=y; Rewrite (add_sym k y); Rewrite H3;
- Apply compare_convert_EGAL; Assumption ]
- | Apply ZC2;Assumption]
- | Elim (sub_pos_SUPERIEUR z y); [ (* Case 5 *)
- Intros k H;Elim H;Intros H1 H2;Elim H2;Intros H3 H4;
- Unfold 1 3 5 true_sub; Rewrite H1;
- Cut (compare x k EGAL)=INFERIEUR; [
- Intros E2;Rewrite E2; Elim (sub_pos_SUPERIEUR k x); [
- Intros i H5;Elim H5;Intros H6 H7;Elim H7;Intros H8 H9;
- Elim (sub_pos_SUPERIEUR z (add x y)); [
- Intros j H10;Elim H10;Intros H11 H12;Elim H12;Intros H13 H14;
- Unfold true_sub ;Rewrite H6;Rewrite H11; Cut i=j; [
- Intros E;Rewrite E;Auto with arith
- | Apply (simpl_add_l (add x y)); Rewrite H13;
- Rewrite (add_sym x y); Rewrite <- add_assoc; Rewrite H8;
- Assumption ]
- | Apply ZC2; Assumption]
- | Apply ZC2;Assumption]
- | Apply convert_compare_INFERIEUR;
- Apply simpl_lt_plus_l with p:=(convert y);
- Do 2 Rewrite <- convert_add; Apply compare_convert_INFERIEUR;
- Rewrite H3; Rewrite add_sym; Assumption ]
- | Apply ZC2; Assumption ]
- | Elim (sub_pos_SUPERIEUR z y); [ (* Case 6 *)
- Intros k H;Elim H;Intros H1 H2;Elim H2;Intros H3 H4;
- Elim (sub_pos_SUPERIEUR (add x y) z); [
- Intros i H5;Elim H5;Intros H6 H7;Elim H7;Intros H8 H9;
- Unfold true_sub; Rewrite H1;Rewrite H6;
- Cut (compare x k EGAL)=SUPERIEUR; [
- Intros H10;Elim (sub_pos_SUPERIEUR x k H10);
- Intros j H11;Elim H11;Intros H12 H13;Elim H13;Intros H14 H15;
- Rewrite H10; Rewrite H12; Cut i=j; [
- Intros H16;Rewrite H16;Auto with arith
- | Apply (simpl_add_l (add z k)); Rewrite <- (add_assoc z k j);
- Rewrite H14; Rewrite (add_sym z k); Rewrite <- add_assoc;
- Rewrite H8; Rewrite (add_sym x y); Rewrite add_assoc;
- Rewrite (add_sym k y); Rewrite H3; Trivial with arith]
- | Apply convert_compare_SUPERIEUR; Unfold lt gt;
- Apply simpl_lt_plus_l with p:=(convert y);
- Do 2 Rewrite <- convert_add; Apply compare_convert_INFERIEUR;
- Rewrite H3; Rewrite add_sym; Apply ZC1; Assumption ]
- | Assumption ]
- | Apply ZC2;Assumption ]
- | Absurd (compare (add x y) z EGAL)=EGAL; [ (* Case 7 *)
- Rewrite convert_compare_SUPERIEUR; [
- Discriminate
- | Rewrite convert_add; Unfold gt;Apply lt_le_trans with m:=(convert y);[
- Apply compare_convert_INFERIEUR; Apply ZC1; Assumption
- | Apply le_plus_r]]
- | Assumption ]
- | Absurd (compare (add x y) z EGAL)=INFERIEUR; [ (* Case 8 *)
- Rewrite convert_compare_SUPERIEUR; [
- Discriminate
- | Unfold gt; Apply lt_le_trans with m:=(convert y);[
- Exact (compare_convert_SUPERIEUR y z E0)
- | Rewrite convert_add; Apply le_plus_r]]
- | Assumption ]
- | Elim sub_pos_SUPERIEUR with 1:=E0;Intros k H1; (* Case 9 *)
- Elim sub_pos_SUPERIEUR with 1:=E1; Intros i H2;Elim H1;Intros H3 H4;
- Elim H4;Intros H5 H6; Elim H2;Intros H7 H8;Elim H8;Intros H9 H10;
- Unfold true_sub ;Rewrite H3;Rewrite H7; Cut (add x k)=i; [
- Intros E;Rewrite E;Auto with arith
- | Apply (simpl_add_l z);Rewrite (add_sym x k);
- Rewrite add_assoc; Rewrite H5;Rewrite H9;
- Rewrite add_sym; Trivial with arith ]]].
-Qed.
-
-Hints Local Resolve weak_assoc.
-
-Theorem Zplus_assoc :
- (n,m,p:Z) (Zplus n (Zplus m p))= (Zplus (Zplus n m) p).
-Proof.
-Intros x y z;Case x;Case y;Case z;Auto with arith; Intros; [
- Rewrite (Zplus_sym (NEG p0)); Rewrite weak_assoc;
- Rewrite (Zplus_sym (Zplus (POS p1) (NEG p0))); Rewrite weak_assoc;
- Rewrite (Zplus_sym (POS p1)); Trivial with arith
-| Apply Zopp_intro; Do 4 Rewrite Zopp_Zplus;
- Do 2 Rewrite Zopp_NEG; Rewrite Zplus_sym; Rewrite <- weak_assoc;
- Rewrite (Zplus_sym (Zopp (POS p1)));
- Rewrite (Zplus_sym (Zplus (POS p0) (Zopp (POS p1))));
- Rewrite (weak_assoc p); Rewrite weak_assoc; Rewrite (Zplus_sym (POS p0));
- Trivial with arith
-| Rewrite Zplus_sym; Rewrite (Zplus_sym (POS p0) (POS p));
- Rewrite <- weak_assoc; Rewrite Zplus_sym; Rewrite (Zplus_sym (POS p0));
- Trivial with arith
-| Apply Zopp_intro; Do 4 Rewrite Zopp_Zplus;
- Do 2 Rewrite Zopp_NEG; Rewrite (Zplus_sym (Zopp (POS p0)));
- Rewrite weak_assoc; Rewrite (Zplus_sym (Zplus (POS p1) (Zopp (POS p0))));
- Rewrite weak_assoc;Rewrite (Zplus_sym (POS p)); Trivial with arith
-| Apply Zopp_intro; Do 4 Rewrite Zopp_Zplus; Do 2 Rewrite Zopp_NEG;
- Apply weak_assoc
-| Apply Zopp_intro; Do 4 Rewrite Zopp_Zplus; Do 2 Rewrite Zopp_NEG;
- Apply weak_assoc]
-.
-Qed.
-
-V7only [Notation Zplus_assoc_l := Zplus_assoc.].
-
-Lemma Zplus_assoc_r : (n,m,p:Z)(Zplus (Zplus n m) p) =(Zplus n (Zplus m p)).
-Proof.
-Intros; Symmetry; Apply Zplus_assoc.
+ forall (p q:positive) (n:Z), Zpos p + (Zpos q + n) = Zpos p + Zpos q + n.
+Proof.
+intros x y z'; case z';
+ [ auto with arith
+ | intros z; simpl in |- *; rewrite Pplus_assoc; auto with arith
+ | intros z; simpl in |- *; ElimPcompare y z; intros E0; rewrite E0;
+ ElimPcompare (x + y)%positive z; intros E1; rewrite E1;
+ [ absurd ((x + y ?= z)%positive Eq = Eq);
+ [ (* Case 1 *)
+ rewrite nat_of_P_gt_Gt_compare_complement_morphism;
+ [ discriminate
+ | rewrite nat_of_P_plus_morphism; rewrite (Pcompare_Eq_eq y z E0);
+ elim (ZL4 x); intros k E2; rewrite E2;
+ simpl in |- *; unfold gt, lt in |- *;
+ apply le_n_S; apply le_plus_r ]
+ | assumption ]
+ | absurd ((x + y ?= z)%positive Eq = Lt);
+ [ (* Case 2 *)
+ rewrite nat_of_P_gt_Gt_compare_complement_morphism;
+ [ discriminate
+ | rewrite nat_of_P_plus_morphism; rewrite (Pcompare_Eq_eq y z E0);
+ elim (ZL4 x); intros k E2; rewrite E2;
+ simpl in |- *; unfold gt, lt in |- *;
+ apply le_n_S; apply le_plus_r ]
+ | assumption ]
+ | rewrite (Pcompare_Eq_eq y z E0);
+ (* Case 3 *)
+ elim (Pminus_mask_Gt (x + z) z);
+ [ intros t H; elim H; intros H1 H2; elim H2; intros H3 H4;
+ unfold Pminus in |- *; rewrite H1; cut (x = t);
+ [ intros E; rewrite E; auto with arith
+ | apply Pplus_reg_r with (r := z); rewrite <- H3;
+ rewrite Pplus_comm; trivial with arith ]
+ | pattern z at 1 in |- *; rewrite <- (Pcompare_Eq_eq y z E0);
+ assumption ]
+ | elim (Pminus_mask_Gt z y);
+ [ (* Case 4 *)
+ intros k H; elim H; intros H1 H2; elim H2; intros H3 H4;
+ unfold Pminus at 1 in |- *; rewrite H1; cut (x = k);
+ [ intros E; rewrite E; rewrite (Pcompare_refl k);
+ trivial with arith
+ | apply Pplus_reg_r with (r := y); rewrite (Pplus_comm k y);
+ rewrite H3; apply Pcompare_Eq_eq; assumption ]
+ | apply ZC2; assumption ]
+ | elim (Pminus_mask_Gt z y);
+ [ (* Case 5 *)
+ intros k H; elim H; intros H1 H2; elim H2; intros H3 H4;
+ unfold Pminus at 1 3 5 in |- *; rewrite H1;
+ cut ((x ?= k)%positive Eq = Lt);
+ [ intros E2; rewrite E2; elim (Pminus_mask_Gt k x);
+ [ intros i H5; elim H5; intros H6 H7; elim H7; intros H8 H9;
+ elim (Pminus_mask_Gt z (x + y));
+ [ intros j H10; elim H10; intros H11 H12; elim H12;
+ intros H13 H14; unfold Pminus in |- *;
+ rewrite H6; rewrite H11; cut (i = j);
+ [ intros E; rewrite E; auto with arith
+ | apply (Pplus_reg_l (x + y)); rewrite H13;
+ rewrite (Pplus_comm x y); rewrite <- Pplus_assoc;
+ rewrite H8; assumption ]
+ | apply ZC2; assumption ]
+ | apply ZC2; assumption ]
+ | apply nat_of_P_lt_Lt_compare_complement_morphism;
+ apply plus_lt_reg_l with (p := nat_of_P y);
+ do 2 rewrite <- nat_of_P_plus_morphism;
+ apply nat_of_P_lt_Lt_compare_morphism;
+ rewrite H3; rewrite Pplus_comm; assumption ]
+ | apply ZC2; assumption ]
+ | elim (Pminus_mask_Gt z y);
+ [ (* Case 6 *)
+ intros k H; elim H; intros H1 H2; elim H2; intros H3 H4;
+ elim (Pminus_mask_Gt (x + y) z);
+ [ intros i H5; elim H5; intros H6 H7; elim H7; intros H8 H9;
+ unfold Pminus in |- *; rewrite H1; rewrite H6;
+ cut ((x ?= k)%positive Eq = Gt);
+ [ intros H10; elim (Pminus_mask_Gt x k H10); intros j H11;
+ elim H11; intros H12 H13; elim H13;
+ intros H14 H15; rewrite H10; rewrite H12;
+ cut (i = j);
+ [ intros H16; rewrite H16; auto with arith
+ | apply (Pplus_reg_l (z + k)); rewrite <- (Pplus_assoc z k j);
+ rewrite H14; rewrite (Pplus_comm z k);
+ rewrite <- Pplus_assoc; rewrite H8;
+ rewrite (Pplus_comm x y); rewrite Pplus_assoc;
+ rewrite (Pplus_comm k y); rewrite H3;
+ trivial with arith ]
+ | apply nat_of_P_gt_Gt_compare_complement_morphism;
+ unfold lt, gt in |- *;
+ apply plus_lt_reg_l with (p := nat_of_P y);
+ do 2 rewrite <- nat_of_P_plus_morphism;
+ apply nat_of_P_lt_Lt_compare_morphism;
+ rewrite H3; rewrite Pplus_comm; apply ZC1;
+ assumption ]
+ | assumption ]
+ | apply ZC2; assumption ]
+ | absurd ((x + y ?= z)%positive Eq = Eq);
+ [ (* Case 7 *)
+ rewrite nat_of_P_gt_Gt_compare_complement_morphism;
+ [ discriminate
+ | rewrite nat_of_P_plus_morphism; unfold gt in |- *;
+ apply lt_le_trans with (m := nat_of_P y);
+ [ apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; assumption
+ | apply le_plus_r ] ]
+ | assumption ]
+ | absurd ((x + y ?= z)%positive Eq = Lt);
+ [ (* Case 8 *)
+ rewrite nat_of_P_gt_Gt_compare_complement_morphism;
+ [ discriminate
+ | unfold gt in |- *; apply lt_le_trans with (m := nat_of_P y);
+ [ exact (nat_of_P_gt_Gt_compare_morphism y z E0)
+ | rewrite nat_of_P_plus_morphism; apply le_plus_r ] ]
+ | assumption ]
+ | elim Pminus_mask_Gt with (1 := E0); intros k H1;
+ (* Case 9 *)
+ elim Pminus_mask_Gt with (1 := E1); intros i H2;
+ elim H1; intros H3 H4; elim H4; intros H5 H6;
+ elim H2; intros H7 H8; elim H8; intros H9 H10;
+ unfold Pminus in |- *; rewrite H3; rewrite H7;
+ cut ((x + k)%positive = i);
+ [ intros E; rewrite E; auto with arith
+ | apply (Pplus_reg_l z); rewrite (Pplus_comm x k); rewrite Pplus_assoc;
+ rewrite H5; rewrite H9; rewrite Pplus_comm;
+ trivial with arith ] ] ].
+Qed.
+
+Hint Local Resolve weak_assoc.
+
+Theorem Zplus_assoc : forall n m p:Z, n + (m + p) = n + m + p.
+Proof.
+intros x y z; case x; case y; case z; auto with arith; intros;
+ [ rewrite (Zplus_comm (Zneg p0)); rewrite weak_assoc;
+ rewrite (Zplus_comm (Zpos p1 + Zneg p0)); rewrite weak_assoc;
+ rewrite (Zplus_comm (Zpos p1)); trivial with arith
+ | apply Zopp_inj; do 4 rewrite Zopp_plus_distr; do 2 rewrite Zopp_neg;
+ rewrite Zplus_comm; rewrite <- weak_assoc;
+ rewrite (Zplus_comm (- Zpos p1));
+ rewrite (Zplus_comm (Zpos p0 + - Zpos p1)); rewrite (weak_assoc p);
+ rewrite weak_assoc; rewrite (Zplus_comm (Zpos p0));
+ trivial with arith
+ | rewrite Zplus_comm; rewrite (Zplus_comm (Zpos p0) (Zpos p));
+ rewrite <- weak_assoc; rewrite Zplus_comm; rewrite (Zplus_comm (Zpos p0));
+ trivial with arith
+ | apply Zopp_inj; do 4 rewrite Zopp_plus_distr; do 2 rewrite Zopp_neg;
+ rewrite (Zplus_comm (- Zpos p0)); rewrite weak_assoc;
+ rewrite (Zplus_comm (Zpos p1 + - Zpos p0)); rewrite weak_assoc;
+ rewrite (Zplus_comm (Zpos p)); trivial with arith
+ | apply Zopp_inj; do 4 rewrite Zopp_plus_distr; do 2 rewrite Zopp_neg;
+ apply weak_assoc
+ | apply Zopp_inj; do 4 rewrite Zopp_plus_distr; do 2 rewrite Zopp_neg;
+ apply weak_assoc ].
+Qed.
+
+
+Lemma Zplus_assoc_reverse : forall n m p:Z, n + m + p = n + (m + p).
+Proof.
+intros; symmetry in |- *; apply Zplus_assoc.
Qed.
(** Associativity mixed with commutativity *)
-Theorem Zplus_permute : (n,m,p:Z) (Zplus n (Zplus m p))=(Zplus m (Zplus n p)).
+Theorem Zplus_permute : forall n m p:Z, n + (m + p) = m + (n + p).
Proof.
-Intros n m p;
-Rewrite Zplus_sym;Rewrite <- Zplus_assoc; Rewrite (Zplus_sym p n); Trivial with arith.
+intros n m p; rewrite Zplus_comm; rewrite <- Zplus_assoc;
+ rewrite (Zplus_comm p n); trivial with arith.
Qed.
(** addition simplifies *)
-Theorem Zsimpl_plus_l : (n,m,p:Z)(Zplus n m)=(Zplus n p)->m=p.
-Intros n m p H; Cut (Zplus (Zopp n) (Zplus n m))=(Zplus (Zopp n) (Zplus n p));[
- Do 2 Rewrite -> Zplus_assoc; Rewrite -> (Zplus_sym (Zopp n) n);
- Rewrite -> Zplus_inverse_r;Simpl; Trivial with arith
-| Rewrite -> H; Trivial with arith ].
+Theorem Zplus_reg_l : forall n m p:Z, n + m = n + p -> m = p.
+intros n m p H; cut (- n + (n + m) = - n + (n + p));
+ [ do 2 rewrite Zplus_assoc; rewrite (Zplus_comm (- n) n);
+ rewrite Zplus_opp_r; simpl in |- *; trivial with arith
+ | rewrite H; trivial with arith ].
Qed.
(** addition and successor permutes *)
-Lemma Zplus_S_n: (x,y:Z) (Zplus (Zs x) y) = (Zs (Zplus x y)).
+Lemma Zplus_succ_l : forall n m:Z, Zsucc n + m = Zsucc (n + m).
Proof.
-Intros x y; Unfold Zs; Rewrite (Zplus_sym (Zplus x y)); Rewrite Zplus_assoc;
-Rewrite (Zplus_sym (POS xH)); Trivial with arith.
+intros x y; unfold Zsucc in |- *; rewrite (Zplus_comm (x + y));
+ rewrite Zplus_assoc; rewrite (Zplus_comm (Zpos 1));
+ trivial with arith.
Qed.
-Lemma Zplus_n_Sm : (n,m:Z) (Zs (Zplus n m))=(Zplus n (Zs m)).
+Lemma Zplus_succ_r : forall n m:Z, Zsucc (n + m) = n + Zsucc m.
Proof.
-Intros n m; Unfold Zs; Rewrite Zplus_assoc; Trivial with arith.
+intros n m; unfold Zsucc in |- *; rewrite Zplus_assoc; trivial with arith.
Qed.
-Lemma Zplus_Snm_nSm : (n,m:Z)(Zplus (Zs n) m)=(Zplus n (Zs m)).
+Lemma Zplus_succ_comm : forall n m:Z, Zsucc n + m = n + Zsucc m.
Proof.
-Unfold Zs ;Intros n m; Rewrite <- Zplus_assoc; Rewrite (Zplus_sym (POS xH));
-Trivial with arith.
+unfold Zsucc in |- *; intros n m; rewrite <- Zplus_assoc;
+ rewrite (Zplus_comm (Zpos 1)); trivial with arith.
Qed.
(** Misc properties, usually redundant or non natural *)
-Lemma Zplus_n_O : (n:Z) n=(Zplus n ZERO).
+Lemma Zplus_0_r_reverse : forall n:Z, n = n + Z0.
Proof.
-Symmetry; Apply Zero_right.
+symmetry in |- *; apply Zplus_0_r.
Qed.
-Lemma Zplus_unit_left : (n,m:Z) (Zplus n ZERO)=m -> n=m.
+Lemma Zplus_0_simpl_l : forall n m:Z, n + Z0 = m -> n = m.
Proof.
-Intros n m; Rewrite Zero_right; Intro; Assumption.
+intros n m; rewrite Zplus_0_r; intro; assumption.
Qed.
-Lemma Zplus_unit_right : (n,m:Z) n=(Zplus m ZERO) -> n=m.
+Lemma Zplus_0_simpl_l_reverse : forall n m:Z, n = m + Z0 -> n = m.
Proof.
-Intros n m; Rewrite Zero_right; Intro; Assumption.
+intros n m; rewrite Zplus_0_r; intro; assumption.
Qed.
-Lemma Zplus_simpl : (x,y,z,t:Z) x=y -> z=t -> (Zplus x z)=(Zplus y t).
+Lemma Zplus_eq_compat : forall n m p q:Z, n = m -> p = q -> n + p = m + q.
Proof.
-Intros; Rewrite H; Rewrite H0; Reflexivity.
+intros; rewrite H; rewrite H0; reflexivity.
Qed.
-Lemma Zplus_Zopp_expand : (x,y,z:Z)
- (Zplus x (Zopp y))=(Zplus (Zplus x (Zopp z)) (Zplus z (Zopp y))).
+Lemma Zplus_opp_expand : forall n m p:Z, n + - m = n + - p + (p + - m).
Proof.
-Intros x y z.
-Rewrite <- (Zplus_assoc x).
-Rewrite (Zplus_assoc (Zopp z)).
-Rewrite Zplus_inverse_l.
-Reflexivity.
+intros x y z.
+rewrite <- (Zplus_assoc x).
+rewrite (Zplus_assoc (- z)).
+rewrite Zplus_opp_l.
+reflexivity.
Qed.
(**********************************************************************)
(** Properties of successor and predecessor on binary integer numbers *)
-Theorem Zn_Sn : (x:Z) ~ x=(Zs x).
+Theorem Zsucc_discr : forall n:Z, n <> Zsucc n.
Proof.
-Intros n;Cut ~ZERO=(POS xH);[
- Unfold not ;Intros H1 H2;Apply H1;Apply (Zsimpl_plus_l n);Rewrite Zero_right;
- Exact H2
-| Discriminate ].
+intros n; cut (Z0 <> Zpos 1);
+ [ unfold not in |- *; intros H1 H2; apply H1; apply (Zplus_reg_l n);
+ rewrite Zplus_0_r; exact H2
+ | discriminate ].
Qed.
-Theorem add_un_Zs : (x:positive) (POS (add_un x)) = (Zs (POS x)).
+Theorem Zpos_succ_morphism :
+ forall p:positive, Zpos (Psucc p) = Zsucc (Zpos p).
Proof.
-Intro; Rewrite -> ZL12; Unfold Zs; Simpl; Trivial with arith.
+intro; rewrite Pplus_one_succ_r; unfold Zsucc in |- *; simpl in |- *;
+ trivial with arith.
Qed.
(** successor and predecessor are inverse functions *)
-Theorem Zs_pred : (n:Z) n=(Zs (Zpred n)).
+Theorem Zsucc_pred : forall n:Z, n = Zsucc (Zpred n).
Proof.
-Intros n; Unfold Zs Zpred ;Rewrite <- Zplus_assoc; Simpl; Rewrite Zero_right;
-Trivial with arith.
+intros n; unfold Zsucc, Zpred in |- *; rewrite <- Zplus_assoc; simpl in |- *;
+ rewrite Zplus_0_r; trivial with arith.
Qed.
-Hints Immediate Zs_pred : zarith.
+Hint Immediate Zsucc_pred: zarith.
-Theorem Zpred_Sn : (x:Z) x=(Zpred (Zs x)).
+Theorem Zpred_succ : forall n:Z, n = Zpred (Zsucc n).
Proof.
-Intros m; Unfold Zpred Zs; Rewrite <- Zplus_assoc; Simpl;
-Rewrite Zplus_sym; Auto with arith.
+intros m; unfold Zpred, Zsucc in |- *; rewrite <- Zplus_assoc; simpl in |- *;
+ rewrite Zplus_comm; auto with arith.
Qed.
-Theorem Zeq_add_S : (n,m:Z) (Zs n)=(Zs m) -> n=m.
+Theorem Zsucc_inj : forall n m:Z, Zsucc n = Zsucc m -> n = m.
Proof.
-Intros n m H.
-Change (Zplus (Zplus (NEG xH) (POS xH)) n)=
- (Zplus (Zplus (NEG xH) (POS xH)) m);
-Do 2 Rewrite <- Zplus_assoc; Do 2 Rewrite (Zplus_sym (POS xH));
-Unfold Zs in H;Rewrite H; Trivial with arith.
+intros n m H.
+change (Zneg 1 + Zpos 1 + n = Zneg 1 + Zpos 1 + m) in |- *;
+ do 2 rewrite <- Zplus_assoc; do 2 rewrite (Zplus_comm (Zpos 1));
+ unfold Zsucc in H; rewrite H; trivial with arith.
Qed.
(** Misc properties, usually redundant or non natural *)
-Lemma Zeq_S : (n,m:Z) n=m -> (Zs n)=(Zs m).
+Lemma Zsucc_eq_compat : forall n m:Z, n = m -> Zsucc n = Zsucc m.
Proof.
-Intros n m H; Rewrite H; Reflexivity.
+intros n m H; rewrite H; reflexivity.
Qed.
-Lemma Znot_eq_S : (n,m:Z) ~(n=m) -> ~((Zs n)=(Zs m)).
+Lemma Zsucc_inj_contrapositive : forall n m:Z, n <> m -> Zsucc n <> Zsucc m.
Proof.
-Unfold not ;Intros n m H1 H2;Apply H1;Apply Zeq_add_S; Assumption.
+unfold not in |- *; intros n m H1 H2; apply H1; apply Zsucc_inj; assumption.
Qed.
(**********************************************************************)
(** Properties of subtraction on binary integer numbers *)
-Lemma Zminus_0_r : (x:Z) (Zminus x ZERO)=x.
+Lemma Zminus_0_r : forall n:Z, n - Z0 = n.
Proof.
-Intro; Unfold Zminus; Simpl;Rewrite Zero_right; Trivial with arith.
+intro; unfold Zminus in |- *; simpl in |- *; rewrite Zplus_0_r;
+ trivial with arith.
Qed.
-Lemma Zminus_n_O : (x:Z) x=(Zminus x ZERO).
+Lemma Zminus_0_l_reverse : forall n:Z, n = n - Z0.
Proof.
-Intro; Symmetry; Apply Zminus_0_r.
+intro; symmetry in |- *; apply Zminus_0_r.
Qed.
-Lemma Zminus_diag : (n:Z)(Zminus n n)=ZERO.
+Lemma Zminus_diag : forall n:Z, n - n = Z0.
Proof.
-Intro; Unfold Zminus; Rewrite Zplus_inverse_r; Trivial with arith.
+intro; unfold Zminus in |- *; rewrite Zplus_opp_r; trivial with arith.
Qed.
-Lemma Zminus_n_n : (n:Z)(ZERO=(Zminus n n)).
+Lemma Zminus_diag_reverse : forall n:Z, Z0 = n - n.
Proof.
-Intro; Symmetry; Apply Zminus_diag.
+intro; symmetry in |- *; apply Zminus_diag.
Qed.
-Lemma Zplus_minus : (x,y,z:Z)(x=(Zplus y z))->(z=(Zminus x y)).
+Lemma Zplus_minus_eq : forall n m p:Z, n = m + p -> p = n - m.
Proof.
-Intros n m p H;Unfold Zminus;Apply (Zsimpl_plus_l m);
-Rewrite (Zplus_sym m (Zplus n (Zopp m))); Rewrite <- Zplus_assoc;
-Rewrite Zplus_inverse_l; Rewrite Zero_right; Rewrite H; Trivial with arith.
+intros n m p H; unfold Zminus in |- *; apply (Zplus_reg_l m);
+ rewrite (Zplus_comm m (n + - m)); rewrite <- Zplus_assoc;
+ rewrite Zplus_opp_l; rewrite Zplus_0_r; rewrite H;
+ trivial with arith.
Qed.
-Lemma Zminus_plus : (x,y:Z)(Zminus (Zplus x y) x)=y.
+Lemma Zminus_plus : forall n m:Z, n + m - n = m.
Proof.
-Intros n m;Unfold Zminus ;Rewrite -> (Zplus_sym n m);Rewrite <- Zplus_assoc;
-Rewrite -> Zplus_inverse_r; Apply Zero_right.
+intros n m; unfold Zminus in |- *; rewrite (Zplus_comm n m);
+ rewrite <- Zplus_assoc; rewrite Zplus_opp_r; apply Zplus_0_r.
Qed.
-Lemma Zle_plus_minus : (n,m:Z) (Zplus n (Zminus m n))=m.
+Lemma Zplus_minus : forall n m:Z, n + (m - n) = m.
Proof.
-Unfold Zminus; Intros n m; Rewrite Zplus_permute; Rewrite Zplus_inverse_r;
-Apply Zero_right.
+unfold Zminus in |- *; intros n m; rewrite Zplus_permute; rewrite Zplus_opp_r;
+ apply Zplus_0_r.
Qed.
-Lemma Zminus_Sn_m : (n,m:Z)((Zs (Zminus n m))=(Zminus (Zs n) m)).
+Lemma Zminus_succ_l : forall n m:Z, Zsucc (n - m) = Zsucc n - m.
Proof.
-Intros n m;Unfold Zminus Zs; Rewrite (Zplus_sym n (Zopp m));
-Rewrite <- Zplus_assoc;Apply Zplus_sym.
+intros n m; unfold Zminus, Zsucc in |- *; rewrite (Zplus_comm n (- m));
+ rewrite <- Zplus_assoc; apply Zplus_comm.
Qed.
-Lemma Zminus_plus_simpl_l :
- (x,y,z:Z)(Zminus (Zplus z x) (Zplus z y))=(Zminus x y).
+Lemma Zminus_plus_simpl_l : forall n m p:Z, p + n - (p + m) = n - m.
Proof.
-Intros n m p;Unfold Zminus; Rewrite Zopp_Zplus; Rewrite Zplus_assoc;
-Rewrite (Zplus_sym p); Rewrite <- (Zplus_assoc n p); Rewrite Zplus_inverse_r;
-Rewrite Zero_right; Trivial with arith.
+intros n m p; unfold Zminus in |- *; rewrite Zopp_plus_distr;
+ rewrite Zplus_assoc; rewrite (Zplus_comm p); rewrite <- (Zplus_assoc n p);
+ rewrite Zplus_opp_r; rewrite Zplus_0_r; trivial with arith.
Qed.
-Lemma Zminus_plus_simpl :
- (x,y,z:Z)((Zminus x y)=(Zminus (Zplus z x) (Zplus z y))).
+Lemma Zminus_plus_simpl_l_reverse : forall n m p:Z, n - m = p + n - (p + m).
Proof.
-Intros; Symmetry; Apply Zminus_plus_simpl_l.
+intros; symmetry in |- *; apply Zminus_plus_simpl_l.
Qed.
-Lemma Zminus_Zplus_compatible :
- (x,y,z:Z) (Zminus (Zplus x z) (Zplus y z)) = (Zminus x y).
-Intros x y n.
-Unfold Zminus.
-Rewrite -> Zopp_Zplus.
-Rewrite -> (Zplus_sym (Zopp y) (Zopp n)).
-Rewrite -> Zplus_assoc.
-Rewrite <- (Zplus_assoc x n (Zopp n)).
-Rewrite -> (Zplus_inverse_r n).
-Rewrite <- Zplus_n_O.
-Reflexivity.
+Lemma Zminus_plus_simpl_r : forall n m p:Z, n + p - (m + p) = n - m.
+intros x y n.
+unfold Zminus in |- *.
+rewrite Zopp_plus_distr.
+rewrite (Zplus_comm (- y) (- n)).
+rewrite Zplus_assoc.
+rewrite <- (Zplus_assoc x n (- n)).
+rewrite (Zplus_opp_r n).
+rewrite <- Zplus_0_r_reverse.
+reflexivity.
Qed.
(** Misc redundant properties *)
-V7only [Set Implicit Arguments.].
-Lemma Zeq_Zminus : (x,y:Z)x=y -> (Zminus x y)=ZERO.
+Lemma Zeq_minus : forall n m:Z, n = m -> n - m = Z0.
Proof.
-Intros x y H; Rewrite H; Symmetry; Apply Zminus_n_n.
+intros x y H; rewrite H; symmetry in |- *; apply Zminus_diag_reverse.
Qed.
-Lemma Zminus_Zeq : (x,y:Z)(Zminus x y)=ZERO -> x=y.
+Lemma Zminus_eq : forall n m:Z, n - m = Z0 -> n = m.
Proof.
-Intros x y H; Rewrite <- (Zle_plus_minus y x); Rewrite H; Apply Zero_right.
+intros x y H; rewrite <- (Zplus_minus y x); rewrite H; apply Zplus_0_r.
Qed.
-V7only [Unset Implicit Arguments.].
(**********************************************************************)
(** Properties of multiplication on binary integer numbers *)
(** One is neutral for multiplication *)
-Theorem Zmult_1_n : (n:Z)(Zmult (POS xH) n)=n.
+Theorem Zmult_1_l : forall n:Z, Zpos 1 * n = n.
Proof.
-Intro x; NewDestruct x; Reflexivity.
+intro x; destruct x; reflexivity.
Qed.
-V7only [Notation Zmult_one := Zmult_1_n.].
-Theorem Zmult_n_1 : (n:Z)(Zmult n (POS xH))=n.
+Theorem Zmult_1_r : forall n:Z, n * Zpos 1 = n.
Proof.
-Intro x; NewDestruct x; Simpl; Try Rewrite times_x_1; Reflexivity.
+intro x; destruct x; simpl in |- *; try rewrite Pmult_1_r; reflexivity.
Qed.
(** Zero property of multiplication *)
-Theorem Zero_mult_left: (x:Z) (Zmult ZERO x) = ZERO.
+Theorem Zmult_0_l : forall n:Z, Z0 * n = Z0.
Proof.
-Intro x; NewDestruct x; Reflexivity.
+intro x; destruct x; reflexivity.
Qed.
-Theorem Zero_mult_right: (x:Z) (Zmult x ZERO) = ZERO.
+Theorem Zmult_0_r : forall n:Z, n * Z0 = Z0.
Proof.
-Intro x; NewDestruct x; Reflexivity.
+intro x; destruct x; reflexivity.
Qed.
-Hints Local Resolve Zero_mult_left Zero_mult_right.
+Hint Local Resolve Zmult_0_l Zmult_0_r.
-Lemma Zmult_n_O : (n:Z) ZERO=(Zmult n ZERO).
+Lemma Zmult_0_r_reverse : forall n:Z, Z0 = n * Z0.
Proof.
-Intro x; NewDestruct x; Reflexivity.
+intro x; destruct x; reflexivity.
Qed.
(** Commutativity of multiplication *)
-Theorem Zmult_sym : (x,y:Z) (Zmult x y) = (Zmult y x).
+Theorem Zmult_comm : forall n m:Z, n * m = m * n.
Proof.
-Intros x y; NewDestruct x as [|p|p]; NewDestruct y as [|q|q]; Simpl;
- Try Rewrite (times_sym p q); Reflexivity.
+intros x y; destruct x as [| p| p]; destruct y as [| q| q]; simpl in |- *;
+ try rewrite (Pmult_comm p q); reflexivity.
Qed.
(** Associativity of multiplication *)
-Theorem Zmult_assoc :
- (x,y,z:Z) (Zmult x (Zmult y z))= (Zmult (Zmult x y) z).
+Theorem Zmult_assoc : forall n m p:Z, n * (m * p) = n * m * p.
Proof.
-Intros x y z; NewDestruct x; NewDestruct y; NewDestruct z; Simpl;
- Try Rewrite times_assoc; Reflexivity.
+intros x y z; destruct x; destruct y; destruct z; simpl in |- *;
+ try rewrite Pmult_assoc; reflexivity.
Qed.
-V7only [Notation Zmult_assoc_l := Zmult_assoc.].
-Lemma Zmult_assoc_r : (n,m,p:Z)((Zmult (Zmult n m) p) = (Zmult n (Zmult m p))).
+Lemma Zmult_assoc_reverse : forall n m p:Z, n * m * p = n * (m * p).
Proof.
-Intros n m p; Rewrite Zmult_assoc; Trivial with arith.
+intros n m p; rewrite Zmult_assoc; trivial with arith.
Qed.
(** Associativity mixed with commutativity *)
-Theorem Zmult_permute : (n,m,p:Z)(Zmult n (Zmult m p)) = (Zmult m (Zmult n p)).
+Theorem Zmult_permute : forall n m p:Z, n * (m * p) = m * (n * p).
Proof.
-Intros x y z; Rewrite -> (Zmult_assoc y x z); Rewrite -> (Zmult_sym y x).
-Apply Zmult_assoc.
+intros x y z; rewrite (Zmult_assoc y x z); rewrite (Zmult_comm y x).
+apply Zmult_assoc.
Qed.
(** Z is integral *)
-Theorem Zmult_eq: (x,y:Z) ~(x=ZERO) -> (Zmult y x) = ZERO -> y = ZERO.
+Theorem Zmult_integral_l : forall n m:Z, n <> Z0 -> m * n = Z0 -> m = Z0.
Proof.
-Intros x y; NewDestruct x as [|p|p].
- Intro H; Absurd ZERO=ZERO; Trivial.
- Intros _ H; NewDestruct y as [|q|q]; Reflexivity Orelse Discriminate.
- Intros _ H; NewDestruct y as [|q|q]; Reflexivity Orelse Discriminate.
+intros x y; destruct x as [| p| p].
+ intro H; absurd (Z0 = Z0); trivial.
+ intros _ H; destruct y as [| q| q]; reflexivity || discriminate.
+ intros _ H; destruct y as [| q| q]; reflexivity || discriminate.
Qed.
-V7only [Set Implicit Arguments.].
-Theorem Zmult_zero : (x,y:Z)(Zmult x y)=ZERO -> x=ZERO \/ y=ZERO.
+Theorem Zmult_integral : forall n m:Z, n * m = Z0 -> n = Z0 \/ m = Z0.
Proof.
-Intros x y; NewDestruct x; NewDestruct y; Auto; Simpl; Intro H; Discriminate H.
+intros x y; destruct x; destruct y; auto; simpl in |- *; intro H;
+ discriminate H.
Qed.
-V7only [Unset Implicit Arguments.].
-Lemma Zmult_1_inversion_l :
- (x,y:Z) (Zmult x y)=(POS xH) -> x=(POS xH) \/ x=(NEG xH).
+Lemma Zmult_1_inversion_l :
+ forall n m:Z, n * m = Zpos 1 -> n = Zpos 1 \/ n = Zneg 1.
Proof.
-Intros x y; NewDestruct x as [|p|p]; Intro; [ Discriminate | Left | Right ];
- (NewDestruct y as [|q|q]; Try Discriminate;
- Simpl in H; Injection H; Clear H; Intro H;
- Rewrite times_one_inversion_l with 1:=H; Reflexivity).
+intros x y; destruct x as [| p| p]; intro; [ discriminate | left | right ];
+ (destruct y as [| q| q]; try discriminate; simpl in H; injection H; clear H;
+ intro H; rewrite Pmult_1_inversion_l with (1 := H);
+ reflexivity).
Qed.
(** Multiplication and Opposite *)
-Theorem Zopp_Zmult_l : (x,y:Z)(Zopp (Zmult x y)) = (Zmult (Zopp x) y).
+Theorem Zopp_mult_distr_l : forall n m:Z, - (n * m) = - n * m.
Proof.
-Intros x y; NewDestruct x; NewDestruct y; Reflexivity.
+intros x y; destruct x; destruct y; reflexivity.
Qed.
-Theorem Zopp_Zmult_r : (x,y:Z)(Zopp (Zmult x y)) = (Zmult x (Zopp y)).
-Intros x y; Rewrite (Zmult_sym x y); Rewrite Zopp_Zmult_l; Apply Zmult_sym.
+Theorem Zopp_mult_distr_r : forall n m:Z, - (n * m) = n * - m.
+intros x y; rewrite (Zmult_comm x y); rewrite Zopp_mult_distr_l;
+ apply Zmult_comm.
Qed.
-Lemma Zopp_Zmult: (x,y:Z) (Zmult (Zopp x) y) = (Zopp (Zmult x y)).
+Lemma Zopp_mult_distr_l_reverse : forall n m:Z, - n * m = - (n * m).
Proof.
-Intros x y; Symmetry; Apply Zopp_Zmult_l.
+intros x y; symmetry in |- *; apply Zopp_mult_distr_l.
Qed.
-Theorem Zmult_Zopp_left : (x,y:Z)(Zmult (Zopp x) y) = (Zmult x (Zopp y)).
-Intros x y; Rewrite Zopp_Zmult; Rewrite Zopp_Zmult_r; Trivial with arith.
+Theorem Zmult_opp_comm : forall n m:Z, - n * m = n * - m.
+intros x y; rewrite Zopp_mult_distr_l_reverse; rewrite Zopp_mult_distr_r;
+ trivial with arith.
Qed.
-Theorem Zmult_Zopp_Zopp: (x,y:Z) (Zmult (Zopp x) (Zopp y)) = (Zmult x y).
+Theorem Zmult_opp_opp : forall n m:Z, - n * - m = n * m.
Proof.
-Intros x y; NewDestruct x; NewDestruct y; Reflexivity.
+intros x y; destruct x; destruct y; reflexivity.
Qed.
-Theorem Zopp_one : (x:Z)(Zopp x)=(Zmult x (NEG xH)).
-Intro x; NewInduction x; Intros; Rewrite Zmult_sym; Auto with arith.
+Theorem Zopp_eq_mult_neg_1 : forall n:Z, - n = n * Zneg 1.
+intro x; induction x; intros; rewrite Zmult_comm; auto with arith.
Qed.
(** Distributivity of multiplication over addition *)
-Lemma weak_Zmult_plus_distr_r:
- (x:positive)(y,z:Z)
- (Zmult (POS x) (Zplus y z)) = (Zplus (Zmult (POS x) y) (Zmult (POS x) z)).
+Lemma weak_Zmult_plus_distr_r :
+ forall (p:positive) (n m:Z), Zpos p * (n + m) = Zpos p * n + Zpos p * m.
Proof.
-Intros x y' z';Case y';Case z';Auto with arith;Intros y z;
- (Simpl; Rewrite times_add_distr; Trivial with arith)
-Orelse
- (Simpl; ElimPcompare z y; Intros E0;Rewrite E0; [
- Rewrite (compare_convert_EGAL z y E0);
- Rewrite (convert_compare_EGAL (times x y)); Trivial with arith
- | Cut (compare (times x z) (times x y) EGAL)=INFERIEUR; [
- Intros E;Rewrite E; Rewrite times_true_sub_distr; [
- Trivial with arith
- | Apply ZC2;Assumption ]
- | Apply convert_compare_INFERIEUR;Do 2 Rewrite times_convert;
- Elim (ZL4 x);Intros h H1;Rewrite H1;Apply lt_mult_left;
- Exact (compare_convert_INFERIEUR z y E0)]
- | Cut (compare (times x z) (times x y) EGAL)=SUPERIEUR; [
- Intros E;Rewrite E; Rewrite times_true_sub_distr; Auto with arith
- | Apply convert_compare_SUPERIEUR; Unfold gt; Do 2 Rewrite times_convert;
- Elim (ZL4 x);Intros h H1;Rewrite H1;Apply lt_mult_left;
- Exact (compare_convert_SUPERIEUR z y E0) ]]).
+intros x y' z'; case y'; case z'; auto with arith; intros y z;
+ (simpl in |- *; rewrite Pmult_plus_distr_l; trivial with arith) ||
+ (simpl in |- *; ElimPcompare z y; intros E0; rewrite E0;
+ [ rewrite (Pcompare_Eq_eq z y E0); rewrite (Pcompare_refl (x * y));
+ trivial with arith
+ | cut ((x * z ?= x * y)%positive Eq = Lt);
+ [ intros E; rewrite E; rewrite Pmult_minus_distr_l;
+ [ trivial with arith | apply ZC2; assumption ]
+ | apply nat_of_P_lt_Lt_compare_complement_morphism;
+ do 2 rewrite nat_of_P_mult_morphism; elim (ZL4 x);
+ intros h H1; rewrite H1; apply mult_S_lt_compat_l;
+ exact (nat_of_P_lt_Lt_compare_morphism z y E0) ]
+ | cut ((x * z ?= x * y)%positive Eq = Gt);
+ [ intros E; rewrite E; rewrite Pmult_minus_distr_l; auto with arith
+ | apply nat_of_P_gt_Gt_compare_complement_morphism; unfold gt in |- *;
+ do 2 rewrite nat_of_P_mult_morphism; elim (ZL4 x);
+ intros h H1; rewrite H1; apply mult_S_lt_compat_l;
+ exact (nat_of_P_gt_Gt_compare_morphism z y E0) ] ]).
Qed.
-Theorem Zmult_plus_distr_r:
- (x,y,z:Z) (Zmult x (Zplus y z)) = (Zplus (Zmult x y) (Zmult x z)).
+Theorem Zmult_plus_distr_r : forall n m p:Z, n * (m + p) = n * m + n * p.
Proof.
-Intros x y z; Case x; [
- Auto with arith
-| Intros x';Apply weak_Zmult_plus_distr_r
-| Intros p; Apply Zopp_intro; Rewrite Zopp_Zplus;
- Do 3 Rewrite <- Zopp_Zmult; Rewrite Zopp_NEG;
- Apply weak_Zmult_plus_distr_r ].
+intros x y z; case x;
+ [ auto with arith
+ | intros x'; apply weak_Zmult_plus_distr_r
+ | intros p; apply Zopp_inj; rewrite Zopp_plus_distr;
+ do 3 rewrite <- Zopp_mult_distr_l_reverse; rewrite Zopp_neg;
+ apply weak_Zmult_plus_distr_r ].
Qed.
-Theorem Zmult_plus_distr_l :
- (n,m,p:Z)((Zmult (Zplus n m) p)=(Zplus (Zmult n p) (Zmult m p))).
+Theorem Zmult_plus_distr_l : forall n m p:Z, (n + m) * p = n * p + m * p.
Proof.
-Intros n m p;Rewrite Zmult_sym;Rewrite Zmult_plus_distr_r;
-Do 2 Rewrite -> (Zmult_sym p); Trivial with arith.
+intros n m p; rewrite Zmult_comm; rewrite Zmult_plus_distr_r;
+ do 2 rewrite (Zmult_comm p); trivial with arith.
Qed.
(** Distributivity of multiplication over subtraction *)
-Lemma Zmult_Zminus_distr_l :
- (x,y,z:Z)((Zmult (Zminus x y) z)=(Zminus (Zmult x z) (Zmult y z))).
+Lemma Zmult_minus_distr_r : forall n m p:Z, (n - m) * p = n * p - m * p.
Proof.
-Intros x y z; Unfold Zminus.
-Rewrite <- Zopp_Zmult.
-Apply Zmult_plus_distr_l.
+intros x y z; unfold Zminus in |- *.
+rewrite <- Zopp_mult_distr_l_reverse.
+apply Zmult_plus_distr_l.
Qed.
-V7only [Notation Zmult_minus_distr := Zmult_Zminus_distr_l.].
-Lemma Zmult_Zminus_distr_r :
- (x,y,z:Z)(Zmult z (Zminus x y)) = (Zminus (Zmult z x) (Zmult z y)).
+Lemma Zmult_minus_distr_l : forall n m p:Z, p * (n - m) = p * n - p * m.
Proof.
-Intros x y z; Rewrite (Zmult_sym z (Zminus x y)).
-Rewrite (Zmult_sym z x).
-Rewrite (Zmult_sym z y).
-Apply Zmult_Zminus_distr_l.
+intros x y z; rewrite (Zmult_comm z (x - y)).
+rewrite (Zmult_comm z x).
+rewrite (Zmult_comm z y).
+apply Zmult_minus_distr_r.
Qed.
(** Simplification of multiplication for non-zero integers *)
-V7only [Set Implicit Arguments.].
-Lemma Zmult_reg_left : (x,y,z:Z) z<>ZERO -> (Zmult z x)=(Zmult z y) -> x=y.
+Lemma Zmult_reg_l : forall n m p:Z, p <> Z0 -> p * n = p * m -> n = m.
Proof.
-Intros x y z H H0.
-Generalize (Zeq_Zminus H0).
-Intro.
-Apply Zminus_Zeq.
-Rewrite <- Zmult_Zminus_distr_r in H1.
-Clear H0; NewDestruct (Zmult_zero H1).
-Contradiction.
-Trivial.
+intros x y z H H0.
+generalize (Zeq_minus _ _ H0).
+intro.
+apply Zminus_eq.
+rewrite <- Zmult_minus_distr_l in H1.
+clear H0; destruct (Zmult_integral _ _ H1).
+contradiction.
+trivial.
Qed.
-Lemma Zmult_reg_right : (x,y,z:Z) z<>ZERO -> (Zmult x z)=(Zmult y z) -> x=y.
+Lemma Zmult_reg_r : forall n m p:Z, p <> Z0 -> n * p = m * p -> n = m.
Proof.
-Intros x y z Hz.
-Rewrite (Zmult_sym x z).
-Rewrite (Zmult_sym y z).
-Intro; Apply Zmult_reg_left with z; Assumption.
+intros x y z Hz.
+rewrite (Zmult_comm x z).
+rewrite (Zmult_comm y z).
+intro; apply Zmult_reg_l with z; assumption.
Qed.
-V7only [Unset Implicit Arguments.].
(** Addition and multiplication by 2 *)
-Lemma Zplus_Zmult_2 : (x:Z) (Zplus x x) = (Zmult x (POS (xO xH))).
+Lemma Zplus_diag_eq_mult_2 : forall n:Z, n + n = n * Zpos 2.
Proof.
-Intros x; Pattern 1 2 x ; Rewrite <- (Zmult_n_1 x);
-Rewrite <- Zmult_plus_distr_r; Reflexivity.
+intros x; pattern x at 1 2 in |- *; rewrite <- (Zmult_1_r x);
+ rewrite <- Zmult_plus_distr_r; reflexivity.
Qed.
(** Multiplication and successor *)
-Lemma Zmult_succ_r : (n,m:Z) (Zmult n (Zs m))=(Zplus (Zmult n m) n).
+Lemma Zmult_succ_r : forall n m:Z, n * Zsucc m = n * m + n.
Proof.
-Intros n m;Unfold Zs; Rewrite Zmult_plus_distr_r;
-Rewrite (Zmult_sym n (POS xH));Rewrite Zmult_one; Trivial with arith.
+intros n m; unfold Zsucc in |- *; rewrite Zmult_plus_distr_r;
+ rewrite (Zmult_comm n (Zpos 1)); rewrite Zmult_1_l;
+ trivial with arith.
Qed.
-Lemma Zmult_n_Sm : (n,m:Z) (Zplus (Zmult n m) n)=(Zmult n (Zs m)).
+Lemma Zmult_succ_r_reverse : forall n m:Z, n * m + n = n * Zsucc m.
Proof.
-Intros; Symmetry; Apply Zmult_succ_r.
+intros; symmetry in |- *; apply Zmult_succ_r.
Qed.
-Lemma Zmult_succ_l : (n,m:Z) (Zmult (Zs n) m)=(Zplus (Zmult n m) m).
+Lemma Zmult_succ_l : forall n m:Z, Zsucc n * m = n * m + m.
Proof.
-Intros n m; Unfold Zs; Rewrite Zmult_plus_distr_l; Rewrite Zmult_1_n;
-Trivial with arith.
+intros n m; unfold Zsucc in |- *; rewrite Zmult_plus_distr_l;
+ rewrite Zmult_1_l; trivial with arith.
Qed.
-Lemma Zmult_Sm_n : (n,m:Z) (Zplus (Zmult n m) m)=(Zmult (Zs n) m).
+Lemma Zmult_succ_l_reverse : forall n m:Z, n * m + m = Zsucc n * m.
Proof.
-Intros; Symmetry; Apply Zmult_succ_l.
+intros; symmetry in |- *; apply Zmult_succ_l.
Qed.
(** Misc redundant properties *)
-Lemma Z_eq_mult:
- (x,y:Z) y = ZERO -> (Zmult y x) = ZERO.
-Intros x y H; Rewrite H; Auto with arith.
+Lemma Z_eq_mult : forall n m:Z, m = Z0 -> m * n = Z0.
+intros x y H; rewrite H; auto with arith.
Qed.
(**********************************************************************)
(** Relating binary positive numbers and binary integers *)
-Lemma POS_xI : (p:positive) (POS (xI p))=(Zplus (Zmult (POS (xO xH)) (POS p)) (POS xH)).
+Lemma Zpos_xI : forall p:positive, Zpos (xI p) = Zpos 2 * Zpos p + Zpos 1.
Proof.
-Intro; Apply refl_equal.
+intro; apply refl_equal.
Qed.
-Lemma POS_xO : (p:positive) (POS (xO p))=(Zmult (POS (xO xH)) (POS p)).
+Lemma Zpos_xO : forall p:positive, Zpos (xO p) = Zpos 2 * Zpos p.
Proof.
-Intro; Apply refl_equal.
+intro; apply refl_equal.
Qed.
-Lemma NEG_xI : (p:positive) (NEG (xI p))=(Zminus (Zmult (POS (xO xH)) (NEG p)) (POS xH)).
+Lemma Zneg_xI : forall p:positive, Zneg (xI p) = Zpos 2 * Zneg p - Zpos 1.
Proof.
-Intro; Apply refl_equal.
+intro; apply refl_equal.
Qed.
-Lemma NEG_xO : (p:positive) (NEG (xO p))=(Zmult (POS (xO xH)) (NEG p)).
+Lemma Zneg_xO : forall p:positive, Zneg (xO p) = Zpos 2 * Zneg p.
Proof.
-Reflexivity.
+reflexivity.
Qed.
-Lemma POS_add : (p,p':positive)(POS (add p p'))=(Zplus (POS p) (POS p')).
+Lemma Zpos_plus_distr : forall p q:positive, Zpos (p + q) = Zpos p + Zpos q.
Proof.
-Intros p p'; NewDestruct p; NewDestruct p'; Reflexivity.
+intros p p'; destruct p;
+ [ destruct p' as [p0| p0| ]
+ | destruct p' as [p0| p0| ]
+ | destruct p' as [p| p| ] ]; reflexivity.
Qed.
-Lemma NEG_add : (p,p':positive)(NEG (add p p'))=(Zplus (NEG p) (NEG p')).
+Lemma Zneg_plus_distr : forall p q:positive, Zneg (p + q) = Zneg p + Zneg q.
Proof.
-Intros p p'; NewDestruct p; NewDestruct p'; Reflexivity.
+intros p p'; destruct p;
+ [ destruct p' as [p0| p0| ]
+ | destruct p' as [p0| p0| ]
+ | destruct p' as [p| p| ] ]; reflexivity.
Qed.
(**********************************************************************)
(** Order relations *)
-Definition Zlt := [x,y:Z](Zcompare x y) = INFERIEUR.
-Definition Zgt := [x,y:Z](Zcompare x y) = SUPERIEUR.
-Definition Zle := [x,y:Z]~(Zcompare x y) = SUPERIEUR.
-Definition Zge := [x,y:Z]~(Zcompare x y) = INFERIEUR.
-Definition Zne := [x,y:Z] ~(x=y).
+Definition Zlt (x y:Z) := (x ?= y) = Lt.
+Definition Zgt (x y:Z) := (x ?= y) = Gt.
+Definition Zle (x y:Z) := (x ?= y) <> Gt.
+Definition Zge (x y:Z) := (x ?= y) <> Lt.
+Definition Zne (x y:Z) := x <> y.
-V8Infix "<=" Zle : Z_scope.
-V8Infix "<" Zlt : Z_scope.
-V8Infix ">=" Zge : Z_scope.
-V8Infix ">" Zgt : Z_scope.
+Infix "<=" := Zle : Z_scope.
+Infix "<" := Zlt : Z_scope.
+Infix ">=" := Zge : Z_scope.
+Infix ">" := Zgt : Z_scope.
-V8Notation "x <= y <= z" := (Zle x y)/\(Zle y z) :Z_scope.
-V8Notation "x <= y < z" := (Zle x y)/\(Zlt y z) :Z_scope.
-V8Notation "x < y < z" := (Zlt x y)/\(Zlt y z) :Z_scope.
-V8Notation "x < y <= z" := (Zlt x y)/\(Zle y z) :Z_scope.
+Notation "x <= y <= z" := (x <= y /\ y <= z) : Z_scope.
+Notation "x <= y < z" := (x <= y /\ y < z) : Z_scope.
+Notation "x < y < z" := (x < y /\ y < z) : Z_scope.
+Notation "x < y <= z" := (x < y /\ y <= z) : Z_scope.
(**********************************************************************)
(** Absolute value on integers *)
-Definition absolu [x:Z] : nat :=
- Cases x of
- ZERO => O
- | (POS p) => (convert p)
- | (NEG p) => (convert p)
+Definition Zabs_nat (x:Z) : nat :=
+ match x with
+ | Z0 => 0%nat
+ | Zpos p => nat_of_P p
+ | Zneg p => nat_of_P p
end.
-Definition Zabs [z:Z] : Z :=
- Cases z of
- ZERO => ZERO
- | (POS p) => (POS p)
- | (NEG p) => (POS p)
+Definition Zabs (z:Z) : Z :=
+ match z with
+ | Z0 => Z0
+ | Zpos p => Zpos p
+ | Zneg p => Zpos p
end.
(**********************************************************************)
(** From [nat] to [Z] *)
-Definition inject_nat :=
- [x:nat]Cases x of
- O => ZERO
- | (S y) => (POS (anti_convert y))
- end.
+Definition Z_of_nat (x:nat) :=
+ match x with
+ | O => Z0
+ | S y => Zpos (P_of_succ_nat y)
+ end.
-Require BinNat.
+Require Import BinNat.
-Definition entier_of_Z :=
- [z:Z]Cases z of ZERO => Nul | (POS p) => (Pos p) | (NEG p) => (Pos p) end.
+Definition Zabs_N (z:Z) :=
+ match z with
+ | Z0 => 0%N
+ | Zpos p => Npos p
+ | Zneg p => Npos p
+ end.
-Definition Z_of_entier :=
- [x:entier]Cases x of Nul => ZERO | (Pos p) => (POS p) end.
+Definition Z_of_N (x:N) := match x with
+ | N0 => Z0
+ | Npos p => Zpos p
+ end. \ No newline at end of file
diff --git a/theories/ZArith/Wf_Z.v b/theories/ZArith/Wf_Z.v
index eecfc42b2..4c2efceb1 100644
--- a/theories/ZArith/Wf_Z.v
+++ b/theories/ZArith/Wf_Z.v
@@ -8,14 +8,12 @@
(*i $Id$ i*)
-Require BinInt.
-Require Zcompare.
-Require Zorder.
-Require Znat.
-Require Zmisc.
-Require Zsyntax.
-Require Wf_nat.
-V7only [Import Z_scope.].
+Require Import BinInt.
+Require Import Zcompare.
+Require Import Zorder.
+Require Import Znat.
+Require Import Zmisc.
+Require Import Wf_nat.
Open Local Scope Z_scope.
(** Our purpose is to write an induction shema for {0,1,2,...}
@@ -36,86 +34,83 @@ Open Local Scope Z_scope.
>>
Then the diagram will be closed and the theorem proved. *)
-Lemma inject_nat_complete :
- (x:Z)`0 <= x` -> (EX n:nat | x=(inject_nat n)).
-Intro x; NewDestruct x; Intros;
-[ Exists O; Auto with arith
-| Specialize (ZL4 p); Intros Hp; Elim Hp; Intros;
- Exists (S x); Intros; Simpl;
- Specialize (bij1 x); Intro Hx0;
- Rewrite <- H0 in Hx0;
- Apply f_equal with f:=POS;
- Apply convert_intro; Auto with arith
-| Absurd `0 <= (NEG p)`;
- [ Unfold Zle; Simpl; Do 2 (Unfold not); Auto with arith
- | Assumption]
-].
+Lemma Z_of_nat_complete :
+ forall x:Z, 0 <= x -> exists n : nat | x = Z_of_nat n.
+intro x; destruct x; intros;
+ [ exists 0%nat; auto with arith
+ | specialize (ZL4 p); intros Hp; elim Hp; intros; exists (S x); intros;
+ simpl in |- *; specialize (nat_of_P_o_P_of_succ_nat_eq_succ x);
+ intro Hx0; rewrite <- H0 in Hx0; apply f_equal with (f := Zpos);
+ apply nat_of_P_inj; auto with arith
+ | absurd (0 <= Zneg p);
+ [ unfold Zle in |- *; simpl in |- *; do 2 unfold not in |- *;
+ auto with arith
+ | assumption ] ].
Qed.
-Lemma ZL4_inf: (y:positive) { h:nat | (convert y)=(S h) }.
-Intro y; NewInduction y as [p H|p H1|]; [
- Elim H; Intros x H1; Exists (plus (S x) (S x));
- Unfold convert ;Simpl; Rewrite ZL0; Rewrite ZL2; Unfold convert in H1;
- Rewrite H1; Auto with arith
-| Elim H1;Intros x H2; Exists (plus x (S x)); Unfold convert;
- Simpl; Rewrite ZL0; Rewrite ZL2;Unfold convert in H2; Rewrite H2; Auto with arith
-| Exists O ;Auto with arith].
+Lemma ZL4_inf : forall y:positive, {h : nat | nat_of_P y = S h}.
+intro y; induction y as [p H| p H1| ];
+ [ elim H; intros x H1; exists (S x + S x)%nat; unfold nat_of_P in |- *;
+ simpl in |- *; rewrite ZL0; rewrite Pmult_nat_r_plus_morphism;
+ unfold nat_of_P in H1; rewrite H1; auto with arith
+ | elim H1; intros x H2; exists (x + S x)%nat; unfold nat_of_P in |- *;
+ simpl in |- *; rewrite ZL0; rewrite Pmult_nat_r_plus_morphism;
+ unfold nat_of_P in H2; rewrite H2; auto with arith
+ | exists 0%nat; auto with arith ].
Qed.
-Lemma inject_nat_complete_inf :
- (x:Z)`0 <= x` -> { n:nat | (x=(inject_nat n)) }.
-Intro x; NewDestruct x; Intros;
-[ Exists O; Auto with arith
-| Specialize (ZL4_inf p); Intros Hp; Elim Hp; Intros x0 H0;
- Exists (S x0); Intros; Simpl;
- Specialize (bij1 x0); Intro Hx0;
- Rewrite <- H0 in Hx0;
- Apply f_equal with f:=POS;
- Apply convert_intro; Auto with arith
-| Absurd `0 <= (NEG p)`;
- [ Unfold Zle; Simpl; Do 2 (Unfold not); Auto with arith
- | Assumption]
-].
+Lemma Z_of_nat_complete_inf :
+ forall x:Z, 0 <= x -> {n : nat | x = Z_of_nat n}.
+intro x; destruct x; intros;
+ [ exists 0%nat; auto with arith
+ | specialize (ZL4_inf p); intros Hp; elim Hp; intros x0 H0; exists (S x0);
+ intros; simpl in |- *; specialize (nat_of_P_o_P_of_succ_nat_eq_succ x0);
+ intro Hx0; rewrite <- H0 in Hx0; apply f_equal with (f := Zpos);
+ apply nat_of_P_inj; auto with arith
+ | absurd (0 <= Zneg p);
+ [ unfold Zle in |- *; simpl in |- *; do 2 unfold not in |- *;
+ auto with arith
+ | assumption ] ].
Qed.
-Lemma inject_nat_prop :
- (P:Z->Prop)((n:nat)(P (inject_nat n))) ->
- (x:Z) `0 <= x` -> (P x).
-Intros P H x H0.
-Specialize (inject_nat_complete x H0).
-Intros Hn; Elim Hn; Intros.
-Rewrite -> H1; Apply H.
+Lemma Z_of_nat_prop :
+ forall P:Z -> Prop,
+ (forall n:nat, P (Z_of_nat n)) -> forall x:Z, 0 <= x -> P x.
+intros P H x H0.
+specialize (Z_of_nat_complete x H0).
+intros Hn; elim Hn; intros.
+rewrite H1; apply H.
Qed.
-Lemma inject_nat_set :
- (P:Z->Set)((n:nat)(P (inject_nat n))) ->
- (x:Z) `0 <= x` -> (P x).
-Intros P H x H0.
-Specialize (inject_nat_complete_inf x H0).
-Intros Hn; Elim Hn; Intros.
-Rewrite -> p; Apply H.
+Lemma Z_of_nat_set :
+ forall P:Z -> Set,
+ (forall n:nat, P (Z_of_nat n)) -> forall x:Z, 0 <= x -> P x.
+intros P H x H0.
+specialize (Z_of_nat_complete_inf x H0).
+intros Hn; elim Hn; intros.
+rewrite p; apply H.
Qed.
-Lemma natlike_ind : (P:Z->Prop) (P `0`) ->
- ((x:Z)(`0 <= x` -> (P x) -> (P (Zs x)))) ->
- (x:Z) `0 <= x` -> (P x).
-Intros P H H0 x H1; Apply inject_nat_prop;
-[ Induction n;
- [ Simpl; Assumption
- | Intros; Rewrite -> (inj_S n0);
- Exact (H0 (inject_nat n0) (ZERO_le_inj n0) H2) ]
-| Assumption].
+Lemma natlike_ind :
+ forall P:Z -> Prop,
+ P 0 ->
+ (forall x:Z, 0 <= x -> P x -> P (Zsucc x)) -> forall x:Z, 0 <= x -> P x.
+intros P H H0 x H1; apply Z_of_nat_prop;
+ [ simple induction n;
+ [ simpl in |- *; assumption
+ | intros; rewrite (inj_S n0); exact (H0 (Z_of_nat n0) (Zle_0_nat n0) H2) ]
+ | assumption ].
Qed.
-Lemma natlike_rec : (P:Z->Set) (P `0`) ->
- ((x:Z)(`0 <= x` -> (P x) -> (P (Zs x)))) ->
- (x:Z) `0 <= x` -> (P x).
-Intros P H H0 x H1; Apply inject_nat_set;
-[ Induction n;
- [ Simpl; Assumption
- | Intros; Rewrite -> (inj_S n0);
- Exact (H0 (inject_nat n0) (ZERO_le_inj n0) H2) ]
-| Assumption].
+Lemma natlike_rec :
+ forall P:Z -> Set,
+ P 0 ->
+ (forall x:Z, 0 <= x -> P x -> P (Zsucc x)) -> forall x:Z, 0 <= x -> P x.
+intros P H H0 x H1; apply Z_of_nat_set;
+ [ simple induction n;
+ [ simpl in |- *; assumption
+ | intros; rewrite (inj_S n0); exact (H0 (Z_of_nat n0) (Zle_0_nat n0) H2) ]
+ | assumption ].
Qed.
Section Efficient_Rec.
@@ -123,72 +118,87 @@ Section Efficient_Rec.
(** [natlike_rec2] is the same as [natlike_rec], but with a different proof, designed
to give a better extracted term. *)
-Local R := [a,b:Z]`0<=a`/\`a<b`.
+Let R (a b:Z) := 0 <= a /\ a < b.
-Local R_wf : (well_founded Z R).
+Let R_wf : well_founded R.
Proof.
-LetTac f := [z]Cases z of (POS p) => (convert p) | ZERO => O | (NEG _) => O end.
-Apply well_founded_lt_compat with f.
-Unfold R f; Clear f R.
-Intros x y; Case x; Intros; Elim H; Clear H.
-Case y; Intros; Apply compare_convert_O Orelse Inversion H0.
-Case y; Intros; Apply compare_convert_INFERIEUR Orelse Inversion H0; Auto.
-Intros; Elim H; Auto.
+set
+ (f :=
+ fun z =>
+ match z with
+ | Zpos p => nat_of_P p
+ | Z0 => 0%nat
+ | Zneg _ => 0%nat
+ end) in *.
+apply well_founded_lt_compat with f.
+unfold R, f in |- *; clear f R.
+intros x y; case x; intros; elim H; clear H.
+case y; intros; apply lt_O_nat_of_P || inversion H0.
+case y; intros; apply nat_of_P_lt_Lt_compare_morphism || inversion H0; auto.
+intros; elim H; auto.
Qed.
-Lemma natlike_rec2 : (P:Z->Type)(P `0`) ->
- ((z:Z)`0<=z` -> (P z) -> (P (Zs z))) -> (z:Z)`0<=z` -> (P z).
+Lemma natlike_rec2 :
+ forall P:Z -> Type,
+ P 0 ->
+ (forall z:Z, 0 <= z -> P z -> P (Zsucc z)) -> forall z:Z, 0 <= z -> P z.
Proof.
-Intros P Ho Hrec z; Pattern z; Apply (well_founded_induction_type Z R R_wf).
-Intro x; Case x.
-Trivial.
-Intros.
-Assert `0<=(Zpred (POS p))`.
-Apply Zlt_ZERO_pred_le_ZERO; Unfold Zlt; Simpl; Trivial.
-Rewrite Zs_pred.
-Apply Hrec.
-Auto.
-Apply X; Auto; Unfold R; Intuition; Apply Zlt_pred_n_n.
-Intros; Elim H; Simpl; Trivial.
+intros P Ho Hrec z; pattern z in |- *;
+ apply (well_founded_induction_type R_wf).
+intro x; case x.
+trivial.
+intros.
+assert (0 <= Zpred (Zpos p)).
+apply Zorder.Zlt_0_le_0_pred; unfold Zlt in |- *; simpl in |- *; trivial.
+rewrite Zsucc_pred.
+apply Hrec.
+auto.
+apply X; auto; unfold R in |- *; intuition; apply Zlt_pred.
+intros; elim H; simpl in |- *; trivial.
Qed.
(** A variant of the previous using [Zpred] instead of [Zs]. *)
-Lemma natlike_rec3 : (P:Z->Type)(P `0`) ->
- ((z:Z)`0<z` -> (P (Zpred z)) -> (P z)) -> (z:Z)`0<=z` -> (P z).
+Lemma natlike_rec3 :
+ forall P:Z -> Type,
+ P 0 ->
+ (forall z:Z, 0 < z -> P (Zpred z) -> P z) -> forall z:Z, 0 <= z -> P z.
Proof.
-Intros P Ho Hrec z; Pattern z; Apply (well_founded_induction_type Z R R_wf).
-Intro x; Case x.
-Trivial.
-Intros; Apply Hrec.
-Unfold Zlt; Trivial.
-Assert `0<=(Zpred (POS p))`.
-Apply Zlt_ZERO_pred_le_ZERO; Unfold Zlt; Simpl; Trivial.
-Apply X; Auto; Unfold R; Intuition; Apply Zlt_pred_n_n.
-Intros; Elim H; Simpl; Trivial.
+intros P Ho Hrec z; pattern z in |- *;
+ apply (well_founded_induction_type R_wf).
+intro x; case x.
+trivial.
+intros; apply Hrec.
+unfold Zlt in |- *; trivial.
+assert (0 <= Zpred (Zpos p)).
+apply Zorder.Zlt_0_le_0_pred; unfold Zlt in |- *; simpl in |- *; trivial.
+apply X; auto; unfold R in |- *; intuition; apply Zlt_pred.
+intros; elim H; simpl in |- *; trivial.
Qed.
(** A more general induction principal using [Zlt]. *)
-Lemma Z_lt_rec : (P:Z->Type)
- ((x:Z)((y:Z)`0 <= y < x`->(P y))->(P x)) -> (x:Z)`0 <= x`->(P x).
+Lemma Z_lt_rec :
+ forall P:Z -> Type,
+ (forall x:Z, (forall y:Z, 0 <= y < x -> P y) -> P x) ->
+ forall x:Z, 0 <= x -> P x.
Proof.
-Intros P Hrec z; Pattern z; Apply (well_founded_induction_type Z R R_wf).
-Intro x; Case x; Intros.
-Apply Hrec; Intros.
-Assert H2: `0<0`.
- Apply Zle_lt_trans with y; Intuition.
-Inversion H2.
-Firstorder.
-Unfold Zle Zcompare in H; Elim H; Auto.
+intros P Hrec z; pattern z in |- *; apply (well_founded_induction_type R_wf).
+intro x; case x; intros.
+apply Hrec; intros.
+assert (H2 : 0 < 0).
+ apply Zle_lt_trans with y; intuition.
+inversion H2.
+firstorder.
+unfold Zle, Zcompare in H; elim H; auto.
Defined.
-Lemma Z_lt_induction :
- (P:Z->Prop)
- ((x:Z)((y:Z)`0 <= y < x`->(P y))->(P x))
- -> (x:Z)`0 <= x`->(P x).
+Lemma Z_lt_induction :
+ forall P:Z -> Prop,
+ (forall x:Z, (forall y:Z, 0 <= y < x -> P y) -> P x) ->
+ forall x:Z, 0 <= x -> P x.
Proof.
-Exact Z_lt_rec.
+exact Z_lt_rec.
Qed.
-End Efficient_Rec.
+End Efficient_Rec. \ No newline at end of file
diff --git a/theories/ZArith/ZArith.v b/theories/ZArith/ZArith.v
index f85b0bddd..bc58a1a4b 100644
--- a/theories/ZArith/ZArith.v
+++ b/theories/ZArith/ZArith.v
@@ -19,4 +19,4 @@ Require Export Zsqrt.
Require Export Zpower.
Require Export Zdiv.
Require Export Zlogarithm.
-Require Export Zbool.
+Require Export Zbool. \ No newline at end of file
diff --git a/theories/ZArith/ZArith_base.v b/theories/ZArith/ZArith_base.v
index 97f4c3f3e..ec57dda57 100644
--- a/theories/ZArith/ZArith_base.v
+++ b/theories/ZArith/ZArith_base.v
@@ -12,10 +12,6 @@
These are the basic modules, required by [Omega] and [Ring] for instance.
The full library is [ZArith]. *)
-V7only [
-Require Export fast_integer.
-Require Export zarith_aux.
-].
Require Export BinPos.
Require Export BinNat.
Require Export BinInt.
@@ -26,14 +22,13 @@ Require Export Zmin.
Require Export Zabs.
Require Export Znat.
Require Export auxiliary.
-Require Export Zsyntax.
Require Export ZArith_dec.
Require Export Zbool.
Require Export Zmisc.
Require Export Wf_Z.
-Hints Resolve Zle_n Zplus_sym Zplus_assoc Zmult_sym Zmult_assoc
- Zero_left Zero_right Zmult_one Zplus_inverse_l Zplus_inverse_r
- Zmult_plus_distr_l Zmult_plus_distr_r : zarith.
+Hint Resolve Zle_refl Zplus_comm Zplus_assoc Zmult_comm Zmult_assoc Zplus_0_l
+ Zplus_0_r Zmult_1_l Zplus_opp_l Zplus_opp_r Zmult_plus_distr_l
+ Zmult_plus_distr_r: zarith.
-Require Export Zhints.
+Require Export Zhints. \ No newline at end of file
diff --git a/theories/ZArith/ZArith_dec.v b/theories/ZArith/ZArith_dec.v
index e8f83fe1a..ed323a641 100644
--- a/theories/ZArith/ZArith_dec.v
+++ b/theories/ZArith/ZArith_dec.v
@@ -8,236 +8,219 @@
(*i $Id$ i*)
-Require Sumbool.
+Require Import Sumbool.
-Require BinInt.
-Require Zorder.
-Require Zcompare.
-Require Zsyntax.
-V7only [Import Z_scope.].
+Require Import BinInt.
+Require Import Zorder.
+Require Import Zcompare.
Open Local Scope Z_scope.
-Lemma Dcompare_inf : (r:relation) {r=EGAL} + {r=INFERIEUR} + {r=SUPERIEUR}.
+Lemma Dcompare_inf : forall r:comparison, {r = Eq} + {r = Lt} + {r = Gt}.
Proof.
-Induction r; Auto with arith.
+simple induction r; auto with arith.
Defined.
Lemma Zcompare_rec :
- (P:Set)(x,y:Z)
- ((Zcompare x y)=EGAL -> P) ->
- ((Zcompare x y)=INFERIEUR -> P) ->
- ((Zcompare x y)=SUPERIEUR -> P) ->
- P.
+ forall (P:Set) (n m:Z),
+ ((n ?= m) = Eq -> P) -> ((n ?= m) = Lt -> P) -> ((n ?= m) = Gt -> P) -> P.
Proof.
-Intros P x y H1 H2 H3.
-Elim (Dcompare_inf (Zcompare x y)).
-Intro H. Elim H; Auto with arith. Auto with arith.
+intros P x y H1 H2 H3.
+elim (Dcompare_inf (x ?= y)).
+intro H. elim H; auto with arith. auto with arith.
Defined.
Section decidability.
-Variables x,y : Z.
+Variables x y : Z.
(** Decidability of equality on binary integers *)
-Definition Z_eq_dec : {x=y}+{~x=y}.
+Definition Z_eq_dec : {x = y} + {x <> y}.
Proof.
-Apply Zcompare_rec with x:=x y:=y.
-Intro. Left. Elim (Zcompare_EGAL x y); Auto with arith.
-Intro H3. Right. Elim (Zcompare_EGAL x y). Intros H1 H2. Unfold not. Intro H4.
- Rewrite (H2 H4) in H3. Discriminate H3.
-Intro H3. Right. Elim (Zcompare_EGAL x y). Intros H1 H2. Unfold not. Intro H4.
- Rewrite (H2 H4) in H3. Discriminate H3.
+apply Zcompare_rec with (n := x) (m := y).
+intro. left. elim (Zcompare_Eq_iff_eq x y); auto with arith.
+intro H3. right. elim (Zcompare_Eq_iff_eq x y). intros H1 H2. unfold not in |- *. intro H4.
+ rewrite (H2 H4) in H3. discriminate H3.
+intro H3. right. elim (Zcompare_Eq_iff_eq x y). intros H1 H2. unfold not in |- *. intro H4.
+ rewrite (H2 H4) in H3. discriminate H3.
Defined.
(** Decidability of order on binary integers *)
-Definition Z_lt_dec : {(Zlt x y)}+{~(Zlt x y)}.
+Definition Z_lt_dec : {x < y} + {~ x < y}.
Proof.
-Unfold Zlt.
-Apply Zcompare_rec with x:=x y:=y; Intro H.
-Right. Rewrite H. Discriminate.
-Left; Assumption.
-Right. Rewrite H. Discriminate.
+unfold Zlt in |- *.
+apply Zcompare_rec with (n := x) (m := y); intro H.
+right. rewrite H. discriminate.
+left; assumption.
+right. rewrite H. discriminate.
Defined.
-Definition Z_le_dec : {(Zle x y)}+{~(Zle x y)}.
+Definition Z_le_dec : {x <= y} + {~ x <= y}.
Proof.
-Unfold Zle.
-Apply Zcompare_rec with x:=x y:=y; Intro H.
-Left. Rewrite H. Discriminate.
-Left. Rewrite H. Discriminate.
-Right. Tauto.
+unfold Zle in |- *.
+apply Zcompare_rec with (n := x) (m := y); intro H.
+left. rewrite H. discriminate.
+left. rewrite H. discriminate.
+right. tauto.
Defined.
-Definition Z_gt_dec : {(Zgt x y)}+{~(Zgt x y)}.
+Definition Z_gt_dec : {x > y} + {~ x > y}.
Proof.
-Unfold Zgt.
-Apply Zcompare_rec with x:=x y:=y; Intro H.
-Right. Rewrite H. Discriminate.
-Right. Rewrite H. Discriminate.
-Left; Assumption.
+unfold Zgt in |- *.
+apply Zcompare_rec with (n := x) (m := y); intro H.
+right. rewrite H. discriminate.
+right. rewrite H. discriminate.
+left; assumption.
Defined.
-Definition Z_ge_dec : {(Zge x y)}+{~(Zge x y)}.
+Definition Z_ge_dec : {x >= y} + {~ x >= y}.
Proof.
-Unfold Zge.
-Apply Zcompare_rec with x:=x y:=y; Intro H.
-Left. Rewrite H. Discriminate.
-Right. Tauto.
-Left. Rewrite H. Discriminate.
+unfold Zge in |- *.
+apply Zcompare_rec with (n := x) (m := y); intro H.
+left. rewrite H. discriminate.
+right. tauto.
+left. rewrite H. discriminate.
Defined.
-Definition Z_lt_ge_dec : {`x < y`}+{`x >= y`}.
+Definition Z_lt_ge_dec : {x < y} + {x >= y}.
Proof.
-Exact Z_lt_dec.
+exact Z_lt_dec.
Defined.
-V7only [ (* From Zextensions *) ].
-Lemma Z_lt_le_dec: {`x < y`}+{`y <= x`}.
+Lemma Z_lt_le_dec : {x < y} + {y <= x}.
Proof.
-Intros.
-Elim Z_lt_ge_dec.
-Intros; Left; Assumption.
-Intros; Right; Apply Zge_le; Assumption.
+intros.
+elim Z_lt_ge_dec.
+intros; left; assumption.
+intros; right; apply Zge_le; assumption.
Qed.
-Definition Z_le_gt_dec : {`x <= y`}+{`x > y`}.
+Definition Z_le_gt_dec : {x <= y} + {x > y}.
Proof.
-Elim Z_le_dec; Auto with arith.
-Intro. Right. Apply not_Zle; Auto with arith.
+elim Z_le_dec; auto with arith.
+intro. right. apply Znot_le_gt; auto with arith.
Defined.
-Definition Z_gt_le_dec : {`x > y`}+{`x <= y`}.
+Definition Z_gt_le_dec : {x > y} + {x <= y}.
Proof.
-Exact Z_gt_dec.
+exact Z_gt_dec.
Defined.
-Definition Z_ge_lt_dec : {`x >= y`}+{`x < y`}.
+Definition Z_ge_lt_dec : {x >= y} + {x < y}.
Proof.
-Elim Z_ge_dec; Auto with arith.
-Intro. Right. Apply not_Zge; Auto with arith.
+elim Z_ge_dec; auto with arith.
+intro. right. apply Znot_ge_lt; auto with arith.
Defined.
-Definition Z_le_lt_eq_dec : `x <= y` -> {`x < y`}+{x=y}.
+Definition Z_le_lt_eq_dec : x <= y -> {x < y} + {x = y}.
Proof.
-Intro H.
-Apply Zcompare_rec with x:=x y:=y.
-Intro. Right. Elim (Zcompare_EGAL x y); Auto with arith.
-Intro. Left. Elim (Zcompare_EGAL x y); Auto with arith.
-Intro H1. Absurd `x > y`; Auto with arith.
+intro H.
+apply Zcompare_rec with (n := x) (m := y).
+intro. right. elim (Zcompare_Eq_iff_eq x y); auto with arith.
+intro. left. elim (Zcompare_Eq_iff_eq x y); auto with arith.
+intro H1. absurd (x > y); auto with arith.
Defined.
End decidability.
(** Cotransitivity of order on binary integers *)
-Lemma Zlt_cotrans:(n,m:Z)`n<m`->(p:Z){`n<p`}+{`p<m`}.
-Proof.
- Intros x y H z.
- Case (Z_lt_ge_dec x z).
- Intro.
- Left.
- Assumption.
- Intro.
- Right.
- Apply Zle_lt_trans with m:=x.
- Apply Zge_le.
- Assumption.
- Assumption.
-Defined.
-
-Lemma Zlt_cotrans_pos:(x,y:Z)`0<x+y`->{`0<x`}+{`0<y`}.
-Proof.
- Intros x y H.
- Case (Zlt_cotrans `0` `x+y` H x).
- Intro.
- Left.
- Assumption.
- Intro.
- Right.
- Apply Zsimpl_lt_plus_l with p:=`x`.
- Rewrite Zero_right.
- Assumption.
-Defined.
-
-Lemma Zlt_cotrans_neg:(x,y:Z)`x+y<0`->{`x<0`}+{`y<0`}.
-Proof.
- Intros x y H;
- Case (Zlt_cotrans `x+y` `0` H x);
- Intro Hxy;
- [ Right;
- Apply Zsimpl_lt_plus_l with p:=`x`;
- Rewrite Zero_right
- | Left
- ];
- Assumption.
-Defined.
-
-Lemma not_Zeq_inf:(x,y:Z)`x<>y`->{`x<y`}+{`y<x`}.
-Proof.
- Intros x y H.
- Case Z_lt_ge_dec with x y.
- Intro.
- Left.
- Assumption.
- Intro H0.
- Generalize (Zge_le ? ? H0).
- Intro.
- Case (Z_le_lt_eq_dec ? ? H1).
- Intro.
- Right.
- Assumption.
- Intro.
- Apply False_rec.
- Apply H.
- Symmetry.
- Assumption.
-Defined.
-
-Lemma Z_dec:(x,y:Z){`x<y`}+{`x>y`}+{`x=y`}.
-Proof.
- Intros x y.
- Case (Z_lt_ge_dec x y).
- Intro H.
- Left.
- Left.
- Assumption.
- Intro H.
- Generalize (Zge_le ? ? H).
- Intro H0.
- Case (Z_le_lt_eq_dec y x H0).
- Intro H1.
- Left.
- Right.
- Apply Zlt_gt.
- Assumption.
- Intro.
- Right.
- Symmetry.
- Assumption.
-Defined.
-
-
-Lemma Z_dec':(x,y:Z){`x<y`}+{`y<x`}+{`x=y`}.
-Proof.
- Intros x y.
- Case (Z_eq_dec x y);
- Intro H;
- [ Right;
- Assumption
- | Left;
- Apply (not_Zeq_inf ?? H)
- ].
-Defined.
-
-
-
-Definition Z_zerop : (x:Z){(`x = 0`)}+{(`x <> 0`)}.
-Proof.
-Exact [x:Z](Z_eq_dec x ZERO).
-Defined.
-
-Definition Z_notzerop := [x:Z](sumbool_not ? ? (Z_zerop x)).
-
-Definition Z_noteq_dec := [x,y:Z](sumbool_not ? ? (Z_eq_dec x y)).
+Lemma Zlt_cotrans : forall n m:Z, n < m -> forall p:Z, {n < p} + {p < m}.
+Proof.
+ intros x y H z.
+ case (Z_lt_ge_dec x z).
+ intro.
+ left.
+ assumption.
+ intro.
+ right.
+ apply Zle_lt_trans with (m := x).
+ apply Zge_le.
+ assumption.
+ assumption.
+Defined.
+
+Lemma Zlt_cotrans_pos : forall n m:Z, 0 < n + m -> {0 < n} + {0 < m}.
+Proof.
+ intros x y H.
+ case (Zlt_cotrans 0 (x + y) H x).
+ intro.
+ left.
+ assumption.
+ intro.
+ right.
+ apply Zplus_lt_reg_l with (p := x).
+ rewrite Zplus_0_r.
+ assumption.
+Defined.
+
+Lemma Zlt_cotrans_neg : forall n m:Z, n + m < 0 -> {n < 0} + {m < 0}.
+Proof.
+ intros x y H; case (Zlt_cotrans (x + y) 0 H x); intro Hxy;
+ [ right; apply Zplus_lt_reg_l with (p := x); rewrite Zplus_0_r | left ];
+ assumption.
+Defined.
+
+Lemma not_Zeq_inf : forall n m:Z, n <> m -> {n < m} + {m < n}.
+Proof.
+ intros x y H.
+ case Z_lt_ge_dec with x y.
+ intro.
+ left.
+ assumption.
+ intro H0.
+ generalize (Zge_le _ _ H0).
+ intro.
+ case (Z_le_lt_eq_dec _ _ H1).
+ intro.
+ right.
+ assumption.
+ intro.
+ apply False_rec.
+ apply H.
+ symmetry in |- *.
+ assumption.
+Defined.
+
+Lemma Z_dec : forall n m:Z, {n < m} + {n > m} + {n = m}.
+Proof.
+ intros x y.
+ case (Z_lt_ge_dec x y).
+ intro H.
+ left.
+ left.
+ assumption.
+ intro H.
+ generalize (Zge_le _ _ H).
+ intro H0.
+ case (Z_le_lt_eq_dec y x H0).
+ intro H1.
+ left.
+ right.
+ apply Zlt_gt.
+ assumption.
+ intro.
+ right.
+ symmetry in |- *.
+ assumption.
+Defined.
+
+
+Lemma Z_dec' : forall n m:Z, {n < m} + {m < n} + {n = m}.
+Proof.
+ intros x y.
+ case (Z_eq_dec x y); intro H;
+ [ right; assumption | left; apply (not_Zeq_inf _ _ H) ].
+Defined.
+
+
+
+Definition Z_zerop : forall x:Z, {x = 0} + {x <> 0}.
+Proof.
+exact (fun x:Z => Z_eq_dec x 0).
+Defined.
+
+Definition Z_notzerop (x:Z) := sumbool_not _ _ (Z_zerop x).
+
+Definition Z_noteq_dec (x y:Z) := sumbool_not _ _ (Z_eq_dec x y). \ No newline at end of file
diff --git a/theories/ZArith/Zabs.v b/theories/ZArith/Zabs.v
index 27c72c4d1..eff457fc5 100644
--- a/theories/ZArith/Zabs.v
+++ b/theories/ZArith/Zabs.v
@@ -9,130 +9,120 @@
(** Binary Integers (Pierre Crégut (CNET, Lannion, France) *)
-Require Arith.
-Require BinPos.
-Require BinInt.
-Require Zorder.
-Require Zsyntax.
-Require ZArith_dec.
-
-V7only [Import nat_scope.].
+Require Import Arith.
+Require Import BinPos.
+Require Import BinInt.
+Require Import Zorder.
+Require Import ZArith_dec.
+
Open Local Scope Z_scope.
(**********************************************************************)
(** Properties of absolute value *)
-Lemma Zabs_eq : (x:Z) (Zle ZERO x) -> (Zabs x)=x.
-Intro x; NewDestruct x; Auto with arith.
-Compute; Intros; Absurd SUPERIEUR=SUPERIEUR; Trivial with arith.
+Lemma Zabs_eq : forall n:Z, 0 <= n -> Zabs n = n.
+intro x; destruct x; auto with arith.
+compute in |- *; intros; absurd (Gt = Gt); trivial with arith.
Qed.
-Lemma Zabs_non_eq : (x:Z) (Zle x ZERO) -> (Zabs x)=(Zopp x).
+Lemma Zabs_non_eq : forall n:Z, n <= 0 -> Zabs n = - n.
Proof.
-Intro x; NewDestruct x; Auto with arith.
-Compute; Intros; Absurd SUPERIEUR=SUPERIEUR; Trivial with arith.
+intro x; destruct x; auto with arith.
+compute in |- *; intros; absurd (Gt = Gt); trivial with arith.
Qed.
-V7only [ (* From Zdivides *) ].
-Theorem Zabs_Zopp: (z : Z) (Zabs (Zopp z)) = (Zabs z).
+Theorem Zabs_Zopp : forall n:Z, Zabs (- n) = Zabs n.
Proof.
-Intros z; Case z; Simpl; Auto.
+intros z; case z; simpl in |- *; auto.
Qed.
(** Proving a property of the absolute value by cases *)
-Lemma Zabs_ind :
- (P:Z->Prop)(x:Z)(`x >= 0` -> (P x)) -> (`x <= 0` -> (P `-x`)) ->
- (P `|x|`).
+Lemma Zabs_ind :
+ forall (P:Z -> Prop) (n:Z),
+ (n >= 0 -> P n) -> (n <= 0 -> P (- n)) -> P (Zabs n).
Proof.
-Intros P x H H0; Elim (Z_lt_ge_dec x `0`); Intro.
-Assert `x<=0`. Apply Zlt_le_weak; Assumption.
-Rewrite Zabs_non_eq. Apply H0. Assumption. Assumption.
-Rewrite Zabs_eq. Apply H; Assumption. Apply Zge_le. Assumption.
-Save.
-
-V7only [ (* From Zdivides *) ].
-Theorem Zabs_intro: (P : ?) (z : Z) (P (Zopp z)) -> (P z) -> (P (Zabs z)).
-Intros P z; Case z; Simpl; Auto.
+intros P x H H0; elim (Z_lt_ge_dec x 0); intro.
+assert (x <= 0). apply Zlt_le_weak; assumption.
+rewrite Zabs_non_eq. apply H0. assumption. assumption.
+rewrite Zabs_eq. apply H; assumption. apply Zge_le. assumption.
+Qed.
+
+Theorem Zabs_intro : forall P (n:Z), P (- n) -> P n -> P (Zabs n).
+intros P z; case z; simpl in |- *; auto.
Qed.
-Definition Zabs_dec : (x:Z){x=(Zabs x)}+{x=(Zopp (Zabs x))}.
+Definition Zabs_dec : forall x:Z, {x = Zabs x} + {x = - Zabs x}.
Proof.
-Intro x; NewDestruct x;Auto with arith.
+intro x; destruct x; auto with arith.
Defined.
-Lemma Zabs_pos : (x:Z)(Zle ZERO (Zabs x)).
-Intro x; NewDestruct x;Auto with arith; Compute; Intros H;Inversion H.
+Lemma Zabs_pos : forall n:Z, 0 <= Zabs n.
+intro x; destruct x; auto with arith; compute in |- *; intros H; inversion H.
Qed.
-V7only [ (* From Zdivides *) ].
-Theorem Zabs_eq_case:
- (z1, z2 : Z) (Zabs z1) = (Zabs z2) -> z1 = z2 \/ z1 = (Zopp z2).
+Theorem Zabs_eq_case : forall n m:Z, Zabs n = Zabs m -> n = m \/ n = - m.
Proof.
-Intros z1 z2; Case z1; Case z2; Simpl; Auto; Try (Intros; Discriminate);
- Intros p1 p2 H1; Injection H1; (Intros H2; Rewrite H2); Auto.
+intros z1 z2; case z1; case z2; simpl in |- *; auto;
+ try (intros; discriminate); intros p1 p2 H1; injection H1;
+ (intros H2; rewrite H2); auto.
Qed.
(** Triangular inequality *)
-Hints Local Resolve Zle_NEG_POS :zarith.
+Hint Local Resolve Zle_neg_pos: zarith.
-V7only [ (* From Zdivides *) ].
-Theorem Zabs_triangle:
- (z1, z2 : Z) (Zle (Zabs (Zplus z1 z2)) (Zplus (Zabs z1) (Zabs z2))).
+Theorem Zabs_triangle : forall n m:Z, Zabs (n + m) <= Zabs n + Zabs m.
Proof.
-Intros z1 z2; Case z1; Case z2; Try (Simpl; Auto with zarith; Fail).
-Intros p1 p2;
- Apply Zabs_intro
- with P := [x : ?] (Zle x (Zplus (Zabs (POS p2)) (Zabs (NEG p1))));
- Try Rewrite Zopp_Zplus; Auto with zarith.
-Apply Zle_plus_plus; Simpl; Auto with zarith.
-Apply Zle_plus_plus; Simpl; Auto with zarith.
-Intros p1 p2;
- Apply Zabs_intro
- with P := [x : ?] (Zle x (Zplus (Zabs (POS p2)) (Zabs (NEG p1))));
- Try Rewrite Zopp_Zplus; Auto with zarith.
-Apply Zle_plus_plus; Simpl; Auto with zarith.
-Apply Zle_plus_plus; Simpl; Auto with zarith.
+intros z1 z2; case z1; case z2; try (simpl in |- *; auto with zarith; fail).
+intros p1 p2;
+ apply Zabs_intro with (P := fun x => x <= Zabs (Zpos p2) + Zabs (Zneg p1));
+ try rewrite Zopp_plus_distr; auto with zarith.
+apply Zplus_le_compat; simpl in |- *; auto with zarith.
+apply Zplus_le_compat; simpl in |- *; auto with zarith.
+intros p1 p2;
+ apply Zabs_intro with (P := fun x => x <= Zabs (Zpos p2) + Zabs (Zneg p1));
+ try rewrite Zopp_plus_distr; auto with zarith.
+apply Zplus_le_compat; simpl in |- *; auto with zarith.
+apply Zplus_le_compat; simpl in |- *; auto with zarith.
Qed.
(** Absolute value and multiplication *)
-Lemma Zsgn_Zabs: (x:Z)(Zmult x (Zsgn x))=(Zabs x).
+Lemma Zsgn_Zabs : forall n:Z, n * Zsgn n = Zabs n.
Proof.
-Intro x; NewDestruct x; Rewrite Zmult_sym; Auto with arith.
+intro x; destruct x; rewrite Zmult_comm; auto with arith.
Qed.
-Lemma Zabs_Zsgn: (x:Z)(Zmult (Zabs x) (Zsgn x))=x.
+Lemma Zabs_Zsgn : forall n:Z, Zabs n * Zsgn n = n.
Proof.
-Intro x; NewDestruct x; Rewrite Zmult_sym; Auto with arith.
+intro x; destruct x; rewrite Zmult_comm; auto with arith.
Qed.
-V7only [ (* From Zdivides *) ].
-Theorem Zabs_Zmult:
- (z1, z2 : Z) (Zabs (Zmult z1 z2)) = (Zmult (Zabs z1) (Zabs z2)).
+Theorem Zabs_Zmult : forall n m:Z, Zabs (n * m) = Zabs n * Zabs m.
Proof.
-Intros z1 z2; Case z1; Case z2; Simpl; Auto.
+intros z1 z2; case z1; case z2; simpl in |- *; auto.
Qed.
(** absolute value in nat is compatible with order *)
-Lemma absolu_lt : (x,y:Z) (Zle ZERO x)/\(Zlt x y) -> (lt (absolu x) (absolu y)).
+Lemma Zabs_nat_lt :
+ forall n m:Z, 0 <= n /\ n < m -> (Zabs_nat n < Zabs_nat m)%nat.
Proof.
-Intros x y. Case x; Simpl. Case y; Simpl.
+intros x y. case x; simpl in |- *. case y; simpl in |- *.
-Intro. Absurd (Zlt ZERO ZERO). Compute. Intro H0. Discriminate H0. Intuition.
-Intros. Elim (ZL4 p). Intros. Rewrite H0. Auto with arith.
-Intros. Elim (ZL4 p). Intros. Rewrite H0. Auto with arith.
+intro. absurd (0 < 0). compute in |- *. intro H0. discriminate H0. intuition.
+intros. elim (ZL4 p). intros. rewrite H0. auto with arith.
+intros. elim (ZL4 p). intros. rewrite H0. auto with arith.
-Case y; Simpl.
-Intros. Absurd (Zlt (POS p) ZERO). Compute. Intro H0. Discriminate H0. Intuition.
-Intros. Change (gt (convert p) (convert p0)).
-Apply compare_convert_SUPERIEUR.
-Elim H; Auto with arith. Intro. Exact (ZC2 p0 p).
+case y; simpl in |- *.
+intros. absurd (Zpos p < 0). compute in |- *. intro H0. discriminate H0. intuition.
+intros. change (nat_of_P p > nat_of_P p0)%nat in |- *.
+apply nat_of_P_gt_Gt_compare_morphism.
+elim H; auto with arith. intro. exact (ZC2 p0 p).
-Intros. Absurd (Zlt (POS p0) (NEG p)).
-Compute. Intro H0. Discriminate H0. Intuition.
+intros. absurd (Zpos p0 < Zneg p).
+compute in |- *. intro H0. discriminate H0. intuition.
-Intros. Absurd (Zle ZERO (NEG p)). Compute. Auto with arith. Intuition.
-Qed.
+intros. absurd (0 <= Zneg p). compute in |- *. auto with arith. intuition.
+Qed. \ No newline at end of file
diff --git a/theories/ZArith/Zbinary.v b/theories/ZArith/Zbinary.v
index 142bfdef6..cd8872dac 100644
--- a/theories/ZArith/Zbinary.v
+++ b/theories/ZArith/Zbinary.v
@@ -11,10 +11,10 @@
(** Bit vectors interpreted as integers.
Contribution by Jean Duprat (ENS Lyon). *)
-Require Bvector.
-Require ZArith.
+Require Import Bvector.
+Require Import ZArith.
Require Export Zpower.
-Require Omega.
+Require Import Omega.
(*
L'évaluation des vecteurs de booléens se font à la fois en binaire et
@@ -41,29 +41,29 @@ Le complément à deux n'a de sens que sur les vecteurs de taille
supérieure ou égale à un, le bit de signe étant évalué négativement.
*)
-Definition bit_value [b:bool] : Z :=
-Cases b of
- | true => `1`
- | false => `0`
-end.
+Definition bit_value (b:bool) : Z :=
+ match b with
+ | true => 1%Z
+ | false => 0%Z
+ end.
-Lemma binary_value : (n:nat) (Bvector n) -> Z.
+Lemma binary_value : forall n:nat, Bvector n -> Z.
Proof.
- Induction n; Intros.
- Exact `0`.
+ simple induction n; intros.
+ exact 0%Z.
- Inversion H0.
- Exact (Zplus (bit_value a) (Zmult `2` (H H2))).
+ inversion H0.
+ exact (bit_value a + 2 * H H2)%Z.
Defined.
-Lemma two_compl_value : (n:nat) (Bvector (S n)) -> Z.
+Lemma two_compl_value : forall n:nat, Bvector (S n) -> Z.
Proof.
- Induction n; Intros.
- Inversion H.
- Exact (Zopp (bit_value a)).
+ simple induction n; intros.
+ inversion H.
+ exact (- bit_value a)%Z.
- Inversion H0.
- Exact (Zplus (bit_value a) (Zmult `2` (H H2))).
+ inversion H0.
+ exact (bit_value a + 2 * H H2)%Z.
Defined.
(*
@@ -91,52 +91,50 @@ La valeur en complément à deux est calculée selon un schema de Horner
avec Zmod2, le paramètre est la taille moins un.
*)
-Definition Zmod2 := [z:Z] Cases z of
- | ZERO => `0`
- | ((POS p)) => Cases p of
- | (xI q) => (POS q)
- | (xO q) => (POS q)
- | xH => `0`
- end
- | ((NEG p)) => Cases p of
- | (xI q) => `(NEG q) - 1`
- | (xO q) => (NEG q)
- | xH => `-1`
- end
- end.
-
-V7only [
-Notation double_moins_un_add_un :=
- [p](sym_eq ? ? ? (double_moins_un_add_un_xI p)).
-].
-
-Lemma Zmod2_twice : (z:Z)
- `z = (2*(Zmod2 z) + (bit_value (Zodd_bool z)))`.
+Definition Zmod2 (z:Z) :=
+ match z with
+ | Z0 => 0%Z
+ | Zpos p => match p with
+ | xI q => Zpos q
+ | xO q => Zpos q
+ | xH => 0%Z
+ end
+ | Zneg p =>
+ match p with
+ | xI q => (Zneg q - 1)%Z
+ | xO q => Zneg q
+ | xH => (-1)%Z
+ end
+ end.
+
+
+Lemma Zmod2_twice :
+ forall z:Z, z = (2 * Zmod2 z + bit_value (Zeven.Zodd_bool z))%Z.
Proof.
- NewDestruct z; Simpl.
- Trivial.
+ destruct z; simpl in |- *.
+ trivial.
- NewDestruct p; Simpl; Trivial.
+ destruct p; simpl in |- *; trivial.
- NewDestruct p; Simpl.
- NewDestruct p as [p|p|]; Simpl.
- Rewrite <- (double_moins_un_add_un_xI p); Trivial.
+ destruct p; simpl in |- *.
+ destruct p as [p| p| ]; simpl in |- *.
+ rewrite <- (Pdouble_minus_one_o_succ_eq_xI p); trivial.
- Trivial.
+ trivial.
- Trivial.
+ trivial.
- Trivial.
+ trivial.
- Trivial.
-Save.
+ trivial.
+Qed.
-Lemma Z_to_binary : (n:nat) Z -> (Bvector n).
+Lemma Z_to_binary : forall n:nat, Z -> Bvector n.
Proof.
- Induction n; Intros.
- Exact Bnil.
+ simple induction n; intros.
+ exact Bnil.
- Exact (Bcons (Zodd_bool H0) n0 (H (Zdiv2 H0))).
+ exact (Bcons (Zeven.Zodd_bool H0) n0 (H (Zeven.Zdiv2 H0))).
Defined.
(*
@@ -148,12 +146,12 @@ Eval Compute in (Z_to_binary (5) `5`).
: (Bvector (5))
*)
-Lemma Z_to_two_compl : (n:nat) Z -> (Bvector (S n)).
+Lemma Z_to_two_compl : forall n:nat, Z -> Bvector (S n).
Proof.
- Induction n; Intros.
- Exact (Bcons (Zodd_bool H) (0) Bnil).
+ simple induction n; intros.
+ exact (Bcons (Zeven.Zodd_bool H) 0 Bnil).
- Exact (Bcons (Zodd_bool H0) (S n0) (H (Zmod2 H0))).
+ exact (Bcons (Zeven.Zodd_bool H0) (S n0) (H (Zmod2 H0))).
Defined.
(*
@@ -186,93 +184,97 @@ Utilise largement ZArith.
Meriterait d'etre reecrite.
*)
-Lemma binary_value_Sn : (n:nat) (b:bool) (bv : (Bvector n))
- (binary_value (S n) (Vcons bool b n bv))=`(bit_value b) + 2*(binary_value n bv)`.
+Lemma binary_value_Sn :
+ forall (n:nat) (b:bool) (bv:Bvector n),
+ binary_value (S n) (Vcons bool b n bv) =
+ (bit_value b + 2 * binary_value n bv)%Z.
Proof.
- Intros; Auto.
-Save.
+ intros; auto.
+Qed.
-Lemma Z_to_binary_Sn : (n:nat) (b:bool) (z:Z)
- `z>=0`->
- (Z_to_binary (S n) `(bit_value b) + 2*z`)=(Bcons b n (Z_to_binary n z)).
+Lemma Z_to_binary_Sn :
+ forall (n:nat) (b:bool) (z:Z),
+ (z >= 0)%Z ->
+ Z_to_binary (S n) (bit_value b + 2 * z) = Bcons b n (Z_to_binary n z).
Proof.
- NewDestruct b; NewDestruct z; Simpl; Auto.
- Intro H; Elim H; Trivial.
-Save.
+ destruct b; destruct z; simpl in |- *; auto.
+ intro H; elim H; trivial.
+Qed.
-Lemma binary_value_pos : (n:nat) (bv:(Bvector n))
- `(binary_value n bv) >= 0`.
+Lemma binary_value_pos :
+ forall (n:nat) (bv:Bvector n), (binary_value n bv >= 0)%Z.
Proof.
- NewInduction bv as [|a n v IHbv]; Simpl.
- Omega.
+ induction bv as [| a n v IHbv]; simpl in |- *.
+ omega.
- NewDestruct a; NewDestruct (binary_value n v); Simpl; Auto.
- Auto with zarith.
-Save.
+ destruct a; destruct (binary_value n v); simpl in |- *; auto.
+ auto with zarith.
+Qed.
-V7only [Notation add_un_double_moins_un_xO := is_double_moins_un.].
-Lemma two_compl_value_Sn : (n:nat) (bv : (Bvector (S n))) (b:bool)
- (two_compl_value (S n) (Bcons b (S n) bv)) =
- `(bit_value b) + 2*(two_compl_value n bv)`.
+Lemma two_compl_value_Sn :
+ forall (n:nat) (bv:Bvector (S n)) (b:bool),
+ two_compl_value (S n) (Bcons b (S n) bv) =
+ (bit_value b + 2 * two_compl_value n bv)%Z.
Proof.
- Intros; Auto.
-Save.
+ intros; auto.
+Qed.
-Lemma Z_to_two_compl_Sn : (n:nat) (b:bool) (z:Z)
- (Z_to_two_compl (S n) `(bit_value b) + 2*z`) =
- (Bcons b (S n) (Z_to_two_compl n z)).
+Lemma Z_to_two_compl_Sn :
+ forall (n:nat) (b:bool) (z:Z),
+ Z_to_two_compl (S n) (bit_value b + 2 * z) =
+ Bcons b (S n) (Z_to_two_compl n z).
Proof.
- NewDestruct b; NewDestruct z as [|p|p]; Auto.
- NewDestruct p as [p|p|]; Auto.
- NewDestruct p as [p|p|]; Simpl; Auto.
- Intros; Rewrite (add_un_double_moins_un_xO p); Trivial.
-Save.
-
-Lemma Z_to_binary_Sn_z : (n:nat) (z:Z)
- (Z_to_binary (S n) z)=(Bcons (Zodd_bool z) n (Z_to_binary n (Zdiv2 z))).
+ destruct b; destruct z as [| p| p]; auto.
+ destruct p as [p| p| ]; auto.
+ destruct p as [p| p| ]; simpl in |- *; auto.
+ intros; rewrite (Psucc_o_double_minus_one_eq_xO p); trivial.
+Qed.
+
+Lemma Z_to_binary_Sn_z :
+ forall (n:nat) (z:Z),
+ Z_to_binary (S n) z =
+ Bcons (Zeven.Zodd_bool z) n (Z_to_binary n (Zeven.Zdiv2 z)).
Proof.
- Intros; Auto.
-Save.
+ intros; auto.
+Qed.
-Lemma Z_div2_value : (z:Z)
- ` z>=0 `->
- `(bit_value (Zodd_bool z))+2*(Zdiv2 z) = z`.
+Lemma Z_div2_value :
+ forall z:Z,
+ (z >= 0)%Z -> (bit_value (Zeven.Zodd_bool z) + 2 * Zeven.Zdiv2 z)%Z = z.
Proof.
- NewDestruct z as [|p|p]; Auto.
- NewDestruct p; Auto.
- Intro H; Elim H; Trivial.
-Save.
+ destruct z as [| p| p]; auto.
+ destruct p; auto.
+ intro H; elim H; trivial.
+Qed.
-Lemma Zdiv2_pos : (z:Z)
- ` z >= 0 ` ->
- `(Zdiv2 z) >= 0 `.
+Lemma Pdiv2 : forall z:Z, (z >= 0)%Z -> (Zeven.Zdiv2 z >= 0)%Z.
Proof.
- NewDestruct z as [|p|p].
- Auto.
+ destruct z as [| p| p].
+ auto.
- NewDestruct p; Auto.
- Simpl; Intros; Omega.
+ destruct p; auto.
+ simpl in |- *; intros; omega.
- Intro H; Elim H; Trivial.
+ intro H; elim H; trivial.
-Save.
+Qed.
-Lemma Zdiv2_two_power_nat : (z:Z) (n:nat)
- ` z >= 0 ` ->
- ` z < (two_power_nat (S n)) ` ->
- `(Zdiv2 z) < (two_power_nat n) `.
+Lemma Zdiv2_two_power_nat :
+ forall (z:Z) (n:nat),
+ (z >= 0)%Z ->
+ (z < two_power_nat (S n))%Z -> (Zeven.Zdiv2 z < two_power_nat n)%Z.
Proof.
- Intros.
- Cut (Zlt (Zmult `2` (Zdiv2 z)) (Zmult `2` (two_power_nat n))); Intros.
- Omega.
+ intros.
+ cut (2 * Zeven.Zdiv2 z < 2 * two_power_nat n)%Z; intros.
+ omega.
- Rewrite <- two_power_nat_S.
- NewDestruct (Zeven_odd_dec z); Intros.
- Rewrite <- Zeven_div2; Auto.
+ rewrite <- two_power_nat_S.
+ destruct (Zeven.Zeven_odd_dec z); intros.
+ rewrite <- Zeven.Zeven_div2; auto.
- Generalize (Zodd_div2 z H z0); Omega.
-Save.
+ generalize (Zeven.Zodd_div2 z H z0); omega.
+Qed.
(*
@@ -299,54 +301,54 @@ Proof.
Save.
*)
-Lemma Z_to_two_compl_Sn_z : (n:nat) (z:Z)
- (Z_to_two_compl (S n) z)=(Bcons (Zodd_bool z) (S n) (Z_to_two_compl n (Zmod2 z))).
+Lemma Z_to_two_compl_Sn_z :
+ forall (n:nat) (z:Z),
+ Z_to_two_compl (S n) z =
+ Bcons (Zeven.Zodd_bool z) (S n) (Z_to_two_compl n (Zmod2 z)).
Proof.
- Intros; Auto.
-Save.
+ intros; auto.
+Qed.
-Lemma Zeven_bit_value : (z:Z)
- (Zeven z) ->
- `(bit_value (Zodd_bool z))=0`.
+Lemma Zeven_bit_value :
+ forall z:Z, Zeven.Zeven z -> bit_value (Zeven.Zodd_bool z) = 0%Z.
Proof.
- NewDestruct z; Unfold bit_value; Auto.
- NewDestruct p; Tauto Orelse (Intro H; Elim H).
- NewDestruct p; Tauto Orelse (Intro H; Elim H).
-Save.
+ destruct z; unfold bit_value in |- *; auto.
+ destruct p; tauto || (intro H; elim H).
+ destruct p; tauto || (intro H; elim H).
+Qed.
-Lemma Zodd_bit_value : (z:Z)
- (Zodd z) ->
- `(bit_value (Zodd_bool z))=1`.
+Lemma Zodd_bit_value :
+ forall z:Z, Zeven.Zodd z -> bit_value (Zeven.Zodd_bool z) = 1%Z.
Proof.
- NewDestruct z; Unfold bit_value; Auto.
- Intros; Elim H.
- NewDestruct p; Tauto Orelse (Intros; Elim H).
- NewDestruct p; Tauto Orelse (Intros; Elim H).
-Save.
-
-Lemma Zge_minus_two_power_nat_S : (n:nat) (z:Z)
- `z >= (-(two_power_nat (S n)))`->
- `(Zmod2 z) >= (-(two_power_nat n))`.
+ destruct z; unfold bit_value in |- *; auto.
+ intros; elim H.
+ destruct p; tauto || (intros; elim H).
+ destruct p; tauto || (intros; elim H).
+Qed.
+
+Lemma Zge_minus_two_power_nat_S :
+ forall (n:nat) (z:Z),
+ (z >= - two_power_nat (S n))%Z -> (Zmod2 z >= - two_power_nat n)%Z.
Proof.
- Intros n z; Rewrite (two_power_nat_S n).
- Generalize (Zmod2_twice z).
- NewDestruct (Zeven_odd_dec z) as [H|H].
- Rewrite (Zeven_bit_value z H); Intros; Omega.
+ intros n z; rewrite (two_power_nat_S n).
+ generalize (Zmod2_twice z).
+ destruct (Zeven.Zeven_odd_dec z) as [H| H].
+ rewrite (Zeven_bit_value z H); intros; omega.
- Rewrite (Zodd_bit_value z H); Intros; Omega.
-Save.
+ rewrite (Zodd_bit_value z H); intros; omega.
+Qed.
-Lemma Zlt_two_power_nat_S : (n:nat) (z:Z)
- `z < (two_power_nat (S n))`->
- `(Zmod2 z) < (two_power_nat n)`.
+Lemma Zlt_two_power_nat_S :
+ forall (n:nat) (z:Z),
+ (z < two_power_nat (S n))%Z -> (Zmod2 z < two_power_nat n)%Z.
Proof.
- Intros n z; Rewrite (two_power_nat_S n).
- Generalize (Zmod2_twice z).
- NewDestruct (Zeven_odd_dec z) as [H|H].
- Rewrite (Zeven_bit_value z H); Intros; Omega.
+ intros n z; rewrite (two_power_nat_S n).
+ generalize (Zmod2_twice z).
+ destruct (Zeven.Zeven_odd_dec z) as [H| H].
+ rewrite (Zeven_bit_value z H); intros; omega.
- Rewrite (Zodd_bit_value z H); Intros; Omega.
-Save.
+ rewrite (Zodd_bit_value z H); intros; omega.
+Qed.
End Z_BRIC_A_BRAC.
@@ -358,68 +360,67 @@ réciproques l'une de l'autre.
Elles utilisent les lemmes du bric-a-brac.
*)
-Lemma binary_to_Z_to_binary : (n:nat) (bv : (Bvector n))
- (Z_to_binary n (binary_value n bv))=bv.
+Lemma binary_to_Z_to_binary :
+ forall (n:nat) (bv:Bvector n), Z_to_binary n (binary_value n bv) = bv.
Proof.
- NewInduction bv as [|a n bv IHbv].
- Auto.
+ induction bv as [| a n bv IHbv].
+ auto.
- Rewrite binary_value_Sn.
- Rewrite Z_to_binary_Sn.
- Rewrite IHbv; Trivial.
+ rewrite binary_value_Sn.
+ rewrite Z_to_binary_Sn.
+ rewrite IHbv; trivial.
- Apply binary_value_pos.
-Save.
+ apply binary_value_pos.
+Qed.
-Lemma two_compl_to_Z_to_two_compl : (n:nat) (bv : (Bvector n)) (b:bool)
- (Z_to_two_compl n (two_compl_value n (Bcons b n bv)))=
- (Bcons b n bv).
+Lemma two_compl_to_Z_to_two_compl :
+ forall (n:nat) (bv:Bvector n) (b:bool),
+ Z_to_two_compl n (two_compl_value n (Bcons b n bv)) = Bcons b n bv.
Proof.
- NewInduction bv as [|a n bv IHbv]; Intro b.
- NewDestruct b; Auto.
-
- Rewrite two_compl_value_Sn.
- Rewrite Z_to_two_compl_Sn.
- Rewrite IHbv; Trivial.
-Save.
-
-Lemma Z_to_binary_to_Z : (n:nat) (z : Z)
- `z >= 0 `->
- `z < (two_power_nat n) `->
- (binary_value n (Z_to_binary n z))=z.
+ induction bv as [| a n bv IHbv]; intro b.
+ destruct b; auto.
+
+ rewrite two_compl_value_Sn.
+ rewrite Z_to_two_compl_Sn.
+ rewrite IHbv; trivial.
+Qed.
+
+Lemma Z_to_binary_to_Z :
+ forall (n:nat) (z:Z),
+ (z >= 0)%Z ->
+ (z < two_power_nat n)%Z -> binary_value n (Z_to_binary n z) = z.
Proof.
- NewInduction n as [|n IHn].
- Unfold two_power_nat shift_nat; Simpl; Intros; Omega.
+ induction n as [| n IHn].
+ unfold two_power_nat, shift_nat in |- *; simpl in |- *; intros; omega.
- Intros; Rewrite Z_to_binary_Sn_z.
- Rewrite binary_value_Sn.
- Rewrite IHn.
- Apply Z_div2_value; Auto.
+ intros; rewrite Z_to_binary_Sn_z.
+ rewrite binary_value_Sn.
+ rewrite IHn.
+ apply Z_div2_value; auto.
- Apply Zdiv2_pos; Trivial.
+ apply Pdiv2; trivial.
- Apply Zdiv2_two_power_nat; Trivial.
-Save.
+ apply Zdiv2_two_power_nat; trivial.
+Qed.
-Lemma Z_to_two_compl_to_Z : (n:nat) (z : Z)
- `z >= -(two_power_nat n) `->
- `z < (two_power_nat n) `->
- (two_compl_value n (Z_to_two_compl n z))=z.
+Lemma Z_to_two_compl_to_Z :
+ forall (n:nat) (z:Z),
+ (z >= - two_power_nat n)%Z ->
+ (z < two_power_nat n)%Z -> two_compl_value n (Z_to_two_compl n z) = z.
Proof.
- NewInduction n as [|n IHn].
- Unfold two_power_nat shift_nat; Simpl; Intros.
- Assert `z=-1`\/`z=0`. Omega.
-Intuition; Subst z; Trivial.
+ induction n as [| n IHn].
+ unfold two_power_nat, shift_nat in |- *; simpl in |- *; intros.
+ assert (z = (-1)%Z \/ z = 0%Z). omega.
+intuition; subst z; trivial.
- Intros; Rewrite Z_to_two_compl_Sn_z.
- Rewrite two_compl_value_Sn.
- Rewrite IHn.
- Generalize (Zmod2_twice z); Omega.
+ intros; rewrite Z_to_two_compl_Sn_z.
+ rewrite two_compl_value_Sn.
+ rewrite IHn.
+ generalize (Zmod2_twice z); omega.
- Apply Zge_minus_two_power_nat_S; Auto.
+ apply Zge_minus_two_power_nat_S; auto.
- Apply Zlt_two_power_nat_S; Auto.
-Save.
+ apply Zlt_two_power_nat_S; auto.
+Qed.
End COHERENT_VALUE.
-
diff --git a/theories/ZArith/Zbool.v b/theories/ZArith/Zbool.v
index fcbdd1141..a95218b63 100644
--- a/theories/ZArith/Zbool.v
+++ b/theories/ZArith/Zbool.v
@@ -8,151 +8,179 @@
(* $Id$ *)
-Require BinInt.
-Require Zeven.
-Require Zorder.
-Require Zcompare.
-Require ZArith_dec.
-Require Zsyntax.
-Require Sumbool.
+Require Import BinInt.
+Require Import Zeven.
+Require Import Zorder.
+Require Import Zcompare.
+Require Import ZArith_dec.
+Require Import Sumbool.
(** The decidability of equality and order relations over
type [Z] give some boolean functions with the adequate specification. *)
-Definition Z_lt_ge_bool := [x,y:Z](bool_of_sumbool (Z_lt_ge_dec x y)).
-Definition Z_ge_lt_bool := [x,y:Z](bool_of_sumbool (Z_ge_lt_dec x y)).
+Definition Z_lt_ge_bool (x y:Z) := bool_of_sumbool (Z_lt_ge_dec x y).
+Definition Z_ge_lt_bool (x y:Z) := bool_of_sumbool (Z_ge_lt_dec x y).
-Definition Z_le_gt_bool := [x,y:Z](bool_of_sumbool (Z_le_gt_dec x y)).
-Definition Z_gt_le_bool := [x,y:Z](bool_of_sumbool (Z_gt_le_dec x y)).
+Definition Z_le_gt_bool (x y:Z) := bool_of_sumbool (Z_le_gt_dec x y).
+Definition Z_gt_le_bool (x y:Z) := bool_of_sumbool (Z_gt_le_dec x y).
-Definition Z_eq_bool := [x,y:Z](bool_of_sumbool (Z_eq_dec x y)).
-Definition Z_noteq_bool := [x,y:Z](bool_of_sumbool (Z_noteq_dec x y)).
+Definition Z_eq_bool (x y:Z) := bool_of_sumbool (Z_eq_dec x y).
+Definition Z_noteq_bool (x y:Z) := bool_of_sumbool (Z_noteq_dec x y).
-Definition Zeven_odd_bool := [x:Z](bool_of_sumbool (Zeven_odd_dec x)).
+Definition Zeven_odd_bool (x:Z) := bool_of_sumbool (Zeven_odd_dec x).
(**********************************************************************)
(** Boolean comparisons of binary integers *)
-Definition Zle_bool :=
- [x,y:Z]Cases `x ?= y` of SUPERIEUR => false | _ => true end.
-Definition Zge_bool :=
- [x,y:Z]Cases `x ?= y` of INFERIEUR => false | _ => true end.
-Definition Zlt_bool :=
- [x,y:Z]Cases `x ?= y` of INFERIEUR => true | _ => false end.
-Definition Zgt_bool :=
- [x,y:Z]Cases ` x ?= y` of SUPERIEUR => true | _ => false end.
-Definition Zeq_bool :=
- [x,y:Z]Cases `x ?= y` of EGAL => true | _ => false end.
-Definition Zneq_bool :=
- [x,y:Z]Cases `x ?= y` of EGAL => false | _ => true end.
-
-Lemma Zle_cases : (x,y:Z)if (Zle_bool x y) then `x<=y` else `x>y`.
+Definition Zle_bool (x y:Z) :=
+ match (x ?= y)%Z with
+ | Gt => false
+ | _ => true
+ end.
+Definition Zge_bool (x y:Z) :=
+ match (x ?= y)%Z with
+ | Lt => false
+ | _ => true
+ end.
+Definition Zlt_bool (x y:Z) :=
+ match (x ?= y)%Z with
+ | Lt => true
+ | _ => false
+ end.
+Definition Zgt_bool (x y:Z) :=
+ match (x ?= y)%Z with
+ | Gt => true
+ | _ => false
+ end.
+Definition Zeq_bool (x y:Z) :=
+ match (x ?= y)%Z with
+ | Eq => true
+ | _ => false
+ end.
+Definition Zneq_bool (x y:Z) :=
+ match (x ?= y)%Z with
+ | Eq => false
+ | _ => true
+ end.
+
+Lemma Zle_cases :
+ forall n m:Z, if Zle_bool n m then (n <= m)%Z else (n > m)%Z.
Proof.
-Intros x y; Unfold Zle_bool Zle Zgt.
-Case (Zcompare x y); Auto; Discriminate.
+intros x y; unfold Zle_bool, Zle, Zgt in |- *.
+case (x ?= y)%Z; auto; discriminate.
Qed.
-Lemma Zlt_cases : (x,y:Z)if (Zlt_bool x y) then `x<y` else `x>=y`.
+Lemma Zlt_cases :
+ forall n m:Z, if Zlt_bool n m then (n < m)%Z else (n >= m)%Z.
Proof.
-Intros x y; Unfold Zlt_bool Zlt Zge.
-Case (Zcompare x y); Auto; Discriminate.
+intros x y; unfold Zlt_bool, Zlt, Zge in |- *.
+case (x ?= y)%Z; auto; discriminate.
Qed.
-Lemma Zge_cases : (x,y:Z)if (Zge_bool x y) then `x>=y` else `x<y`.
+Lemma Zge_cases :
+ forall n m:Z, if Zge_bool n m then (n >= m)%Z else (n < m)%Z.
Proof.
-Intros x y; Unfold Zge_bool Zge Zlt.
-Case (Zcompare x y); Auto; Discriminate.
+intros x y; unfold Zge_bool, Zge, Zlt in |- *.
+case (x ?= y)%Z; auto; discriminate.
Qed.
-Lemma Zgt_cases : (x,y:Z)if (Zgt_bool x y) then `x>y` else `x<=y`.
+Lemma Zgt_cases :
+ forall n m:Z, if Zgt_bool n m then (n > m)%Z else (n <= m)%Z.
Proof.
-Intros x y; Unfold Zgt_bool Zgt Zle.
-Case (Zcompare x y); Auto; Discriminate.
+intros x y; unfold Zgt_bool, Zgt, Zle in |- *.
+case (x ?= y)%Z; auto; discriminate.
Qed.
(** Lemmas on [Zle_bool] used in contrib/graphs *)
-Lemma Zle_bool_imp_le : (x,y:Z) (Zle_bool x y)=true -> (Zle x y).
+Lemma Zle_bool_imp_le : forall n m:Z, Zle_bool n m = true -> (n <= m)%Z.
Proof.
- Unfold Zle_bool Zle. Intros x y. Unfold not.
- Case (Zcompare x y); Intros; Discriminate.
+ unfold Zle_bool, Zle in |- *. intros x y. unfold not in |- *.
+ case (x ?= y)%Z; intros; discriminate.
Qed.
-Lemma Zle_imp_le_bool : (x,y:Z) (Zle x y) -> (Zle_bool x y)=true.
+Lemma Zle_imp_le_bool : forall n m:Z, (n <= m)%Z -> Zle_bool n m = true.
Proof.
- Unfold Zle Zle_bool. Intros x y. Case (Zcompare x y); Trivial. Intro. Elim (H (refl_equal ? ?)).
+ unfold Zle, Zle_bool in |- *. intros x y. case (x ?= y)%Z; trivial. intro. elim (H (refl_equal _)).
Qed.
-Lemma Zle_bool_refl : (x:Z) (Zle_bool x x)=true.
+Lemma Zle_bool_refl : forall n:Z, Zle_bool n n = true.
Proof.
- Intro. Apply Zle_imp_le_bool. Apply Zle_refl. Reflexivity.
+ intro. apply Zle_imp_le_bool. apply Zeq_le. reflexivity.
Qed.
-Lemma Zle_bool_antisym : (x,y:Z) (Zle_bool x y)=true -> (Zle_bool y x)=true -> x=y.
+Lemma Zle_bool_antisym :
+ forall n m:Z, Zle_bool n m = true -> Zle_bool m n = true -> n = m.
Proof.
- Intros. Apply Zle_antisym. Apply Zle_bool_imp_le. Assumption.
- Apply Zle_bool_imp_le. Assumption.
+ intros. apply Zle_antisym. apply Zle_bool_imp_le. assumption.
+ apply Zle_bool_imp_le. assumption.
Qed.
-Lemma Zle_bool_trans : (x,y,z:Z) (Zle_bool x y)=true -> (Zle_bool y z)=true -> (Zle_bool x z)=true.
+Lemma Zle_bool_trans :
+ forall n m p:Z,
+ Zle_bool n m = true -> Zle_bool m p = true -> Zle_bool n p = true.
Proof.
- Intros x y z; Intros. Apply Zle_imp_le_bool. Apply Zle_trans with m:=y. Apply Zle_bool_imp_le. Assumption.
- Apply Zle_bool_imp_le. Assumption.
+ intros x y z; intros. apply Zle_imp_le_bool. apply Zle_trans with (m := y). apply Zle_bool_imp_le. assumption.
+ apply Zle_bool_imp_le. assumption.
Qed.
-Definition Zle_bool_total : (x,y:Z) {(Zle_bool x y)=true}+{(Zle_bool y x)=true}.
+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. Cut (Zcompare x y)=SUPERIEUR<->(Zcompare y x)=INFERIEUR.
- Case (Zcompare x y). Left . Reflexivity.
- Left . Reflexivity.
- Right . Rewrite (proj1 ? ? H (refl_equal ? ?)). Reflexivity.
- Apply Zcompare_ANTISYM.
+ intros x y; intros. unfold Zle_bool in |- *. cut ((x ?= y)%Z = Gt <-> (y ?= x)%Z = Lt).
+ case (x ?= y)%Z. left. reflexivity.
+ left. reflexivity.
+ right. rewrite (proj1 H (refl_equal _)). reflexivity.
+ apply Zcompare_Gt_Lt_antisym.
Defined.
-Lemma Zle_bool_plus_mono : (x,y,z,t:Z) (Zle_bool x y)=true -> (Zle_bool z t)=true ->
- (Zle_bool (Zplus x z) (Zplus y t))=true.
+Lemma Zle_bool_plus_mono :
+ forall n m p q:Z,
+ Zle_bool n m = true ->
+ Zle_bool p q = true -> Zle_bool (n + p) (m + q) = true.
Proof.
- Intros. Apply Zle_imp_le_bool. Apply Zle_plus_plus. Apply Zle_bool_imp_le. Assumption.
- Apply Zle_bool_imp_le. Assumption.
+ intros. apply Zle_imp_le_bool. apply Zplus_le_compat. apply Zle_bool_imp_le. assumption.
+ apply Zle_bool_imp_le. assumption.
Qed.
-Lemma Zone_pos : (Zle_bool `1` `0`)=false.
+Lemma Zone_pos : Zle_bool 1 0 = false.
Proof.
- Reflexivity.
+ reflexivity.
Qed.
-Lemma Zone_min_pos : (x:Z) (Zle_bool x `0`)=false -> (Zle_bool `1` x)=true.
+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 (Zle (Zs ZERO) x). Apply Zgt_le_S. Generalize H.
- Unfold Zle_bool Zgt. Case (Zcompare x ZERO). Intro H0. Discriminate H0.
- Intro H0. Discriminate H0.
- Reflexivity.
+ 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.
+ intro H0. discriminate H0.
+ reflexivity.
Qed.
- Lemma Zle_is_le_bool : (x,y:Z) (Zle x y) <-> (Zle_bool x y)=true.
+ Lemma Zle_is_le_bool : forall n m:Z, (n <= m)%Z <-> Zle_bool n m = true.
Proof.
- Intros. Split. Intro. Apply Zle_imp_le_bool. Assumption.
- Intro. Apply Zle_bool_imp_le. Assumption.
+ intros. split. intro. apply Zle_imp_le_bool. assumption.
+ intro. apply Zle_bool_imp_le. assumption.
Qed.
- Lemma Zge_is_le_bool : (x,y:Z) (Zge x y) <-> (Zle_bool y x)=true.
+ Lemma Zge_is_le_bool : forall n m:Z, (n >= m)%Z <-> 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.
+ 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_le_bool : (x,y:Z) (Zlt x y) <-> (Zle_bool x `y-1`)=true.
+ Lemma Zlt_is_le_bool :
+ forall n m:Z, (n < m)%Z <-> Zle_bool n (m - 1) = true.
Proof.
- Intros x y. Split. Intro. Apply Zle_imp_le_bool. Apply Zlt_n_Sm_le. Rewrite (Zs_pred y) in H.
- Assumption.
- Intro. Rewrite (Zs_pred y). Apply Zle_lt_n_Sm. Apply Zle_bool_imp_le. Assumption.
+ intros x y. split. intro. apply Zle_imp_le_bool. apply Zlt_succ_le. rewrite (Zsucc_pred y) in H.
+ assumption.
+ intro. rewrite (Zsucc_pred y). apply Zle_lt_succ. apply Zle_bool_imp_le. assumption.
Qed.
- Lemma Zgt_is_le_bool : (x,y:Z) (Zgt x y) <-> (Zle_bool y `x-1`)=true.
+ Lemma Zgt_is_le_bool :
+ forall n m:Z, (n > m)%Z <-> Zle_bool m (n - 1) = true.
Proof.
- 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).
+ intros x y. apply iff_trans with (y < x)%Z. split. exact (Zgt_lt x y).
+ exact (Zlt_gt y x).
+ exact (Zlt_is_le_bool y x).
Qed.
-
diff --git a/theories/ZArith/Zcompare.v b/theories/ZArith/Zcompare.v
index 2383e90cb..f7015089c 100644
--- a/theories/ZArith/Zcompare.v
+++ b/theories/ZArith/Zcompare.v
@@ -10,11 +10,10 @@
Require Export BinPos.
Require Export BinInt.
-Require Zsyntax.
-Require Lt.
-Require Gt.
-Require Plus.
-Require Mult.
+Require Import Lt.
+Require Import Gt.
+Require Import Plus.
+Require Import Mult.
Open Local Scope Z_scope.
@@ -25,456 +24,478 @@ Open Local Scope Z_scope.
(**********************************************************************)
(** Comparison on integers *)
-Lemma Zcompare_x_x : (x:Z) (Zcompare x x) = EGAL.
+Lemma Zcompare_refl : forall n:Z, (n ?= n) = Eq.
Proof.
-Intro x; NewDestruct x as [|p|p]; Simpl; [ Reflexivity | Apply convert_compare_EGAL
- | Rewrite convert_compare_EGAL; Reflexivity ].
+intro x; destruct x as [| p| p]; simpl in |- *;
+ [ reflexivity | apply Pcompare_refl | rewrite Pcompare_refl; reflexivity ].
Qed.
-Lemma Zcompare_EGAL_eq : (x,y:Z) (Zcompare x y) = EGAL -> x = y.
+Lemma Zcompare_Eq_eq : forall n m:Z, (n ?= m) = Eq -> n = m.
Proof.
-Intros x y; NewDestruct x as [|x'|x'];NewDestruct y as [|y'|y'];Simpl;Intro H; Reflexivity Orelse Try Discriminate H; [
- Rewrite (compare_convert_EGAL x' y' H); Reflexivity
- | Rewrite (compare_convert_EGAL x' y'); [
- Reflexivity
- | NewDestruct (compare x' y' EGAL);
- Reflexivity Orelse Discriminate]].
+intros x y; destruct x as [| x'| x']; destruct y as [| y'| y']; simpl in |- *;
+ intro H; reflexivity || (try discriminate H);
+ [ rewrite (Pcompare_Eq_eq x' y' H); reflexivity
+ | rewrite (Pcompare_Eq_eq x' y');
+ [ reflexivity
+ | destruct ((x' ?= y')%positive Eq); reflexivity || discriminate ] ].
Qed.
-Lemma Zcompare_EGAL : (x,y:Z) (Zcompare x y) = EGAL <-> x = y.
+Lemma Zcompare_Eq_iff_eq : forall n m:Z, (n ?= m) = Eq <-> n = m.
Proof.
-Intros x y;Split; Intro E; [ Apply Zcompare_EGAL_eq; Assumption
- | Rewrite E; Apply Zcompare_x_x ].
+intros x y; split; intro E;
+ [ apply Zcompare_Eq_eq; assumption | rewrite E; apply Zcompare_refl ].
Qed.
-Lemma Zcompare_antisym :
- (x,y:Z)(Op (Zcompare x y)) = (Zcompare y x).
+Lemma Zcompare_antisym : forall n m:Z, CompOpp (n ?= m) = (m ?= n).
Proof.
-Intros x y; NewDestruct x; NewDestruct y; Simpl;
- Reflexivity Orelse Discriminate H Orelse
- Rewrite Pcompare_antisym; Reflexivity.
+intros x y; destruct x; destruct y; simpl in |- *;
+ reflexivity || discriminate H || rewrite Pcompare_antisym;
+ reflexivity.
Qed.
-Lemma Zcompare_ANTISYM :
- (x,y:Z) (Zcompare x y) = SUPERIEUR <-> (Zcompare y x) = INFERIEUR.
+Lemma Zcompare_Gt_Lt_antisym : forall n m:Z, (n ?= m) = Gt <-> (m ?= n) = Lt.
Proof.
-Intros x y; Split; Intro H; [
- Change INFERIEUR with (Op SUPERIEUR);
- Rewrite <- Zcompare_antisym; Rewrite H; Reflexivity
-| Change SUPERIEUR with (Op INFERIEUR);
- Rewrite <- Zcompare_antisym; Rewrite H; Reflexivity ].
+intros x y; split; intro H;
+ [ change Lt with (CompOpp Gt) in |- *; rewrite <- Zcompare_antisym;
+ rewrite H; reflexivity
+ | change Gt with (CompOpp Lt) in |- *; rewrite <- Zcompare_antisym;
+ rewrite H; reflexivity ].
Qed.
(** Transitivity of comparison *)
-Lemma Zcompare_trans_SUPERIEUR :
- (x,y,z:Z) (Zcompare x y) = SUPERIEUR ->
- (Zcompare y z) = SUPERIEUR ->
- (Zcompare x z) = SUPERIEUR.
+Lemma Zcompare_Gt_trans :
+ forall n m p:Z, (n ?= m) = Gt -> (m ?= p) = Gt -> (n ?= p) = Gt.
Proof.
-Intros x y z;Case x;Case y;Case z; Simpl;
-Try (Intros; Discriminate H Orelse Discriminate H0);
-Auto with arith; [
- Intros p q r H H0;Apply convert_compare_SUPERIEUR; Unfold gt;
- Apply lt_trans with m:=(convert q);
- Apply compare_convert_INFERIEUR;Apply ZC1;Assumption
-| Intros p q r; Do 3 Rewrite <- ZC4; Intros H H0;
- Apply convert_compare_SUPERIEUR;Unfold gt;Apply lt_trans with m:=(convert q);
- Apply compare_convert_INFERIEUR;Apply ZC1;Assumption ].
+intros x y z; case x; case y; case z; simpl in |- *;
+ try (intros; discriminate H || discriminate H0); auto with arith;
+ [ intros p q r H H0; apply nat_of_P_gt_Gt_compare_complement_morphism;
+ unfold gt in |- *; apply lt_trans with (m := nat_of_P q);
+ apply nat_of_P_lt_Lt_compare_morphism; apply ZC1;
+ assumption
+ | intros p q r; do 3 rewrite <- ZC4; intros H H0;
+ apply nat_of_P_gt_Gt_compare_complement_morphism;
+ unfold gt in |- *; apply lt_trans with (m := nat_of_P q);
+ apply nat_of_P_lt_Lt_compare_morphism; apply ZC1;
+ assumption ].
Qed.
(** Comparison and opposite *)
-Lemma Zcompare_Zopp :
- (x,y:Z) (Zcompare x y) = (Zcompare (Zopp y) (Zopp x)).
+Lemma Zcompare_opp : forall n m:Z, (n ?= m) = (- m ?= - n).
Proof.
-(Intros x y;Case x;Case y;Simpl;Auto with arith);
-Intros;Rewrite <- ZC4;Trivial with arith.
+intros x y; case x; case y; simpl in |- *; auto with arith; intros;
+ rewrite <- ZC4; trivial with arith.
Qed.
-Hints Local Resolve convert_compare_EGAL.
+Hint Local Resolve Pcompare_refl.
(** Comparison first-order specification *)
-Lemma SUPERIEUR_POS :
- (x,y:Z) (Zcompare x y) = SUPERIEUR ->
- (EX h:positive |(Zplus x (Zopp y)) = (POS h)).
+Lemma Zcompare_Gt_spec :
+ forall n m:Z, (n ?= m) = Gt -> exists h : positive | n + - m = Zpos h.
Proof.
-Intros x y;Case x;Case y; [
- Simpl; Intros H; Discriminate H
-| Simpl; Intros p H; Discriminate H
-| Intros p H; Exists p; Simpl; Auto with arith
-| Intros p H; Exists p; Simpl; Auto with arith
-| Intros q p H; Exists (true_sub p q); Unfold Zplus Zopp;
- Unfold Zcompare in H; Rewrite H; Trivial with arith
-| Intros q p H; Exists (add p q); Simpl; Trivial with arith
-| Simpl; Intros p H; Discriminate H
-| Simpl; Intros q p H; Discriminate H
-| Unfold Zcompare; Intros q p; Rewrite <- ZC4; Intros H; Exists (true_sub q p);
- Simpl; Rewrite (ZC1 q p H); Trivial with arith].
+intros x y; case x; case y;
+ [ simpl in |- *; intros H; discriminate H
+ | simpl in |- *; intros p H; discriminate H
+ | intros p H; exists p; simpl in |- *; auto with arith
+ | intros p H; exists p; simpl in |- *; auto with arith
+ | intros q p H; exists (p - q)%positive; unfold Zplus, Zopp in |- *;
+ unfold Zcompare in H; rewrite H; trivial with arith
+ | intros q p H; exists (p + q)%positive; simpl in |- *; trivial with arith
+ | simpl in |- *; intros p H; discriminate H
+ | simpl in |- *; intros q p H; discriminate H
+ | unfold Zcompare in |- *; intros q p; rewrite <- ZC4; intros H;
+ exists (q - p)%positive; simpl in |- *; rewrite (ZC1 q p H);
+ trivial with arith ].
Qed.
(** Comparison and addition *)
-Lemma weaken_Zcompare_Zplus_compatible :
- ((n,m:Z) (p:positive)
- (Zcompare (Zplus (POS p) n) (Zplus (POS p) m)) = (Zcompare n m)) ->
- (x,y,z:Z) (Zcompare (Zplus z x) (Zplus z y)) = (Zcompare x y).
+Lemma weaken_Zcompare_Zplus_compatible :
+ (forall (n m:Z) (p:positive), (Zpos p + n ?= Zpos p + m) = (n ?= m)) ->
+ forall n m p:Z, (p + n ?= p + m) = (n ?= m).
Proof.
-Intros H x y z; NewDestruct z; [
- Reflexivity
-| Apply H
-| Rewrite (Zcompare_Zopp x y); Rewrite Zcompare_Zopp;
- Do 2 Rewrite Zopp_Zplus; Rewrite Zopp_NEG; Apply H ].
+intros H x y z; destruct z;
+ [ reflexivity
+ | apply H
+ | rewrite (Zcompare_opp x y); rewrite Zcompare_opp;
+ do 2 rewrite Zopp_plus_distr; rewrite Zopp_neg;
+ apply H ].
Qed.
-Hints Local Resolve ZC4.
+Hint Local Resolve ZC4.
-Lemma weak_Zcompare_Zplus_compatible :
- (x,y:Z) (z:positive)
- (Zcompare (Zplus (POS z) x) (Zplus (POS z) y)) = (Zcompare x y).
+Lemma weak_Zcompare_Zplus_compatible :
+ forall (n m:Z) (p:positive), (Zpos p + n ?= Zpos p + m) = (n ?= m).
Proof.
-Intros x y z;Case x;Case y;Simpl;Auto with arith; [
- Intros p;Apply convert_compare_INFERIEUR; Apply ZL17
-| Intros p;ElimPcompare z p;Intros E;Rewrite E;Auto with arith;
- Apply convert_compare_SUPERIEUR; Rewrite true_sub_convert; [ Unfold gt ;
- Apply ZL16 | Assumption ]
-| Intros p;ElimPcompare z p;
- Intros E;Auto with arith; Apply convert_compare_SUPERIEUR;
- Unfold gt;Apply ZL17
-| Intros p q;
- ElimPcompare q p;
- Intros E;Rewrite E;[
- Rewrite (compare_convert_EGAL q p E); Apply convert_compare_EGAL
- | Apply convert_compare_INFERIEUR;Do 2 Rewrite convert_add;Apply lt_reg_l;
- Apply compare_convert_INFERIEUR with 1:=E
- | Apply convert_compare_SUPERIEUR;Unfold gt ;Do 2 Rewrite convert_add;
- Apply lt_reg_l;Exact (compare_convert_SUPERIEUR q p E) ]
-| Intros p q;
- ElimPcompare z p;
- Intros E;Rewrite E;Auto with arith;
- Apply convert_compare_SUPERIEUR; Rewrite true_sub_convert; [
- Unfold gt; Apply lt_trans with m:=(convert z); [Apply ZL16 | Apply ZL17]
- | Assumption ]
-| Intros p;ElimPcompare z p;Intros E;Rewrite E;Auto with arith; Simpl;
- Apply convert_compare_INFERIEUR;Rewrite true_sub_convert;[Apply ZL16|
- Assumption]
-| Intros p q;
- ElimPcompare z q;
- Intros E;Rewrite E;Auto with arith; Simpl;Apply convert_compare_INFERIEUR;
- Rewrite true_sub_convert;[
- Apply lt_trans with m:=(convert z) ;[Apply ZL16|Apply ZL17]
- | Assumption]
-| Intros p q; ElimPcompare z q; Intros E0;Rewrite E0;
- ElimPcompare z p; Intros E1;Rewrite E1; ElimPcompare q p;
- Intros E2;Rewrite E2;Auto with arith; [
- Absurd (compare q p EGAL)=INFERIEUR; [
- Rewrite <- (compare_convert_EGAL z q E0);
- Rewrite <- (compare_convert_EGAL z p E1);
- Rewrite (convert_compare_EGAL z); Discriminate
- | Assumption ]
- | Absurd (compare q p EGAL)=SUPERIEUR; [
- Rewrite <- (compare_convert_EGAL z q E0);
- Rewrite <- (compare_convert_EGAL z p E1);
- Rewrite (convert_compare_EGAL z);Discriminate
- | Assumption]
- | Absurd (compare z p EGAL)=INFERIEUR; [
- Rewrite (compare_convert_EGAL z q E0);
- Rewrite <- (compare_convert_EGAL q p E2);
- Rewrite (convert_compare_EGAL q);Discriminate
- | Assumption ]
- | Absurd (compare z p EGAL)=INFERIEUR; [
- Rewrite (compare_convert_EGAL z q E0); Rewrite E2;Discriminate
- | Assumption]
- | Absurd (compare z p EGAL)=SUPERIEUR;[
- Rewrite (compare_convert_EGAL z q E0);
- Rewrite <- (compare_convert_EGAL q p E2);
- Rewrite (convert_compare_EGAL q);Discriminate
- | Assumption]
- | Absurd (compare z p EGAL)=SUPERIEUR;[
- Rewrite (compare_convert_EGAL z q E0);Rewrite E2;Discriminate
- | Assumption]
- | Absurd (compare z q EGAL)=INFERIEUR;[
- Rewrite (compare_convert_EGAL z p E1);
- Rewrite (compare_convert_EGAL q p E2);
- Rewrite (convert_compare_EGAL p); Discriminate
- | Assumption]
- | Absurd (compare p q EGAL)=SUPERIEUR; [
- Rewrite <- (compare_convert_EGAL z p E1);
- Rewrite E0; Discriminate
- | Apply ZC2;Assumption ]
- | Simpl; Rewrite (compare_convert_EGAL q p E2);
- Rewrite (convert_compare_EGAL (true_sub p z)); Auto with arith
- | Simpl; Rewrite <- ZC4; Apply convert_compare_SUPERIEUR;
- Rewrite true_sub_convert; [
- Rewrite true_sub_convert; [
- Unfold gt; Apply simpl_lt_plus_l with p:=(convert z);
- Rewrite le_plus_minus_r; [
- Rewrite le_plus_minus_r; [
- Apply compare_convert_INFERIEUR;Assumption
- | Apply lt_le_weak; Apply compare_convert_INFERIEUR;Assumption ]
- | Apply lt_le_weak; Apply compare_convert_INFERIEUR;Assumption ]
- | Apply ZC2;Assumption ]
- | Apply ZC2;Assumption ]
- | Simpl; Rewrite <- ZC4; Apply convert_compare_INFERIEUR;
- Rewrite true_sub_convert; [
- Rewrite true_sub_convert; [
- Apply simpl_lt_plus_l with p:=(convert z);
- Rewrite le_plus_minus_r; [
- Rewrite le_plus_minus_r; [
- Apply compare_convert_INFERIEUR;Apply ZC1;Assumption
- | Apply lt_le_weak; Apply compare_convert_INFERIEUR;Assumption ]
- | Apply lt_le_weak; Apply compare_convert_INFERIEUR;Assumption ]
- | Apply ZC2;Assumption]
- | Apply ZC2;Assumption ]
- | Absurd (compare z q EGAL)=INFERIEUR; [
- Rewrite (compare_convert_EGAL q p E2);Rewrite E1;Discriminate
- | Assumption ]
- | Absurd (compare q p EGAL)=INFERIEUR; [
- Cut (compare q p EGAL)=SUPERIEUR; [
- Intros E;Rewrite E;Discriminate
- | Apply convert_compare_SUPERIEUR; Unfold gt;
- Apply lt_trans with m:=(convert z); [
- Apply compare_convert_INFERIEUR;Apply ZC1;Assumption
- | Apply compare_convert_INFERIEUR;Assumption ]]
- | Assumption ]
- | Absurd (compare z q EGAL)=SUPERIEUR; [
- Rewrite (compare_convert_EGAL z p E1);
- Rewrite (compare_convert_EGAL q p E2);
- Rewrite (convert_compare_EGAL p); Discriminate
- | Assumption ]
- | Absurd (compare z q EGAL)=SUPERIEUR; [
- Rewrite (compare_convert_EGAL z p E1);
- Rewrite ZC1; [Discriminate | Assumption ]
- | Assumption ]
- | Absurd (compare z q EGAL)=SUPERIEUR; [
- Rewrite (compare_convert_EGAL q p E2); Rewrite E1; Discriminate
- | Assumption ]
- | Absurd (compare q p EGAL)=SUPERIEUR; [
- Rewrite ZC1; [
- Discriminate
- | Apply convert_compare_SUPERIEUR; Unfold gt;
- Apply lt_trans with m:=(convert z); [
- Apply compare_convert_INFERIEUR;Apply ZC1;Assumption
- | Apply compare_convert_INFERIEUR;Assumption ]]
- | Assumption ]
- | Simpl; Rewrite (compare_convert_EGAL q p E2); Apply convert_compare_EGAL
- | Simpl; Apply convert_compare_SUPERIEUR; Unfold gt;
- Rewrite true_sub_convert; [
- Rewrite true_sub_convert; [
- Apply simpl_lt_plus_l with p:=(convert p); Rewrite le_plus_minus_r; [
- Rewrite plus_sym; Apply simpl_lt_plus_l with p:=(convert q);
- Rewrite plus_assoc_l; Rewrite le_plus_minus_r; [
- Rewrite (plus_sym (convert q)); Apply lt_reg_l;
- Apply compare_convert_INFERIEUR;Assumption
- | Apply lt_le_weak; Apply compare_convert_INFERIEUR;
- Apply ZC1;Assumption ]
- | Apply lt_le_weak; Apply compare_convert_INFERIEUR;Apply ZC1;
- Assumption ]
- | Assumption ]
- | Assumption ]
- | Simpl; Apply convert_compare_INFERIEUR; Rewrite true_sub_convert; [
- Rewrite true_sub_convert; [
- Apply simpl_lt_plus_l with p:=(convert q); Rewrite le_plus_minus_r; [
- Rewrite plus_sym; Apply simpl_lt_plus_l with p:=(convert p);
- Rewrite plus_assoc_l; Rewrite le_plus_minus_r; [
- Rewrite (plus_sym (convert p)); Apply lt_reg_l;
- Apply compare_convert_INFERIEUR;Apply ZC1;Assumption
- | Apply lt_le_weak; Apply compare_convert_INFERIEUR;Apply ZC1;
- Assumption ]
- | Apply lt_le_weak;Apply compare_convert_INFERIEUR;Apply ZC1;Assumption]
- | Assumption]
- | Assumption]]].
+intros x y z; case x; case y; simpl in |- *; auto with arith;
+ [ intros p; apply nat_of_P_lt_Lt_compare_complement_morphism; apply ZL17
+ | intros p; ElimPcompare z p; intros E; rewrite E; auto with arith;
+ apply nat_of_P_gt_Gt_compare_complement_morphism;
+ rewrite nat_of_P_minus_morphism;
+ [ unfold gt in |- *; apply ZL16 | assumption ]
+ | intros p; ElimPcompare z p; intros E; auto with arith;
+ apply nat_of_P_gt_Gt_compare_complement_morphism;
+ unfold gt in |- *; apply ZL17
+ | intros p q; ElimPcompare q p; intros E; rewrite E;
+ [ rewrite (Pcompare_Eq_eq q p E); apply Pcompare_refl
+ | apply nat_of_P_lt_Lt_compare_complement_morphism;
+ do 2 rewrite nat_of_P_plus_morphism; apply plus_lt_compat_l;
+ apply nat_of_P_lt_Lt_compare_morphism with (1 := E)
+ | apply nat_of_P_gt_Gt_compare_complement_morphism; unfold gt in |- *;
+ do 2 rewrite nat_of_P_plus_morphism; apply plus_lt_compat_l;
+ exact (nat_of_P_gt_Gt_compare_morphism q p E) ]
+ | intros p q; ElimPcompare z p; intros E; rewrite E; auto with arith;
+ apply nat_of_P_gt_Gt_compare_complement_morphism;
+ rewrite nat_of_P_minus_morphism;
+ [ unfold gt in |- *; apply lt_trans with (m := nat_of_P z);
+ [ apply ZL16 | apply ZL17 ]
+ | assumption ]
+ | intros p; ElimPcompare z p; intros E; rewrite E; auto with arith;
+ simpl in |- *; apply nat_of_P_lt_Lt_compare_complement_morphism;
+ rewrite nat_of_P_minus_morphism; [ apply ZL16 | assumption ]
+ | intros p q; ElimPcompare z q; intros E; rewrite E; auto with arith;
+ simpl in |- *; apply nat_of_P_lt_Lt_compare_complement_morphism;
+ rewrite nat_of_P_minus_morphism;
+ [ apply lt_trans with (m := nat_of_P z); [ apply ZL16 | apply ZL17 ]
+ | assumption ]
+ | intros p q; ElimPcompare z q; intros E0; rewrite E0; ElimPcompare z p;
+ intros E1; rewrite E1; ElimPcompare q p; intros E2;
+ rewrite E2; auto with arith;
+ [ absurd ((q ?= p)%positive Eq = Lt);
+ [ rewrite <- (Pcompare_Eq_eq z q E0);
+ rewrite <- (Pcompare_Eq_eq z p E1); rewrite (Pcompare_refl z);
+ discriminate
+ | assumption ]
+ | absurd ((q ?= p)%positive Eq = Gt);
+ [ rewrite <- (Pcompare_Eq_eq z q E0);
+ rewrite <- (Pcompare_Eq_eq z p E1); rewrite (Pcompare_refl z);
+ discriminate
+ | assumption ]
+ | absurd ((z ?= p)%positive Eq = Lt);
+ [ rewrite (Pcompare_Eq_eq z q E0); rewrite <- (Pcompare_Eq_eq q p E2);
+ rewrite (Pcompare_refl q); discriminate
+ | assumption ]
+ | absurd ((z ?= p)%positive Eq = Lt);
+ [ rewrite (Pcompare_Eq_eq z q E0); rewrite E2; discriminate
+ | assumption ]
+ | absurd ((z ?= p)%positive Eq = Gt);
+ [ rewrite (Pcompare_Eq_eq z q E0); rewrite <- (Pcompare_Eq_eq q p E2);
+ rewrite (Pcompare_refl q); discriminate
+ | assumption ]
+ | absurd ((z ?= p)%positive Eq = Gt);
+ [ rewrite (Pcompare_Eq_eq z q E0); rewrite E2; discriminate
+ | assumption ]
+ | absurd ((z ?= q)%positive Eq = Lt);
+ [ rewrite (Pcompare_Eq_eq z p E1); rewrite (Pcompare_Eq_eq q p E2);
+ rewrite (Pcompare_refl p); discriminate
+ | assumption ]
+ | absurd ((p ?= q)%positive Eq = Gt);
+ [ rewrite <- (Pcompare_Eq_eq z p E1); rewrite E0; discriminate
+ | apply ZC2; assumption ]
+ | simpl in |- *; rewrite (Pcompare_Eq_eq q p E2);
+ rewrite (Pcompare_refl (p - z)); auto with arith
+ | simpl in |- *; rewrite <- ZC4;
+ apply nat_of_P_gt_Gt_compare_complement_morphism;
+ rewrite nat_of_P_minus_morphism;
+ [ rewrite nat_of_P_minus_morphism;
+ [ unfold gt in |- *; apply plus_lt_reg_l with (p := nat_of_P z);
+ rewrite le_plus_minus_r;
+ [ rewrite le_plus_minus_r;
+ [ apply nat_of_P_lt_Lt_compare_morphism; assumption
+ | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
+ assumption ]
+ | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
+ assumption ]
+ | apply ZC2; assumption ]
+ | apply ZC2; assumption ]
+ | simpl in |- *; rewrite <- ZC4;
+ apply nat_of_P_lt_Lt_compare_complement_morphism;
+ rewrite nat_of_P_minus_morphism;
+ [ rewrite nat_of_P_minus_morphism;
+ [ apply plus_lt_reg_l with (p := nat_of_P z);
+ rewrite le_plus_minus_r;
+ [ rewrite le_plus_minus_r;
+ [ apply nat_of_P_lt_Lt_compare_morphism; apply ZC1;
+ assumption
+ | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
+ assumption ]
+ | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
+ assumption ]
+ | apply ZC2; assumption ]
+ | apply ZC2; assumption ]
+ | absurd ((z ?= q)%positive Eq = Lt);
+ [ rewrite (Pcompare_Eq_eq q p E2); rewrite E1; discriminate
+ | assumption ]
+ | absurd ((q ?= p)%positive Eq = Lt);
+ [ cut ((q ?= p)%positive Eq = Gt);
+ [ intros E; rewrite E; discriminate
+ | apply nat_of_P_gt_Gt_compare_complement_morphism;
+ unfold gt in |- *; apply lt_trans with (m := nat_of_P z);
+ [ apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; assumption
+ | apply nat_of_P_lt_Lt_compare_morphism; assumption ] ]
+ | assumption ]
+ | absurd ((z ?= q)%positive Eq = Gt);
+ [ rewrite (Pcompare_Eq_eq z p E1); rewrite (Pcompare_Eq_eq q p E2);
+ rewrite (Pcompare_refl p); discriminate
+ | assumption ]
+ | absurd ((z ?= q)%positive Eq = Gt);
+ [ rewrite (Pcompare_Eq_eq z p E1); rewrite ZC1;
+ [ discriminate | assumption ]
+ | assumption ]
+ | absurd ((z ?= q)%positive Eq = Gt);
+ [ rewrite (Pcompare_Eq_eq q p E2); rewrite E1; discriminate
+ | assumption ]
+ | absurd ((q ?= p)%positive Eq = Gt);
+ [ rewrite ZC1;
+ [ discriminate
+ | apply nat_of_P_gt_Gt_compare_complement_morphism;
+ unfold gt in |- *; apply lt_trans with (m := nat_of_P z);
+ [ apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; assumption
+ | apply nat_of_P_lt_Lt_compare_morphism; assumption ] ]
+ | assumption ]
+ | simpl in |- *; rewrite (Pcompare_Eq_eq q p E2); apply Pcompare_refl
+ | simpl in |- *; apply nat_of_P_gt_Gt_compare_complement_morphism;
+ unfold gt in |- *; rewrite nat_of_P_minus_morphism;
+ [ rewrite nat_of_P_minus_morphism;
+ [ apply plus_lt_reg_l with (p := nat_of_P p);
+ rewrite le_plus_minus_r;
+ [ rewrite plus_comm; apply plus_lt_reg_l with (p := nat_of_P q);
+ rewrite plus_assoc; rewrite le_plus_minus_r;
+ [ rewrite (plus_comm (nat_of_P q)); apply plus_lt_compat_l;
+ apply nat_of_P_lt_Lt_compare_morphism;
+ assumption
+ | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
+ apply ZC1; assumption ]
+ | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
+ apply ZC1; assumption ]
+ | assumption ]
+ | assumption ]
+ | simpl in |- *; apply nat_of_P_lt_Lt_compare_complement_morphism;
+ rewrite nat_of_P_minus_morphism;
+ [ rewrite nat_of_P_minus_morphism;
+ [ apply plus_lt_reg_l with (p := nat_of_P q);
+ rewrite le_plus_minus_r;
+ [ rewrite plus_comm; apply plus_lt_reg_l with (p := nat_of_P p);
+ rewrite plus_assoc; rewrite le_plus_minus_r;
+ [ rewrite (plus_comm (nat_of_P p)); apply plus_lt_compat_l;
+ apply nat_of_P_lt_Lt_compare_morphism;
+ apply ZC1; assumption
+ | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
+ apply ZC1; assumption ]
+ | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
+ apply ZC1; assumption ]
+ | assumption ]
+ | assumption ] ] ].
Qed.
-Lemma Zcompare_Zplus_compatible :
- (x,y,z:Z) (Zcompare (Zplus z x) (Zplus z y)) = (Zcompare x y).
+Lemma Zcompare_plus_compat : forall n m p:Z, (p + n ?= p + m) = (n ?= m).
Proof.
-Exact (weaken_Zcompare_Zplus_compatible weak_Zcompare_Zplus_compatible).
+exact (weaken_Zcompare_Zplus_compatible weak_Zcompare_Zplus_compatible).
Qed.
-Lemma Zcompare_Zplus_compatible2 :
- (r:relation)(x,y,z,t:Z)
- (Zcompare x y) = r -> (Zcompare z t) = r ->
- (Zcompare (Zplus x z) (Zplus y t)) = r.
+Lemma Zplus_compare_compat :
+ forall (r:comparison) (n m p q:Z),
+ (n ?= m) = r -> (p ?= q) = r -> (n + p ?= m + q) = r.
Proof.
-Intros r x y z t; Case r; [
- Intros H1 H2; Elim (Zcompare_EGAL x y); Elim (Zcompare_EGAL z t);
- Intros H3 H4 H5 H6; Rewrite H3; [
- Rewrite H5; [ Elim (Zcompare_EGAL (Zplus y t) (Zplus y t)); Auto with arith | Auto with arith ]
- | Auto with arith ]
-| Intros H1 H2; Elim (Zcompare_ANTISYM (Zplus y t) (Zplus x z));
- Intros H3 H4; Apply H3;
- Apply Zcompare_trans_SUPERIEUR with y:=(Zplus y z) ; [
- Rewrite Zcompare_Zplus_compatible;
- Elim (Zcompare_ANTISYM t z); Auto with arith
- | Do 2 Rewrite <- (Zplus_sym z);
- Rewrite Zcompare_Zplus_compatible;
- Elim (Zcompare_ANTISYM y x); Auto with arith]
-| Intros H1 H2;
- Apply Zcompare_trans_SUPERIEUR with y:=(Zplus x t) ; [
- Rewrite Zcompare_Zplus_compatible; Assumption
- | Do 2 Rewrite <- (Zplus_sym t);
- Rewrite Zcompare_Zplus_compatible; Assumption]].
+intros r x y z t; case r;
+ [ intros H1 H2; elim (Zcompare_Eq_iff_eq x y); elim (Zcompare_Eq_iff_eq z t);
+ intros H3 H4 H5 H6; rewrite H3;
+ [ rewrite H5;
+ [ elim (Zcompare_Eq_iff_eq (y + t) (y + t)); auto with arith
+ | auto with arith ]
+ | auto with arith ]
+ | intros H1 H2; elim (Zcompare_Gt_Lt_antisym (y + t) (x + z)); intros H3 H4;
+ apply H3; apply Zcompare_Gt_trans with (m := y + z);
+ [ rewrite Zcompare_plus_compat; elim (Zcompare_Gt_Lt_antisym t z);
+ auto with arith
+ | do 2 rewrite <- (Zplus_comm z); rewrite Zcompare_plus_compat;
+ elim (Zcompare_Gt_Lt_antisym y x); auto with arith ]
+ | intros H1 H2; apply Zcompare_Gt_trans with (m := x + t);
+ [ rewrite Zcompare_plus_compat; assumption
+ | do 2 rewrite <- (Zplus_comm t); rewrite Zcompare_plus_compat;
+ assumption ] ].
Qed.
-Lemma Zcompare_Zs_SUPERIEUR : (x:Z)(Zcompare (Zs x) x)=SUPERIEUR.
+Lemma Zcompare_succ_Gt : forall n:Z, (Zsucc n ?= n) = Gt.
Proof.
-Intro x; Unfold Zs; Pattern 2 x; Rewrite <- (Zero_right x);
-Rewrite Zcompare_Zplus_compatible;Reflexivity.
+intro x; unfold Zsucc in |- *; pattern x at 2 in |- *;
+ rewrite <- (Zplus_0_r x); rewrite Zcompare_plus_compat;
+ reflexivity.
Qed.
-Lemma Zcompare_et_un:
- (x,y:Z) (Zcompare x y)=SUPERIEUR <->
- ~(Zcompare x (Zplus y (POS xH)))=INFERIEUR.
+Lemma Zcompare_Gt_not_Lt : forall n m:Z, (n ?= m) = Gt <-> (n ?= m + 1) <> Lt.
Proof.
-Intros x y; Split; [
- Intro H; (ElimCompare 'x '(Zplus y (POS xH)));[
- Intro H1; Rewrite H1; Discriminate
- | Intros H1; Elim SUPERIEUR_POS with 1:=H; Intros h H2;
- Absurd (gt (convert h) O) /\ (lt (convert h) (S O)); [
- Unfold not ;Intros H3;Elim H3;Intros H4 H5; Absurd (gt (convert h) O); [
- Unfold gt ;Apply le_not_lt; Apply le_S_n; Exact H5
- | Assumption]
- | Split; [
- Elim (ZL4 h); Intros i H3;Rewrite H3; Apply gt_Sn_O
- | Change (lt (convert h) (convert xH));
- Apply compare_convert_INFERIEUR;
- Change (Zcompare (POS h) (POS xH))=INFERIEUR;
- Rewrite <- H2; Rewrite <- [m,n:Z](Zcompare_Zplus_compatible m n y);
- Rewrite (Zplus_sym x);Rewrite Zplus_assoc; Rewrite Zplus_inverse_r;
- Simpl; Exact H1 ]]
- | Intros H1;Rewrite -> H1;Discriminate ]
-| Intros H; (ElimCompare 'x '(Zplus y (POS xH))); [
- Intros H1;Elim (Zcompare_EGAL x (Zplus y (POS xH))); Intros H2 H3;
- Rewrite (H2 H1); Exact (Zcompare_Zs_SUPERIEUR y)
- | Intros H1;Absurd (Zcompare x (Zplus y (POS xH)))=INFERIEUR;Assumption
- | Intros H1; Apply Zcompare_trans_SUPERIEUR with y:=(Zs y);
- [ Exact H1 | Exact (Zcompare_Zs_SUPERIEUR y)]]].
+intros x y; split;
+ [ intro H; elim_compare x (y + 1);
+ [ intro H1; rewrite H1; discriminate
+ | intros H1; elim Zcompare_Gt_spec with (1 := H); intros h H2;
+ absurd ((nat_of_P h > 0)%nat /\ (nat_of_P h < 1)%nat);
+ [ unfold not in |- *; intros H3; elim H3; intros H4 H5;
+ absurd (nat_of_P h > 0)%nat;
+ [ unfold gt in |- *; apply le_not_lt; apply le_S_n; exact H5
+ | assumption ]
+ | split;
+ [ elim (ZL4 h); intros i H3; rewrite H3; apply gt_Sn_O
+ | change (nat_of_P h < nat_of_P 1)%nat in |- *;
+ apply nat_of_P_lt_Lt_compare_morphism;
+ change ((Zpos h ?= 1) = Lt) in |- *; rewrite <- H2;
+ rewrite <- (fun m n:Z => Zcompare_plus_compat m n y);
+ rewrite (Zplus_comm x); rewrite Zplus_assoc;
+ rewrite Zplus_opp_r; simpl in |- *; exact H1 ] ]
+ | intros H1; rewrite H1; discriminate ]
+ | intros H; elim_compare x (y + 1);
+ [ intros H1; elim (Zcompare_Eq_iff_eq x (y + 1)); intros H2 H3;
+ rewrite (H2 H1); exact (Zcompare_succ_Gt y)
+ | intros H1; absurd ((x ?= y + 1) = Lt); assumption
+ | intros H1; apply Zcompare_Gt_trans with (m := Zsucc y);
+ [ exact H1 | exact (Zcompare_succ_Gt y) ] ] ].
Qed.
(** Successor and comparison *)
-Lemma Zcompare_n_S : (n,m:Z)(Zcompare (Zs n) (Zs m)) = (Zcompare n m).
+Lemma Zcompare_succ_compat : forall n m:Z, (Zsucc n ?= Zsucc m) = (n ?= m).
Proof.
-Intros n m;Unfold Zs ;Do 2 Rewrite -> [t:Z](Zplus_sym t (POS xH));
-Rewrite -> Zcompare_Zplus_compatible;Auto with arith.
+intros n m; unfold Zsucc in |- *; do 2 rewrite (fun t:Z => Zplus_comm t 1);
+ rewrite Zcompare_plus_compat; auto with arith.
Qed.
(** Multiplication and comparison *)
-Lemma Zcompare_Zmult_compatible :
- (x:positive)(y,z:Z)
- (Zcompare (Zmult (POS x) y) (Zmult (POS x) z)) = (Zcompare y z).
+Lemma Zcompare_mult_compat :
+ forall (p:positive) (n m:Z), (Zpos p * n ?= Zpos p * m) = (n ?= m).
Proof.
-Intros x; NewInduction x as [p H|p H|]; [
- Intros y z;
- Cut (POS (xI p))=(Zplus (Zplus (POS p) (POS p)) (POS xH)); [
- Intros E; Rewrite E; Do 4 Rewrite Zmult_plus_distr_l;
- Do 2 Rewrite Zmult_one;
- Apply Zcompare_Zplus_compatible2; [
- Apply Zcompare_Zplus_compatible2; Apply H
- | Trivial with arith]
- | Simpl; Rewrite (add_x_x p); Trivial with arith]
-| Intros y z; Cut (POS (xO p))=(Zplus (POS p) (POS p)); [
- Intros E; Rewrite E; Do 2 Rewrite Zmult_plus_distr_l;
- Apply Zcompare_Zplus_compatible2; Apply H
- | Simpl; Rewrite (add_x_x p); Trivial with arith]
- | Intros y z; Do 2 Rewrite Zmult_one; Trivial with arith].
+intros x; induction x as [p H| p H| ];
+ [ intros y z; cut (Zpos (xI p) = Zpos p + Zpos p + 1);
+ [ intros E; rewrite E; do 4 rewrite Zmult_plus_distr_l;
+ do 2 rewrite Zmult_1_l; apply Zplus_compare_compat;
+ [ apply Zplus_compare_compat; apply H | trivial with arith ]
+ | simpl in |- *; rewrite (Pplus_diag p); trivial with arith ]
+ | intros y z; cut (Zpos (xO p) = Zpos p + Zpos p);
+ [ intros E; rewrite E; do 2 rewrite Zmult_plus_distr_l;
+ apply Zplus_compare_compat; apply H
+ | simpl in |- *; rewrite (Pplus_diag p); trivial with arith ]
+ | intros y z; do 2 rewrite Zmult_1_l; trivial with arith ].
Qed.
(** Reverting [x ?= y] to trichotomy *)
-Lemma rename : (A:Set)(P:A->Prop)(x:A) ((y:A)(x=y)->(P y)) -> (P x).
+Lemma rename :
+ forall (A:Set) (P:A -> Prop) (x:A), (forall y:A, x = y -> P y) -> P x.
Proof.
-Auto with arith.
+auto with arith.
Qed.
Lemma Zcompare_elim :
- (c1,c2,c3:Prop)(x,y:Z)
- ((x=y) -> c1) ->(`x<y` -> c2) ->(`x>y`-> c3)
- -> Cases (Zcompare x y) of EGAL => c1 | INFERIEUR => c2 | SUPERIEUR => c3 end.
+ forall (c1 c2 c3:Prop) (n m:Z),
+ (n = m -> c1) ->
+ (n < m -> c2) ->
+ (n > m -> c3) -> match n ?= m with
+ | Eq => c1
+ | Lt => c2
+ | Gt => c3
+ end.
Proof.
-Intros c1 c2 c3 x y; Intros.
-Apply rename with x:=(Zcompare x y); Intro r; Elim r;
-[ Intro; Apply H; Apply (Zcompare_EGAL_eq x y); Assumption
-| Unfold Zlt in H0; Assumption
-| Unfold Zgt in H1; Assumption ].
+intros c1 c2 c3 x y; intros.
+apply rename with (x := x ?= y); intro r; elim r;
+ [ intro; apply H; apply (Zcompare_Eq_eq x y); assumption
+ | unfold Zlt in H0; assumption
+ | unfold Zgt in H1; assumption ].
Qed.
-Lemma Zcompare_eq_case :
- (c1,c2,c3:Prop)(x,y:Z) c1 -> x=y ->
- Cases (Zcompare x y) of EGAL => c1 | INFERIEUR => c2 | SUPERIEUR => c3 end.
+Lemma Zcompare_eq_case :
+ forall (c1 c2 c3:Prop) (n m:Z),
+ c1 -> n = m -> match n ?= m with
+ | Eq => c1
+ | Lt => c2
+ | Gt => c3
+ end.
Proof.
-Intros c1 c2 c3 x y; Intros.
-Rewrite H0; Rewrite (Zcompare_x_x).
-Assumption.
+intros c1 c2 c3 x y; intros.
+rewrite H0; rewrite Zcompare_refl.
+assumption.
Qed.
(** Decompose an egality between two [?=] relations into 3 implications *)
Lemma Zcompare_egal_dec :
- (x1,y1,x2,y2:Z)
- (`x1<y1`->`x2<y2`)
- ->((Zcompare x1 y1)=EGAL -> (Zcompare x2 y2)=EGAL)
- ->(`x1>y1`->`x2>y2`)->(Zcompare x1 y1)=(Zcompare x2 y2).
+ forall n m p q:Z,
+ (n < m -> p < q) ->
+ ((n ?= m) = Eq -> (p ?= q) = Eq) ->
+ (n > m -> p > q) -> (n ?= m) = (p ?= q).
Proof.
-Intros x1 y1 x2 y2.
-Unfold Zgt; Unfold Zlt;
-Case (Zcompare x1 y1); Case (Zcompare x2 y2); Auto with arith; Symmetry; Auto with arith.
+intros x1 y1 x2 y2.
+unfold Zgt in |- *; unfold Zlt in |- *; case (x1 ?= y1); case (x2 ?= y2);
+ auto with arith; symmetry in |- *; auto with arith.
Qed.
(** Relating [x ?= y] to [Zle], [Zlt], [Zge] or [Zgt] *)
-Lemma Zle_Zcompare :
- (x,y:Z)`x<=y` ->
- Cases (Zcompare x y) of EGAL => True | INFERIEUR => True | SUPERIEUR => False end.
+Lemma Zle_compare :
+ forall n m:Z,
+ n <= m -> match n ?= m with
+ | Eq => True
+ | Lt => True
+ | Gt => False
+ end.
Proof.
-Intros x y; Unfold Zle; Elim (Zcompare x y); Auto with arith.
+intros x y; unfold Zle in |- *; elim (x ?= y); auto with arith.
Qed.
-Lemma Zlt_Zcompare :
- (x,y:Z)`x<y` ->
- Cases (Zcompare x y) of EGAL => False | INFERIEUR => True | SUPERIEUR => False end.
+Lemma Zlt_compare :
+ forall n m:Z,
+ n < m -> match n ?= m with
+ | Eq => False
+ | Lt => True
+ | Gt => False
+ end.
Proof.
-Intros x y; Unfold Zlt; Elim (Zcompare x y); Intros; Discriminate Orelse Trivial with arith.
+intros x y; unfold Zlt in |- *; elim (x ?= y); intros;
+ discriminate || trivial with arith.
Qed.
-Lemma Zge_Zcompare :
- (x,y:Z)`x>=y`->
- Cases (Zcompare x y) of EGAL => True | INFERIEUR => False | SUPERIEUR => True end.
+Lemma Zge_compare :
+ forall n m:Z,
+ n >= m -> match n ?= m with
+ | Eq => True
+ | Lt => False
+ | Gt => True
+ end.
Proof.
-Intros x y; Unfold Zge; Elim (Zcompare x y); Auto with arith.
+intros x y; unfold Zge in |- *; elim (x ?= y); auto with arith.
Qed.
-Lemma Zgt_Zcompare :
- (x,y:Z)`x>y` ->
- Cases (Zcompare x y) of EGAL => False | INFERIEUR => False | SUPERIEUR => True end.
+Lemma Zgt_compare :
+ forall n m:Z,
+ n > m -> match n ?= m with
+ | Eq => False
+ | Lt => False
+ | Gt => True
+ end.
Proof.
-Intros x y; Unfold Zgt; Elim (Zcompare x y); Intros; Discriminate Orelse Trivial with arith.
+intros x y; unfold Zgt in |- *; elim (x ?= y); intros;
+ discriminate || trivial with arith.
Qed.
(**********************************************************************)
(* Other properties *)
-V7only [Set Implicit Arguments.].
-Lemma Zcompare_Zmult_left : (x,y,z:Z)`z>0` -> `x ?= y`=`z*x ?= z*y`.
+Lemma Zmult_compare_compat_l :
+ forall n m p:Z, p > 0 -> (n ?= m) = (p * n ?= p * m).
Proof.
-Intros x y z H; NewDestruct z.
- Discriminate H.
- Rewrite Zcompare_Zmult_compatible; Reflexivity.
- Discriminate H.
+intros x y z H; destruct z.
+ discriminate H.
+ rewrite Zcompare_mult_compat; reflexivity.
+ discriminate H.
Qed.
-Lemma Zcompare_Zmult_right : (x,y,z:Z)` z>0` -> `x ?= y`=`x*z ?= y*z`.
+Lemma Zmult_compare_compat_r :
+ forall n m p:Z, p > 0 -> (n ?= m) = (n * p ?= m * p).
Proof.
-Intros x y z H;
-Rewrite (Zmult_sym x z);
-Rewrite (Zmult_sym y z);
-Apply Zcompare_Zmult_left; Assumption.
+intros x y z H; rewrite (Zmult_comm x z); rewrite (Zmult_comm y z);
+ apply Zmult_compare_compat_l; assumption.
Qed.
-V7only [Unset Implicit Arguments.].
-
diff --git a/theories/ZArith/Zcomplements.v b/theories/ZArith/Zcomplements.v
index 8d27f81d2..01e8d4870 100644
--- a/theories/ZArith/Zcomplements.v
+++ b/theories/ZArith/Zcomplements.v
@@ -8,39 +8,38 @@
(*i $Id$ i*)
-Require ZArithRing.
-Require ZArith_base.
-Require Omega.
-Require Wf_nat.
-V7only [Import Z_scope.].
+Require Import ZArithRing.
+Require Import ZArith_base.
+Require Import Omega.
+Require Import Wf_nat.
Open Local Scope Z_scope.
-V7only [Set Implicit Arguments.].
(**********************************************************************)
(** About parity *)
-Lemma two_or_two_plus_one : (x:Z) { y:Z | `x = 2*y`}+{ y:Z | `x = 2*y+1`}.
+Lemma two_or_two_plus_one :
+ forall n:Z, {y : Z | n = 2 * y} + {y : Z | n = 2 * y + 1}.
Proof.
-Intro x; NewDestruct x.
-Left ; Split with ZERO; Reflexivity.
+intro x; destruct x.
+left; split with 0; reflexivity.
-NewDestruct p.
-Right ; Split with (POS p); Reflexivity.
+destruct p.
+right; split with (Zpos p); reflexivity.
-Left ; Split with (POS p); Reflexivity.
+left; split with (Zpos p); reflexivity.
-Right ; Split with ZERO; Reflexivity.
+right; split with 0; reflexivity.
-NewDestruct p.
-Right ; Split with (NEG (add xH p)).
-Rewrite NEG_xI.
-Rewrite NEG_add.
-Omega.
+destruct p.
+right; split with (Zneg (1 + p)).
+rewrite BinInt.Zneg_xI.
+rewrite BinInt.Zneg_plus_distr.
+omega.
-Left ; Split with (NEG p); Reflexivity.
+left; split with (Zneg p); reflexivity.
-Right ; Split with `-1`; Reflexivity.
+right; split with (-1); reflexivity.
Qed.
(**********************************************************************)
@@ -49,164 +48,165 @@ Qed.
Easy to compute: replace all "1" of the binary representation by
"0", except the first "1" (or the first one :-) *)
-Fixpoint floor_pos [a : positive] : positive :=
- Cases a of
- | xH => xH
- | (xO a') => (xO (floor_pos a'))
- | (xI b') => (xO (floor_pos b'))
+Fixpoint floor_pos (a:positive) : positive :=
+ match a with
+ | xH => 1%positive
+ | xO a' => xO (floor_pos a')
+ | xI b' => xO (floor_pos b')
end.
-Definition floor := [a:positive](POS (floor_pos a)).
+Definition floor (a:positive) := Zpos (floor_pos a).
-Lemma floor_gt0 : (x:positive) `(floor x) > 0`.
+Lemma floor_gt0 : forall p:positive, floor p > 0.
Proof.
-Intro.
-Compute.
-Trivial.
+intro.
+compute in |- *.
+trivial.
Qed.
-Lemma floor_ok : (a:positive)
- `(floor a) <= (POS a) < 2*(floor a)`.
+Lemma floor_ok : forall p:positive, floor p <= Zpos p < 2 * floor p.
Proof.
-Unfold floor.
-Intro a; NewInduction a as [p|p|].
-
-Simpl.
-Repeat Rewrite POS_xI.
-Rewrite (POS_xO (xO (floor_pos p))).
-Rewrite (POS_xO (floor_pos p)).
-Omega.
-
-Simpl.
-Repeat Rewrite POS_xI.
-Rewrite (POS_xO (xO (floor_pos p))).
-Rewrite (POS_xO (floor_pos p)).
-Rewrite (POS_xO p).
-Omega.
-
-Simpl; Omega.
+unfold floor in |- *.
+intro a; induction a as [p| p| ].
+
+simpl in |- *.
+repeat rewrite BinInt.Zpos_xI.
+rewrite (BinInt.Zpos_xO (xO (floor_pos p))).
+rewrite (BinInt.Zpos_xO (floor_pos p)).
+omega.
+
+simpl in |- *.
+repeat rewrite BinInt.Zpos_xI.
+rewrite (BinInt.Zpos_xO (xO (floor_pos p))).
+rewrite (BinInt.Zpos_xO (floor_pos p)).
+rewrite (BinInt.Zpos_xO p).
+omega.
+
+simpl in |- *; omega.
Qed.
(**********************************************************************)
(** Two more induction principles over [Z]. *)
-Theorem Z_lt_abs_rec : (P: Z -> Set)
- ((n: Z) ((m: Z) `|m|<|n|` -> (P m)) -> (P n)) -> (p: Z) (P p).
+Theorem Z_lt_abs_rec :
+ forall P:Z -> Set,
+ (forall n:Z, (forall m:Z, Zabs m < Zabs n -> P m) -> P n) ->
+ forall n:Z, P n.
Proof.
-Intros P HP p.
-LetTac Q:=[z]`0<=z`->(P z)*(P `-z`).
-Cut (Q `|p|`);[Intros|Apply (Z_lt_rec Q);Auto with zarith].
-Elim (Zabs_dec p);Intro eq;Rewrite eq;Elim H;Auto with zarith.
-Unfold Q;Clear Q;Intros.
-Apply pair;Apply HP.
-Rewrite Zabs_eq;Auto;Intros.
-Elim (H `|m|`);Intros;Auto with zarith.
-Elim (Zabs_dec m);Intro eq;Rewrite eq;Trivial.
-Rewrite Zabs_non_eq;Auto with zarith.
-Rewrite Zopp_Zopp;Intros.
-Elim (H `|m|`);Intros;Auto with zarith.
-Elim (Zabs_dec m);Intro eq;Rewrite eq;Trivial.
+intros P HP p.
+set (Q := fun z => 0 <= z -> P z * P (- z)) in *.
+cut (Q (Zabs p)); [ intros | apply (Z_lt_rec Q); auto with zarith ].
+elim (Zabs_dec p); intro eq; rewrite eq; elim H; auto with zarith.
+unfold Q in |- *; clear Q; intros.
+apply pair; apply HP.
+rewrite Zabs_eq; auto; intros.
+elim (H (Zabs m)); intros; auto with zarith.
+elim (Zabs_dec m); intro eq; rewrite eq; trivial.
+rewrite Zabs_non_eq; auto with zarith.
+rewrite Zopp_involutive; intros.
+elim (H (Zabs m)); intros; auto with zarith.
+elim (Zabs_dec m); intro eq; rewrite eq; trivial.
Qed.
-Theorem Z_lt_abs_induction : (P: Z -> Prop)
- ((n: Z) ((m: Z) `|m|<|n|` -> (P m)) -> (P n)) -> (p: Z) (P p).
+Theorem Z_lt_abs_induction :
+ forall P:Z -> Prop,
+ (forall n:Z, (forall m:Z, Zabs m < Zabs n -> P m) -> P n) ->
+ forall n:Z, P n.
Proof.
-Intros P HP p.
-LetTac Q:=[z]`0<=z`->(P z) /\ (P `-z`).
-Cut (Q `|p|`);[Intros|Apply (Z_lt_induction Q);Auto with zarith].
-Elim (Zabs_dec p);Intro eq;Rewrite eq;Elim H;Auto with zarith.
-Unfold Q;Clear Q;Intros.
-Split;Apply HP.
-Rewrite Zabs_eq;Auto;Intros.
-Elim (H `|m|`);Intros;Auto with zarith.
-Elim (Zabs_dec m);Intro eq;Rewrite eq;Trivial.
-Rewrite Zabs_non_eq;Auto with zarith.
-Rewrite Zopp_Zopp;Intros.
-Elim (H `|m|`);Intros;Auto with zarith.
-Elim (Zabs_dec m);Intro eq;Rewrite eq;Trivial.
+intros P HP p.
+set (Q := fun z => 0 <= z -> P z /\ P (- z)) in *.
+cut (Q (Zabs p)); [ intros | apply (Z_lt_induction Q); auto with zarith ].
+elim (Zabs_dec p); intro eq; rewrite eq; elim H; auto with zarith.
+unfold Q in |- *; clear Q; intros.
+split; apply HP.
+rewrite Zabs_eq; auto; intros.
+elim (H (Zabs m)); intros; auto with zarith.
+elim (Zabs_dec m); intro eq; rewrite eq; trivial.
+rewrite Zabs_non_eq; auto with zarith.
+rewrite Zopp_involutive; intros.
+elim (H (Zabs m)); intros; auto with zarith.
+elim (Zabs_dec m); intro eq; rewrite eq; trivial.
Qed.
-V7only [Unset Implicit Arguments.].
(** To do case analysis over the sign of [z] *)
-Lemma Zcase_sign : (x:Z)(P:Prop)
- (`x=0` -> P) ->
- (`x>0` -> P) ->
- (`x<0` -> P) -> P.
+Lemma Zcase_sign :
+ forall (n:Z) (P:Prop), (n = 0 -> P) -> (n > 0 -> P) -> (n < 0 -> P) -> P.
Proof.
-Intros x P Hzero Hpos Hneg.
-Induction x.
-Apply Hzero; Trivial.
-Apply Hpos; Apply POS_gt_ZERO.
-Apply Hneg; Apply NEG_lt_ZERO.
-Save.
-
-Lemma sqr_pos : (x:Z)`x*x >= 0`.
+intros x P Hzero Hpos Hneg.
+induction x as [| p| p].
+apply Hzero; trivial.
+apply Hpos; apply Zorder.Zgt_pos_0.
+apply Hneg; apply Zorder.Zlt_neg_0.
+Qed.
+
+Lemma sqr_pos : forall n:Z, n * n >= 0.
Proof.
-Intro x.
-Apply (Zcase_sign x `x*x >= 0`).
-Intros H; Rewrite H; Omega.
-Intros H; Replace `0` with `0*0`.
-Apply Zge_Zmult_pos_compat; Omega.
-Omega.
-Intros H; Replace `0` with `0*0`.
-Replace `x*x` with `(-x)*(-x)`.
-Apply Zge_Zmult_pos_compat; Omega.
-Ring.
-Omega.
-Save.
+intro x.
+apply (Zcase_sign x (x * x >= 0)).
+intros H; rewrite H; omega.
+intros H; replace 0 with (0 * 0).
+apply Zmult_ge_compat; omega.
+omega.
+intros H; replace 0 with (0 * 0).
+replace (x * x) with (- x * - x).
+apply Zmult_ge_compat; omega.
+ring.
+omega.
+Qed.
(**********************************************************************)
(** A list length in Z, tail recursive. *)
-Require PolyList.
+Require Import List.
-Fixpoint Zlength_aux [acc: Z; A:Set; l:(list A)] : Z := Cases l of
- nil => acc
- | (cons _ l) => (Zlength_aux (Zs acc) A l)
-end.
+Fixpoint Zlength_aux (acc:Z) (A:Set) (l:list A) {struct l} : Z :=
+ match l with
+ | nil => acc
+ | _ :: l => Zlength_aux (Zsucc acc) A l
+ end.
-Definition Zlength := (Zlength_aux 0).
-Implicits Zlength [1].
+Definition Zlength := Zlength_aux 0.
+Implicit Arguments Zlength [A].
Section Zlength_properties.
-Variable A:Set.
+Variable A : Set.
-Implicit Variable Type l:(list A).
+Implicit Type l : list A.
-Lemma Zlength_correct : (l:(list A))(Zlength l)=(inject_nat (length l)).
+Lemma Zlength_correct : forall l, Zlength l = Z_of_nat (length l).
Proof.
-Assert (l:(list A))(acc:Z)(Zlength_aux acc A l)=acc+(inject_nat (length l)).
-Induction l.
-Simpl; Auto with zarith.
-Intros; Simpl (length (cons a l0)); Rewrite inj_S.
-Simpl; Rewrite H; Auto with zarith.
-Unfold Zlength; Intros; Rewrite H; Auto.
+assert (forall l (acc:Z), Zlength_aux acc A l = acc + Z_of_nat (length l)).
+simple induction l.
+simpl in |- *; auto with zarith.
+intros; simpl (length (a :: l0)) in |- *; rewrite Znat.inj_S.
+simpl in |- *; rewrite H; auto with zarith.
+unfold Zlength in |- *; intros; rewrite H; auto.
Qed.
-Lemma Zlength_nil : (Zlength 1!A (nil A))=0.
+Lemma Zlength_nil : Zlength (A:=A) nil = 0.
Proof.
-Auto.
+auto.
Qed.
-Lemma Zlength_cons : (x:A)(l:(list A))(Zlength (cons x l))=(Zs (Zlength l)).
+Lemma Zlength_cons : forall (x:A) l, Zlength (x :: l) = Zsucc (Zlength l).
Proof.
-Intros; Do 2 Rewrite Zlength_correct.
-Simpl (length (cons x l)); Rewrite inj_S; Auto.
+intros; do 2 rewrite Zlength_correct.
+simpl (length (x :: l)) in |- *; rewrite Znat.inj_S; auto.
Qed.
-Lemma Zlength_nil_inv : (l:(list A))(Zlength l)=0 -> l=(nil ?).
+Lemma Zlength_nil_inv : forall l, Zlength l = 0 -> l = nil.
Proof.
-Intro l; Rewrite Zlength_correct.
-Case l; Auto.
-Intros x l'; Simpl (length (cons x l')).
-Rewrite inj_S.
-Intros; ElimType False; Generalize (ZERO_le_inj (length l')); Omega.
+intro l; rewrite Zlength_correct.
+case l; auto.
+intros x l'; simpl (length (x :: l')) in |- *.
+rewrite Znat.inj_S.
+intros; elimtype False; generalize (Zle_0_nat (length l')); omega.
Qed.
End Zlength_properties.
-Implicits Zlength_correct [1].
-Implicits Zlength_cons [1].
-Implicits Zlength_nil_inv [1].
+Implicit Arguments Zlength_correct [A].
+Implicit Arguments Zlength_cons [A].
+Implicit Arguments Zlength_nil_inv [A]. \ No newline at end of file
diff --git a/theories/ZArith/Zdiv.v b/theories/ZArith/Zdiv.v
index ee6987215..7738e868c 100644
--- a/theories/ZArith/Zdiv.v
+++ b/theories/ZArith/Zdiv.v
@@ -20,11 +20,10 @@ Then only after proves the main required property.
*)
Require Export ZArith_base.
-Require Zbool.
-Require Omega.
-Require ZArithRing.
-Require Zcomplements.
-V7only [Import Z_scope.].
+Require Import Zbool.
+Require Import Omega.
+Require Import ZArithRing.
+Require Import Zcomplements.
Open Local Scope Z_scope.
(**
@@ -37,16 +36,19 @@ Open Local Scope Z_scope.
*)
-Fixpoint Zdiv_eucl_POS [a:positive] : Z -> Z*Z := [b:Z]
- Cases a of
- | xH => if `(Zge_bool b 2)` then `(0,1)` else `(1,0)`
- | (xO a') =>
- let (q,r) = (Zdiv_eucl_POS a' b) in
- [r':=`2*r`] if `(Zgt_bool b r')` then `(2*q,r')` else `(2*q+1,r'-b)`
- | (xI a') =>
- let (q,r) = (Zdiv_eucl_POS a' b) in
- [r':=`2*r+1`] if `(Zgt_bool b r')` then `(2*q,r')` else `(2*q+1,r'-b)`
- end.
+Fixpoint Zdiv_eucl_POS (a:positive) (b:Z) {struct a} :
+ Z * Z :=
+ match a with
+ | xH => if Zge_bool b 2 then (0, 1) else (1, 0)
+ | xO a' =>
+ let (q, r) := Zdiv_eucl_POS a' b in
+ let r' := 2 * r in
+ if Zgt_bool b r' then (2 * q, r') else (2 * q + 1, r' - b)
+ | xI a' =>
+ let (q, r) := Zdiv_eucl_POS a' b in
+ let r' := 2 * r + 1 in
+ if Zgt_bool b r' then (2 * q, r') else (2 * q + 1, r' - b)
+ end.
(**
@@ -78,33 +80,32 @@ Fixpoint Zdiv_eucl_POS [a:positive] : Z -> Z*Z := [b:Z]
*)
-Definition Zdiv_eucl [a,b:Z] : Z*Z :=
- Cases a b of
- | ZERO _ => `(0,0)`
- | _ ZERO => `(0,0)`
- | (POS a') (POS _) => (Zdiv_eucl_POS a' b)
- | (NEG a') (POS _) =>
- let (q,r) = (Zdiv_eucl_POS a' b) in
- Cases r of
- | ZERO => `(-q,0)`
- | _ => `(-(q+1),b-r)`
+Definition Zdiv_eucl (a b:Z) : Z * Z :=
+ match a, b with
+ | Z0, _ => (0, 0)
+ | _, Z0 => (0, 0)
+ | Zpos a', Zpos _ => Zdiv_eucl_POS a' b
+ | Zneg a', Zpos _ =>
+ let (q, r) := Zdiv_eucl_POS a' b in
+ match r with
+ | Z0 => (- q, 0)
+ | _ => (- (q + 1), b - r)
end
- | (NEG a') (NEG b') =>
- let (q,r) = (Zdiv_eucl_POS a' (POS b')) in `(q,-r)`
- | (POS a') (NEG b') =>
- let (q,r) = (Zdiv_eucl_POS a' (POS b')) in
- Cases r of
- | ZERO => `(-q,0)`
- | _ => `(-(q+1),b+r)`
+ | Zneg a', Zneg b' => let (q, r) := Zdiv_eucl_POS a' (Zpos b') in (q, - r)
+ | Zpos a', Zneg b' =>
+ let (q, r) := Zdiv_eucl_POS a' (Zpos b') in
+ match r with
+ | Z0 => (- q, 0)
+ | _ => (- (q + 1), b + r)
end
- end.
+ end.
(** Division and modulo are projections of [Zdiv_eucl] *)
-Definition Zdiv [a,b:Z] : Z := let (q,_) = (Zdiv_eucl a b) in q.
+Definition Zdiv (a b:Z) : Z := let (q, _) := Zdiv_eucl a b in q.
-Definition Zmod [a,b:Z] : Z := let (_,r) = (Zdiv_eucl a b) in r.
+Definition Zmod (a b:Z) : Z := let (_, r) := Zdiv_eucl a b in r.
(* Tests:
@@ -127,306 +128,296 @@ Eval Compute in `(Zdiv_eucl (-7) (-3))`.
*)
-Lemma Z_div_mod_POS : (b:Z)`b > 0` -> (a:positive)
- let (q,r)=(Zdiv_eucl_POS a b) in `(POS a) = b*q + r`/\`0<=r<b`.
+Lemma Z_div_mod_POS :
+ forall b:Z,
+ b > 0 ->
+ forall a:positive,
+ let (q, r) := Zdiv_eucl_POS a b in Zpos a = b * q + r /\ 0 <= r < b.
Proof.
-Induction a; Unfold Zdiv_eucl_POS; Fold Zdiv_eucl_POS.
-
-Intro p; Case (Zdiv_eucl_POS p b); Intros q r (H0,H1).
-Generalize (Zgt_cases b `2*r+1`).
-Case (Zgt_bool b `2*r+1`);
-(Rewrite POS_xI; Rewrite H0; Split ; [ Ring | Omega ]).
-
-Intros p; Case (Zdiv_eucl_POS p b); Intros q r (H0,H1).
-Generalize (Zgt_cases b `2*r`).
-Case (Zgt_bool b `2*r`);
- Rewrite POS_xO; Change (POS (xO p)) with `2*(POS p)`;
- Rewrite H0; (Split; [Ring | Omega]).
-
-Generalize (Zge_cases b `2`).
-Case (Zge_bool b `2`); (Intros; Split; [Ring | Omega ]).
-Omega.
+simple induction a; unfold Zdiv_eucl_POS in |- *; fold Zdiv_eucl_POS in |- *.
+
+intro p; case (Zdiv_eucl_POS p b); intros q r [H0 H1].
+generalize (Zgt_cases b (2 * r + 1)).
+case (Zgt_bool b (2 * r + 1));
+ (rewrite BinInt.Zpos_xI; rewrite H0; split; [ ring | omega ]).
+
+intros p; case (Zdiv_eucl_POS p b); intros q r [H0 H1].
+generalize (Zgt_cases b (2 * r)).
+case (Zgt_bool b (2 * r)); rewrite BinInt.Zpos_xO;
+ change (Zpos (xO p)) with (2 * Zpos p) in |- *; rewrite H0;
+ (split; [ ring | omega ]).
+
+generalize (Zge_cases b 2).
+case (Zge_bool b 2); (intros; split; [ ring | omega ]).
+omega.
Qed.
-Theorem Z_div_mod : (a,b:Z)`b > 0` ->
- let (q,r) = (Zdiv_eucl a b) in `a = b*q + r` /\ `0<=r<b`.
+Theorem Z_div_mod :
+ forall a b:Z,
+ b > 0 -> let (q, r) := Zdiv_eucl a b in a = b * q + r /\ 0 <= r < b.
Proof.
-Intros a b; Case a; Case b; Try (Simpl; Intros; Omega).
-Unfold Zdiv_eucl; Intros; Apply Z_div_mod_POS; Trivial.
+intros a b; case a; case b; try (simpl in |- *; intros; omega).
+unfold Zdiv_eucl in |- *; intros; apply Z_div_mod_POS; trivial.
-Intros; Discriminate.
+intros; discriminate.
-Intros.
-Generalize (Z_div_mod_POS (POS p) H p0).
-Unfold Zdiv_eucl.
-Case (Zdiv_eucl_POS p0 (POS p)).
-Intros z z0.
-Case z0.
+intros.
+generalize (Z_div_mod_POS (Zpos p) H p0).
+unfold Zdiv_eucl in |- *.
+case (Zdiv_eucl_POS p0 (Zpos p)).
+intros z z0.
+case z0.
-Intros [H1 H2].
-Split; Trivial.
-Replace (NEG p0) with `-(POS p0)`; [ Rewrite H1; Ring | Trivial ].
+intros [H1 H2].
+split; trivial.
+replace (Zneg p0) with (- Zpos p0); [ rewrite H1; ring | trivial ].
-Intros p1 [H1 H2].
-Split; Trivial.
-Replace (NEG p0) with `-(POS p0)`; [ Rewrite H1; Ring | Trivial ].
-Generalize (POS_gt_ZERO p1); Omega.
+intros p1 [H1 H2].
+split; trivial.
+replace (Zneg p0) with (- Zpos p0); [ rewrite H1; ring | trivial ].
+generalize (Zorder.Zgt_pos_0 p1); omega.
-Intros p1 [H1 H2].
-Split; Trivial.
-Replace (NEG p0) with `-(POS p0)`; [ Rewrite H1; Ring | Trivial ].
-Generalize (NEG_lt_ZERO p1); Omega.
+intros p1 [H1 H2].
+split; trivial.
+replace (Zneg p0) with (- Zpos p0); [ rewrite H1; ring | trivial ].
+generalize (Zorder.Zlt_neg_0 p1); omega.
-Intros; Discriminate.
+intros; discriminate.
Qed.
(** Existence theorems *)
-Theorem Zdiv_eucl_exist : (b:Z)`b > 0` -> (a:Z)
- { qr:Z*Z | let (q,r)=qr in `a=b*q+r` /\ `0 <= r < b` }.
+Theorem Zdiv_eucl_exist :
+ forall b:Z,
+ b > 0 ->
+ forall a:Z, {qr : Z * Z | let (q, r) := qr in a = b * q + r /\ 0 <= r < b}.
Proof.
-Intros b Hb a.
-Exists (Zdiv_eucl a b).
-Exact (Z_div_mod a b Hb).
+intros b Hb a.
+exists (Zdiv_eucl a b).
+exact (Z_div_mod a b Hb).
Qed.
-Implicits Zdiv_eucl_exist.
+Implicit Arguments Zdiv_eucl_exist.
-Theorem Zdiv_eucl_extended : (b:Z)`b <> 0` -> (a:Z)
- { qr:Z*Z | let (q,r)=qr in `a=b*q+r` /\ `0 <= r < |b|` }.
+Theorem Zdiv_eucl_extended :
+ forall b:Z,
+ b <> 0 ->
+ forall a:Z,
+ {qr : Z * Z | let (q, r) := qr in a = b * q + r /\ 0 <= r < Zabs b}.
Proof.
-Intros b Hb a.
-Elim (Z_le_gt_dec `0` b);Intro Hb'.
-Cut `b>0`;[Intro Hb''|Omega].
-Rewrite Zabs_eq;[Apply Zdiv_eucl_exist;Assumption|Assumption].
-Cut `-b>0`;[Intro Hb''|Omega].
-Elim (Zdiv_eucl_exist Hb'' a);Intros qr.
-Elim qr;Intros q r Hqr.
-Exists (pair ? ? `-q` r).
-Elim Hqr;Intros.
-Split.
-Rewrite <- Zmult_Zopp_left;Assumption.
-Rewrite Zabs_non_eq;[Assumption|Omega].
+intros b Hb a.
+elim (Z_le_gt_dec 0 b); intro Hb'.
+cut (b > 0); [ intro Hb'' | omega ].
+rewrite Zabs_eq; [ apply Zdiv_eucl_exist; assumption | assumption ].
+cut (- b > 0); [ intro Hb'' | omega ].
+elim (Zdiv_eucl_exist Hb'' a); intros qr.
+elim qr; intros q r Hqr.
+exists (- q, r).
+elim Hqr; intros.
+split.
+rewrite <- Zmult_opp_comm; assumption.
+rewrite Zabs_non_eq; [ assumption | omega ].
Qed.
-Implicits Zdiv_eucl_extended.
+Implicit Arguments Zdiv_eucl_extended.
(** Auxiliary lemmas about [Zdiv] and [Zmod] *)
-Lemma Z_div_mod_eq : (a,b:Z)`b > 0` -> `a = b * (Zdiv a b) + (Zmod a b)`.
+Lemma Z_div_mod_eq : forall a b:Z, b > 0 -> a = b * Zdiv a b + Zmod a b.
Proof.
-Unfold Zdiv Zmod.
-Intros a b Hb.
-Generalize (Z_div_mod a b Hb).
-Case (Zdiv_eucl); Tauto.
-Save.
+unfold Zdiv, Zmod in |- *.
+intros a b Hb.
+generalize (Z_div_mod a b Hb).
+case Zdiv_eucl; tauto.
+Qed.
-Lemma Z_mod_lt : (a,b:Z)`b > 0` -> `0 <= (Zmod a b) < b`.
+Lemma Z_mod_lt : forall a b:Z, b > 0 -> 0 <= Zmod a b < b.
Proof.
-Unfold Zmod.
-Intros a b Hb.
-Generalize (Z_div_mod a b Hb).
-Case (Zdiv_eucl a b); Tauto.
-Save.
-
-Lemma Z_div_POS_ge0 : (b:Z)(a:positive)
- let (q,_) = (Zdiv_eucl_POS a b) in `q >= 0`.
+unfold Zmod in |- *.
+intros a b Hb.
+generalize (Z_div_mod a b Hb).
+case (Zdiv_eucl a b); tauto.
+Qed.
+
+Lemma Z_div_POS_ge0 :
+ forall (b:Z) (a:positive), let (q, _) := Zdiv_eucl_POS a b in q >= 0.
Proof.
-Induction a; Unfold Zdiv_eucl_POS; Fold Zdiv_eucl_POS.
-Intro p; Case (Zdiv_eucl_POS p b).
-Intros; Case (Zgt_bool b `2*z0+1`); Intros; Omega.
-Intro p; Case (Zdiv_eucl_POS p b).
-Intros; Case (Zgt_bool b `2*z0`); Intros; Omega.
-Case (Zge_bool b `2`); Simpl; Omega.
-Save.
-
-Lemma Z_div_ge0 : (a,b:Z)`b > 0` -> `a >= 0` -> `(Zdiv a b) >= 0`.
+simple induction a; unfold Zdiv_eucl_POS in |- *; fold Zdiv_eucl_POS in |- *.
+intro p; case (Zdiv_eucl_POS p b).
+intros; case (Zgt_bool b (2 * z0 + 1)); intros; omega.
+intro p; case (Zdiv_eucl_POS p b).
+intros; case (Zgt_bool b (2 * z0)); intros; omega.
+case (Zge_bool b 2); simpl in |- *; omega.
+Qed.
+
+Lemma Z_div_ge0 : forall a b:Z, b > 0 -> a >= 0 -> Zdiv a b >= 0.
Proof.
-Intros a b Hb; Unfold Zdiv Zdiv_eucl; Case a; Simpl; Intros.
-Case b; Simpl; Trivial.
-Generalize Hb; Case b; Try Trivial.
-Auto with zarith.
-Intros p0 Hp0; Generalize (Z_div_POS_ge0 (POS p0) p).
-Case (Zdiv_eucl_POS p (POS p0)); Simpl; Tauto.
-Intros; Discriminate.
-Elim H; Trivial.
-Save.
-
-Lemma Z_div_lt : (a,b:Z)`b >= 2` -> `a > 0` -> `(Zdiv a b) < a`.
+intros a b Hb; unfold Zdiv, Zdiv_eucl in |- *; case a; simpl in |- *; intros.
+case b; simpl in |- *; trivial.
+generalize Hb; case b; try trivial.
+auto with zarith.
+intros p0 Hp0; generalize (Z_div_POS_ge0 (Zpos p0) p).
+case (Zdiv_eucl_POS p (Zpos p0)); simpl in |- *; tauto.
+intros; discriminate.
+elim H; trivial.
+Qed.
+
+Lemma Z_div_lt : forall a b:Z, b >= 2 -> a > 0 -> Zdiv a b < a.
Proof.
-Intros. Cut `b > 0`; [Intro Hb | Omega].
-Generalize (Z_div_mod a b Hb).
-Cut `a >= 0`; [Intro Ha | Omega].
-Generalize (Z_div_ge0 a b Hb Ha).
-Unfold Zdiv; Case (Zdiv_eucl a b); Intros q r H1 [H2 H3].
-Cut `a >= 2*q` -> `q < a`; [ Intro h; Apply h; Clear h | Intros; Omega ].
-Apply Zge_trans with `b*q`.
-Omega.
-Auto with zarith.
-Save.
+intros. cut (b > 0); [ intro Hb | omega ].
+generalize (Z_div_mod a b Hb).
+cut (a >= 0); [ intro Ha | omega ].
+generalize (Z_div_ge0 a b Hb Ha).
+unfold Zdiv in |- *; case (Zdiv_eucl a b); intros q r H1 [H2 H3].
+cut (a >= 2 * q -> q < a); [ intro h; apply h; clear h | intros; omega ].
+apply Zge_trans with (b * q).
+omega.
+auto with zarith.
+Qed.
(** Syntax *)
-V7only[
-Grammar znatural expr2 : constr :=
- expr_div [ expr2($p) "/" expr2($c) ] -> [ (Zdiv $p $c) ]
-| expr_mod [ expr2($p) "%" expr2($c) ] -> [ (Zmod $p $c) ]
-.
-
-Syntax constr
- level 6:
- Zdiv [ (Zdiv $n1 $n2) ]
- -> [ [<hov 0> "`"(ZEXPR $n1):E "/" [0 0] (ZEXPR $n2):L "`"] ]
- | Zmod [ (Zmod $n1 $n2) ]
- -> [ [<hov 0> "`"(ZEXPR $n1):E "%" [0 0] (ZEXPR $n2):L "`"] ]
- | Zdiv_inside
- [ << (ZEXPR <<(Zdiv $n1 $n2)>>) >> ]
- -> [ (ZEXPR $n1):E "/" [0 0] (ZEXPR $n2):L ]
- | Zmod_inside
- [ << (ZEXPR <<(Zmod $n1 $n2)>>) >> ]
- -> [ (ZEXPR $n1):E " %" [1 0] (ZEXPR $n2):L ]
-.
-].
-
-
-Infix 3 "/" Zdiv (no associativity) : Z_scope V8only.
-Infix 3 "mod" Zmod (no associativity) : Z_scope.
+
+
+Infix "/" := Zdiv : Z_scope.
+Infix "mod" := Zmod (at level 40, no associativity) : Z_scope.
(** Other lemmas (now using the syntax for [Zdiv] and [Zmod]). *)
-Lemma Z_div_ge : (a,b,c:Z)`c > 0`->`a >= b`->`a/c >= b/c`.
+Lemma Z_div_ge : forall a b c:Z, c > 0 -> a >= b -> a / c >= b / c.
Proof.
-Intros a b c cPos aGeb.
-Generalize (Z_div_mod_eq a c cPos).
-Generalize (Z_mod_lt a c cPos).
-Generalize (Z_div_mod_eq b c cPos).
-Generalize (Z_mod_lt b c cPos).
-Intros.
-Elim (Z_ge_lt_dec `a/c` `b/c`); Trivial.
-Intro.
-Absurd `b-a >= 1`.
-Omega.
-Rewrite -> H0.
-Rewrite -> H2.
-Assert `c*(b/c)+b % c-(c*(a/c)+a % c) = c*(b/c - a/c) + b % c - a % c`.
-Ring.
-Rewrite H3.
-Assert `c*(b/c-a/c) >= c*1`.
-Apply Zge_Zmult_pos_left.
-Omega.
-Omega.
-Assert `c*1=c`.
-Ring.
-Omega.
-Save.
-
-Lemma Z_mod_plus : (a,b,c:Z)`c > 0`->`(a+b*c) % c = a % c`.
+intros a b c cPos aGeb.
+generalize (Z_div_mod_eq a c cPos).
+generalize (Z_mod_lt a c cPos).
+generalize (Z_div_mod_eq b c cPos).
+generalize (Z_mod_lt b c cPos).
+intros.
+elim (Z_ge_lt_dec (a / c) (b / c)); trivial.
+intro.
+absurd (b - a >= 1).
+omega.
+rewrite H0.
+rewrite H2.
+assert
+ (c * (b / c) + b mod c - (c * (a / c) + a mod c) =
+ c * (b / c - a / c) + b mod c - a mod c).
+ring.
+rewrite H3.
+assert (c * (b / c - a / c) >= c * 1).
+apply Zmult_ge_compat_l.
+omega.
+omega.
+assert (c * 1 = c).
+ring.
+omega.
+Qed.
+
+Lemma Z_mod_plus : forall a b c:Z, c > 0 -> (a + b * c) mod c = a mod c.
Proof.
-Intros a b c cPos.
-Generalize (Z_div_mod_eq a c cPos).
-Generalize (Z_mod_lt a c cPos).
-Generalize (Z_div_mod_eq `a+b*c` c cPos).
-Generalize (Z_mod_lt `a+b*c` c cPos).
-Intros.
-
-Assert `(a+b*c) % c - a % c = c*(b+a/c - (a+b*c)/c)`.
-Replace `(a+b*c) % c` with `a+b*c - c*((a+b*c)/c)`.
-Replace `a % c` with `a - c*(a/c)`.
-Ring.
-Omega.
-Omega.
-LetTac q := `b+a/c-(a+b*c)/c`.
-Apply (Zcase_sign q); Intros.
-Assert `c*q=0`.
-Rewrite H4; Ring.
-Rewrite H5 in H3.
-Omega.
-
-Assert `c*q >= c`.
-Pattern 2 c; Replace c with `c*1`.
-Apply Zge_Zmult_pos_left; Omega.
-Ring.
-Omega.
-
-Assert `c*q <= -c`.
-Replace `-c` with `c*(-1)`.
-Apply Zle_Zmult_pos_left; Omega.
-Ring.
-Omega.
-Save.
-
-Lemma Z_div_plus : (a,b,c:Z)`c > 0`->`(a+b*c)/c = a/c+b`.
+intros a b c cPos.
+generalize (Z_div_mod_eq a c cPos).
+generalize (Z_mod_lt a c cPos).
+generalize (Z_div_mod_eq (a + b * c) c cPos).
+generalize (Z_mod_lt (a + b * c) c cPos).
+intros.
+
+assert ((a + b * c) mod c - a mod c = c * (b + a / c - (a + b * c) / c)).
+replace ((a + b * c) mod c) with (a + b * c - c * ((a + b * c) / c)).
+replace (a mod c) with (a - c * (a / c)).
+ring.
+omega.
+omega.
+set (q := b + a / c - (a + b * c) / c) in *.
+apply (Zcase_sign q); intros.
+assert (c * q = 0).
+rewrite H4; ring.
+rewrite H5 in H3.
+omega.
+
+assert (c * q >= c).
+pattern c at 2 in |- *; replace c with (c * 1).
+apply Zmult_ge_compat_l; omega.
+ring.
+omega.
+
+assert (c * q <= - c).
+replace (- c) with (c * -1).
+apply Zmult_le_compat_l; omega.
+ring.
+omega.
+Qed.
+
+Lemma Z_div_plus : forall a b c:Z, c > 0 -> (a + b * c) / c = a / c + b.
Proof.
-Intros a b c cPos.
-Generalize (Z_div_mod_eq a c cPos).
-Generalize (Z_mod_lt a c cPos).
-Generalize (Z_div_mod_eq `a+b*c` c cPos).
-Generalize (Z_mod_lt `a+b*c` c cPos).
-Intros.
-Apply Zmult_reg_left with c. Omega.
-Replace `c*((a+b*c)/c)` with `a+b*c-(a+b*c) % c`.
-Rewrite (Z_mod_plus a b c cPos).
-Pattern 1 a; Rewrite H2.
-Ring.
-Pattern 1 `a+b*c`; Rewrite H0.
-Ring.
-Save.
-
-Lemma Z_div_mult : (a,b:Z)`b > 0`->`(a*b)/b = a`.
-Intros; Replace `a*b` with `0+a*b`; Auto.
-Rewrite Z_div_plus; Auto.
-Save.
-
-Lemma Z_mult_div_ge : (a,b:Z)`b>0`->`b*(a/b) <= a`.
+intros a b c cPos.
+generalize (Z_div_mod_eq a c cPos).
+generalize (Z_mod_lt a c cPos).
+generalize (Z_div_mod_eq (a + b * c) c cPos).
+generalize (Z_mod_lt (a + b * c) c cPos).
+intros.
+apply Zmult_reg_l with c. omega.
+replace (c * ((a + b * c) / c)) with (a + b * c - (a + b * c) mod c).
+rewrite (Z_mod_plus a b c cPos).
+pattern a at 1 in |- *; rewrite H2.
+ring.
+pattern (a + b * c) at 1 in |- *; rewrite H0.
+ring.
+Qed.
+
+Lemma Z_div_mult : forall a b:Z, b > 0 -> a * b / b = a.
+intros; replace (a * b) with (0 + a * b); auto.
+rewrite Z_div_plus; auto.
+Qed.
+
+Lemma Z_mult_div_ge : forall a b:Z, b > 0 -> b * (a / b) <= a.
Proof.
-Intros a b bPos.
-Generalize (Z_div_mod_eq `a` ? bPos); Intros.
-Generalize (Z_mod_lt `a` ? bPos); Intros.
-Pattern 2 a; Rewrite H.
-Omega.
-Save.
-
-Lemma Z_mod_same : (a:Z)`a>0`->`a % a=0`.
+intros a b bPos.
+generalize (Z_div_mod_eq a _ bPos); intros.
+generalize (Z_mod_lt a _ bPos); intros.
+pattern a at 2 in |- *; rewrite H.
+omega.
+Qed.
+
+Lemma Z_mod_same : forall a:Z, a > 0 -> a mod a = 0.
Proof.
-Intros a aPos.
-Generalize (Z_mod_plus `0` `1` a aPos).
-Replace `0+1*a` with `a`.
-Intros.
-Rewrite H.
-Compute.
-Trivial.
-Ring.
-Save.
-
-Lemma Z_div_same : (a:Z)`a>0`->`a/a=1`.
+intros a aPos.
+generalize (Z_mod_plus 0 1 a aPos).
+replace (0 + 1 * a) with a.
+intros.
+rewrite H.
+compute in |- *.
+trivial.
+ring.
+Qed.
+
+Lemma Z_div_same : forall a:Z, a > 0 -> a / a = 1.
Proof.
-Intros a aPos.
-Generalize (Z_div_plus `0` `1` a aPos).
-Replace `0+1*a` with `a`.
-Intros.
-Rewrite H.
-Compute.
-Trivial.
-Ring.
-Save.
-
-Lemma Z_div_exact_1 : (a,b:Z)`b>0` -> `a = b*(a/b)` -> `a%b = 0`.
-Intros a b Hb; Generalize (Z_div_mod a b Hb); Unfold Zmod Zdiv.
-Case (Zdiv_eucl a b); Intros q r; Omega.
-Save.
-
-Lemma Z_div_exact_2 : (a,b:Z)`b>0` -> `a%b = 0` -> `a = b*(a/b)`.
-Intros a b Hb; Generalize (Z_div_mod a b Hb); Unfold Zmod Zdiv.
-Case (Zdiv_eucl a b); Intros q r; Omega.
-Save.
-
-Lemma Z_mod_zero_opp : (a,b:Z)`b>0` -> `a%b = 0` -> `(-a)%b = 0`.
-Intros a b Hb.
-Intros.
-Rewrite Z_div_exact_2 with a b; Auto.
-Replace `-(b*(a/b))` with `0+(-(a/b))*b`.
-Rewrite Z_mod_plus; Auto.
-Ring.
-Save.
+intros a aPos.
+generalize (Z_div_plus 0 1 a aPos).
+replace (0 + 1 * a) with a.
+intros.
+rewrite H.
+compute in |- *.
+trivial.
+ring.
+Qed.
+
+Lemma Z_div_exact_1 : forall a b:Z, b > 0 -> a = b * (a / b) -> a mod b = 0.
+intros a b Hb; generalize (Z_div_mod a b Hb); unfold Zmod, Zdiv in |- *.
+case (Zdiv_eucl a b); intros q r; omega.
+Qed.
+Lemma Z_div_exact_2 : forall a b:Z, b > 0 -> a mod b = 0 -> a = b * (a / b).
+intros a b Hb; generalize (Z_div_mod a b Hb); unfold Zmod, Zdiv in |- *.
+case (Zdiv_eucl a b); intros q r; omega.
+Qed.
+
+Lemma Z_mod_zero_opp : forall a b:Z, b > 0 -> a mod b = 0 -> - a mod b = 0.
+intros a b Hb.
+intros.
+rewrite Z_div_exact_2 with a b; auto.
+replace (- (b * (a / b))) with (0 + - (a / b) * b).
+rewrite Z_mod_plus; auto.
+ring.
+Qed.
diff --git a/theories/ZArith/Zeven.v b/theories/ZArith/Zeven.v
index e22dc20f6..728e16da9 100644
--- a/theories/ZArith/Zeven.v
+++ b/theories/ZArith/Zeven.v
@@ -8,8 +8,7 @@
(*i $Id$ i*)
-Require BinInt.
-Require Zsyntax.
+Require Import BinInt.
(**********************************************************************)
(** About parity: even and odd predicates on Z, division by 2 on Z *)
@@ -17,168 +16,189 @@ Require Zsyntax.
(**********************************************************************)
(** [Zeven], [Zodd], [Zdiv2] and their related properties *)
-Definition Zeven :=
- [z:Z]Cases z of ZERO => True
- | (POS (xO _)) => True
- | (NEG (xO _)) => True
- | _ => False
- end.
-
-Definition Zodd :=
- [z:Z]Cases z of (POS xH) => True
- | (NEG xH) => True
- | (POS (xI _)) => True
- | (NEG (xI _)) => True
- | _ => False
- end.
-
-Definition Zeven_bool :=
- [z:Z]Cases z of ZERO => true
- | (POS (xO _)) => true
- | (NEG (xO _)) => true
- | _ => false
- end.
-
-Definition Zodd_bool :=
- [z:Z]Cases z of ZERO => false
- | (POS (xO _)) => false
- | (NEG (xO _)) => false
- | _ => true
- end.
-
-Definition Zeven_odd_dec : (z:Z) { (Zeven z) }+{ (Zodd z) }.
+Definition Zeven (z:Z) :=
+ match z with
+ | Z0 => True
+ | Zpos (xO _) => True
+ | Zneg (xO _) => True
+ | _ => False
+ end.
+
+Definition Zodd (z:Z) :=
+ match z with
+ | Zpos xH => True
+ | Zneg xH => True
+ | Zpos (xI _) => True
+ | Zneg (xI _) => True
+ | _ => False
+ end.
+
+Definition Zeven_bool (z:Z) :=
+ match z with
+ | Z0 => true
+ | Zpos (xO _) => true
+ | Zneg (xO _) => true
+ | _ => false
+ end.
+
+Definition Zodd_bool (z:Z) :=
+ match z with
+ | Z0 => false
+ | Zpos (xO _) => false
+ | Zneg (xO _) => false
+ | _ => true
+ end.
+
+Definition Zeven_odd_dec : forall z:Z, {Zeven z} + {Zodd z}.
Proof.
- Intro z. Case z;
- [ Left; Compute; Trivial
- | Intro p; Case p; Intros;
- (Right; Compute; Exact I) Orelse (Left; Compute; Exact I)
- | Intro p; Case p; Intros;
- (Right; Compute; Exact I) Orelse (Left; Compute; Exact I) ].
+ intro z. case z;
+ [ left; compute in |- *; trivial
+ | intro p; case p; intros;
+ (right; compute in |- *; exact I) || (left; compute in |- *; exact I)
+ | intro p; case p; intros;
+ (right; compute in |- *; exact I) || (left; compute in |- *; exact I) ].
Defined.
-Definition Zeven_dec : (z:Z) { (Zeven z) }+{ ~(Zeven z) }.
+Definition Zeven_dec : forall z:Z, {Zeven z} + {~ Zeven z}.
Proof.
- Intro z. Case z;
- [ Left; Compute; Trivial
- | Intro p; Case p; Intros;
- (Left; Compute; Exact I) Orelse (Right; Compute; Trivial)
- | Intro p; Case p; Intros;
- (Left; Compute; Exact I) Orelse (Right; Compute; Trivial) ].
+ intro z. case z;
+ [ left; compute in |- *; trivial
+ | intro p; case p; intros;
+ (left; compute in |- *; exact I) || (right; compute in |- *; trivial)
+ | intro p; case p; intros;
+ (left; compute in |- *; exact I) || (right; compute in |- *; trivial) ].
Defined.
-Definition Zodd_dec : (z:Z) { (Zodd z) }+{ ~(Zodd z) }.
+Definition Zodd_dec : forall z:Z, {Zodd z} + {~ Zodd z}.
Proof.
- Intro z. Case z;
- [ Right; Compute; Trivial
- | Intro p; Case p; Intros;
- (Left; Compute; Exact I) Orelse (Right; Compute; Trivial)
- | Intro p; Case p; Intros;
- (Left; Compute; Exact I) Orelse (Right; Compute; Trivial) ].
+ intro z. case z;
+ [ right; compute in |- *; trivial
+ | intro p; case p; intros;
+ (left; compute in |- *; exact I) || (right; compute in |- *; trivial)
+ | intro p; case p; intros;
+ (left; compute in |- *; exact I) || (right; compute in |- *; trivial) ].
Defined.
-Lemma Zeven_not_Zodd : (z:Z)(Zeven z) -> ~(Zodd z).
+Lemma Zeven_not_Zodd : forall n:Z, Zeven n -> ~ Zodd n.
Proof.
- Intro z; NewDestruct z; [ Idtac | NewDestruct p | NewDestruct p ]; Compute; Trivial.
+ intro z; destruct z; [ idtac | destruct p | destruct p ]; compute in |- *;
+ trivial.
Qed.
-Lemma Zodd_not_Zeven : (z:Z)(Zodd z) -> ~(Zeven z).
+Lemma Zodd_not_Zeven : forall n:Z, Zodd n -> ~ Zeven n.
Proof.
- Intro z; NewDestruct z; [ Idtac | NewDestruct p | NewDestruct p ]; Compute; Trivial.
+ intro z; destruct z; [ idtac | destruct p | destruct p ]; compute in |- *;
+ trivial.
Qed.
-Lemma Zeven_Sn : (z:Z)(Zodd z) -> (Zeven (Zs z)).
+Lemma Zeven_Sn : forall n:Z, Zodd n -> Zeven (Zsucc n).
Proof.
- Intro z; NewDestruct z; Unfold Zs; [ Idtac | NewDestruct p | NewDestruct p ]; Simpl; Trivial.
- Unfold double_moins_un; Case p; Simpl; Auto.
+ intro z; destruct z; unfold Zsucc in |- *;
+ [ idtac | destruct p | destruct p ]; simpl in |- *;
+ trivial.
+ unfold Pdouble_minus_one in |- *; case p; simpl in |- *; auto.
Qed.
-Lemma Zodd_Sn : (z:Z)(Zeven z) -> (Zodd (Zs z)).
+Lemma Zodd_Sn : forall n:Z, Zeven n -> Zodd (Zsucc n).
Proof.
- Intro z; NewDestruct z; Unfold Zs; [ Idtac | NewDestruct p | NewDestruct p ]; Simpl; Trivial.
- Unfold double_moins_un; Case p; Simpl; Auto.
+ intro z; destruct z; unfold Zsucc in |- *;
+ [ idtac | destruct p | destruct p ]; simpl in |- *;
+ trivial.
+ unfold Pdouble_minus_one in |- *; case p; simpl in |- *; auto.
Qed.
-Lemma Zeven_pred : (z:Z)(Zodd z) -> (Zeven (Zpred z)).
+Lemma Zeven_pred : forall n:Z, Zodd n -> Zeven (Zpred n).
Proof.
- Intro z; NewDestruct z; Unfold Zpred; [ Idtac | NewDestruct p | NewDestruct p ]; Simpl; Trivial.
- Unfold double_moins_un; Case p; Simpl; Auto.
+ intro z; destruct z; unfold Zpred in |- *;
+ [ idtac | destruct p | destruct p ]; simpl in |- *;
+ trivial.
+ unfold Pdouble_minus_one in |- *; case p; simpl in |- *; auto.
Qed.
-Lemma Zodd_pred : (z:Z)(Zeven z) -> (Zodd (Zpred z)).
+Lemma Zodd_pred : forall n:Z, Zeven n -> Zodd (Zpred n).
Proof.
- Intro z; NewDestruct z; Unfold Zpred; [ Idtac | NewDestruct p | NewDestruct p ]; Simpl; Trivial.
- Unfold double_moins_un; Case p; Simpl; Auto.
+ intro z; destruct z; unfold Zpred in |- *;
+ [ idtac | destruct p | destruct p ]; simpl in |- *;
+ trivial.
+ unfold Pdouble_minus_one in |- *; case p; simpl in |- *; auto.
Qed.
-Hints Unfold Zeven Zodd : zarith.
+Hint Unfold Zeven Zodd: zarith.
(**********************************************************************)
(** [Zdiv2] is defined on all [Z], but notice that for odd negative
integers it is not the euclidean quotient: in that case we have [n =
2*(n/2)-1] *)
-Definition Zdiv2 :=
- [z:Z]Cases z of ZERO => ZERO
- | (POS xH) => ZERO
- | (POS p) => (POS (Zdiv2_pos p))
- | (NEG xH) => ZERO
- | (NEG p) => (NEG (Zdiv2_pos p))
- end.
+Definition Zdiv2 (z:Z) :=
+ match z with
+ | Z0 => 0%Z
+ | Zpos xH => 0%Z
+ | Zpos p => Zpos (Pdiv2 p)
+ | Zneg xH => 0%Z
+ | Zneg p => Zneg (Pdiv2 p)
+ end.
-Lemma Zeven_div2 : (x:Z) (Zeven x) -> `x = 2*(Zdiv2 x)`.
+Lemma Zeven_div2 : forall n:Z, Zeven n -> n = (2 * Zdiv2 n)%Z.
Proof.
-Intro x; NewDestruct x.
-Auto with arith.
-NewDestruct p; Auto with arith.
-Intros. Absurd (Zeven (POS (xI p))); Red; Auto with arith.
-Intros. Absurd (Zeven `1`); Red; Auto with arith.
-NewDestruct p; Auto with arith.
-Intros. Absurd (Zeven (NEG (xI p))); Red; Auto with arith.
-Intros. Absurd (Zeven `-1`); Red; Auto with arith.
+intro x; destruct x.
+auto with arith.
+destruct p; auto with arith.
+intros. absurd (Zeven (Zpos (xI p))); red in |- *; auto with arith.
+intros. absurd (Zeven 1); red in |- *; auto with arith.
+destruct p; auto with arith.
+intros. absurd (Zeven (Zneg (xI p))); red in |- *; auto with arith.
+intros. absurd (Zeven (-1)); red in |- *; auto with arith.
Qed.
-Lemma Zodd_div2 : (x:Z) `x >= 0` -> (Zodd x) -> `x = 2*(Zdiv2 x)+1`.
+Lemma Zodd_div2 : forall n:Z, (n >= 0)%Z -> Zodd n -> n = (2 * Zdiv2 n + 1)%Z.
Proof.
-Intro x; NewDestruct x.
-Intros. Absurd (Zodd `0`); Red; Auto with arith.
-NewDestruct p; Auto with arith.
-Intros. Absurd (Zodd (POS (xO p))); Red; Auto with arith.
-Intros. Absurd `(NEG p) >= 0`; Red; Auto with arith.
+intro x; destruct x.
+intros. absurd (Zodd 0); red in |- *; auto with arith.
+destruct p; auto with arith.
+intros. absurd (Zodd (Zpos (xO p))); red in |- *; auto with arith.
+intros. absurd (Zneg p >= 0)%Z; red in |- *; auto with arith.
Qed.
-Lemma Zodd_div2_neg : (x:Z) `x <= 0` -> (Zodd x) -> `x = 2*(Zdiv2 x)-1`.
+Lemma Zodd_div2_neg :
+ forall n:Z, (n <= 0)%Z -> Zodd n -> n = (2 * Zdiv2 n - 1)%Z.
Proof.
-Intro x; NewDestruct x.
-Intros. Absurd (Zodd `0`); Red; Auto with arith.
-Intros. Absurd `(NEG p) >= 0`; Red; Auto with arith.
-NewDestruct p; Auto with arith.
-Intros. Absurd (Zodd (NEG (xO p))); Red; Auto with arith.
+intro x; destruct x.
+intros. absurd (Zodd 0); red in |- *; auto with arith.
+intros. absurd (Zneg p >= 0)%Z; red in |- *; auto with arith.
+destruct p; auto with arith.
+intros. absurd (Zodd (Zneg (xO p))); red in |- *; auto with arith.
Qed.
-Lemma Z_modulo_2 : (x:Z) { y:Z | `x=2*y` }+{ y:Z | `x=2*y+1` }.
+Lemma Z_modulo_2 :
+ forall n:Z, {y : Z | n = (2 * y)%Z} + {y : Z | n = (2 * y + 1)%Z}.
Proof.
-Intros x.
-Elim (Zeven_odd_dec x); Intro.
-Left. Split with (Zdiv2 x). Exact (Zeven_div2 x a).
-Right. Generalize b; Clear b; Case x.
-Intro b; Inversion b.
-Intro p; Split with (Zdiv2 (POS p)). Apply (Zodd_div2 (POS p)); Trivial.
-Unfold Zge Zcompare; Simpl; Discriminate.
-Intro p; Split with (Zdiv2 (Zpred (NEG p))).
-Pattern 1 (NEG p); Rewrite (Zs_pred (NEG p)).
-Pattern 1 (Zpred (NEG p)); Rewrite (Zeven_div2 (Zpred (NEG p))).
-Reflexivity.
-Apply Zeven_pred; Assumption.
+intros x.
+elim (Zeven_odd_dec x); intro.
+left. split with (Zdiv2 x). exact (Zeven_div2 x a).
+right. generalize b; clear b; case x.
+intro b; inversion b.
+intro p; split with (Zdiv2 (Zpos p)). apply (Zodd_div2 (Zpos p)); trivial.
+unfold Zge, Zcompare in |- *; simpl in |- *; discriminate.
+intro p; split with (Zdiv2 (Zpred (Zneg p))).
+pattern (Zneg p) at 1 in |- *; rewrite (Zsucc_pred (Zneg p)).
+pattern (Zpred (Zneg p)) at 1 in |- *; rewrite (Zeven_div2 (Zpred (Zneg p))).
+reflexivity.
+apply Zeven_pred; assumption.
Qed.
-Lemma Zsplit2 : (x:Z) { p : Z*Z | let (x1,x2)=p in (`x=x1+x2` /\ (x1=x2 \/ `x2=x1+1`)) }.
+Lemma Zsplit2 :
+ forall n:Z,
+ {p : Z * Z |
+ let (x1, x2) := p in n = (x1 + x2)%Z /\ (x1 = x2 \/ x2 = (x1 + 1)%Z)}.
Proof.
-Intros x.
-Elim (Z_modulo_2 x); Intros (y,Hy); Rewrite Zmult_sym in Hy; Rewrite <- Zplus_Zmult_2 in Hy.
-Exists (y,y); Split.
-Assumption.
-Left; Reflexivity.
-Exists (y,`y+1`); Split.
-Rewrite Zplus_assoc; Assumption.
-Right; Reflexivity.
-Qed.
+intros x.
+elim (Z_modulo_2 x); intros [y Hy]; rewrite Zmult_comm in Hy;
+ rewrite <- Zplus_diag_eq_mult_2 in Hy.
+exists (y, y); split.
+assumption.
+left; reflexivity.
+exists (y, (y + 1)%Z); split.
+rewrite Zplus_assoc; assumption.
+right; reflexivity.
+Qed. \ No newline at end of file
diff --git a/theories/ZArith/Zhints.v b/theories/ZArith/Zhints.v
index 6eb668a5a..5cce66fc5 100644
--- a/theories/ZArith/Zhints.v
+++ b/theories/ZArith/Zhints.v
@@ -27,81 +27,80 @@
(* Lemmas involving positive and compare are not taken into account *)
-Require BinInt.
-Require Zorder.
-Require Zmin.
-Require Zabs.
-Require Zcompare.
-Require Znat.
-Require auxiliary.
-Require Zsyntax.
-Require Zmisc.
-Require Wf_Z.
+Require Import BinInt.
+Require Import Zorder.
+Require Import Zmin.
+Require Import Zabs.
+Require Import Zcompare.
+Require Import Znat.
+Require Import auxiliary.
+Require Import Zmisc.
+Require Import Wf_Z.
(**********************************************************************)
(* Simplification lemmas *)
(* No subgoal or smaller subgoals *)
-Hints Resolve
+Hint Resolve
(* A) Reversible simplification lemmas (no loss of information) *)
(* Should clearly declared as hints *)
(* Lemmas ending by eq *)
- Zeq_S (* :(n,m:Z)`n = m`->`(Zs n) = (Zs m)` *)
+ Zsucc_eq_compat (* :(n,m:Z)`n = m`->`(Zs n) = (Zs m)` *)
(* Lemmas ending by Zgt *)
- Zgt_n_S (* :(n,m:Z)`m > n`->`(Zs m) > (Zs n)` *)
- Zgt_Sn_n (* :(n:Z)`(Zs n) > n` *)
- POS_gt_ZERO (* :(p:positive)`(POS p) > 0` *)
- Zgt_reg_l (* :(n,m,p:Z)`n > m`->`p+n > p+m` *)
- Zgt_reg_r (* :(n,m,p:Z)`n > m`->`n+p > m+p` *)
+ Zsucc_gt_compat (* :(n,m:Z)`m > n`->`(Zs m) > (Zs n)` *)
+ Zgt_succ (* :(n:Z)`(Zs n) > n` *)
+ Zorder.Zgt_pos_0 (* :(p:positive)`(POS p) > 0` *)
+ Zplus_gt_compat_l (* :(n,m,p:Z)`n > m`->`p+n > p+m` *)
+ Zplus_gt_compat_r (* :(n,m,p:Z)`n > m`->`n+p > m+p` *)
(* Lemmas ending by Zlt *)
- Zlt_n_Sn (* :(n:Z)`n < (Zs n)` *)
- Zlt_n_S (* :(n,m:Z)`n < m`->`(Zs n) < (Zs m)` *)
- Zlt_pred_n_n (* :(n:Z)`(Zpred n) < n` *)
- Zlt_reg_l (* :(n,m,p:Z)`n < m`->`p+n < p+m` *)
- Zlt_reg_r (* :(n,m,p:Z)`n < m`->`n+p < m+p` *)
+ Zlt_succ (* :(n:Z)`n < (Zs n)` *)
+ Zsucc_lt_compat (* :(n,m:Z)`n < m`->`(Zs n) < (Zs m)` *)
+ Zlt_pred (* :(n:Z)`(Zpred n) < n` *)
+ Zplus_lt_compat_l (* :(n,m,p:Z)`n < m`->`p+n < p+m` *)
+ Zplus_lt_compat_r (* :(n,m,p:Z)`n < m`->`n+p < m+p` *)
(* Lemmas ending by Zle *)
- ZERO_le_inj (* :(n:nat)`0 <= (inject_nat n)` *)
- ZERO_le_POS (* :(p:positive)`0 <= (POS p)` *)
- Zle_n (* :(n:Z)`n <= n` *)
- Zle_n_Sn (* :(n:Z)`n <= (Zs n)` *)
- Zle_n_S (* :(n,m:Z)`m <= n`->`(Zs m) <= (Zs n)` *)
- Zle_pred_n (* :(n:Z)`(Zpred n) <= n` *)
+ Zle_0_nat (* :(n:nat)`0 <= (inject_nat n)` *)
+ Zorder.Zle_0_pos (* :(p:positive)`0 <= (POS p)` *)
+ Zle_refl (* :(n:Z)`n <= n` *)
+ Zle_succ (* :(n:Z)`n <= (Zs n)` *)
+ Zsucc_le_compat (* :(n,m:Z)`m <= n`->`(Zs m) <= (Zs n)` *)
+ Zle_pred (* :(n:Z)`(Zpred n) <= n` *)
Zle_min_l (* :(n,m:Z)`(Zmin n m) <= n` *)
Zle_min_r (* :(n,m:Z)`(Zmin n m) <= m` *)
- Zle_reg_l (* :(n,m,p:Z)`n <= m`->`p+n <= p+m` *)
- Zle_reg_r (* :(a,b,c:Z)`a <= b`->`a+c <= b+c` *)
+ Zplus_le_compat_l (* :(n,m,p:Z)`n <= m`->`p+n <= p+m` *)
+ Zplus_le_compat_r (* :(a,b,c:Z)`a <= b`->`a+c <= b+c` *)
Zabs_pos (* :(x:Z)`0 <= |x|` *)
(* B) Irreversible simplification lemmas : Probably to be declared as *)
(* hints, when no other simplification is possible *)
(* Lemmas ending by eq *)
- Z_eq_mult (* :(x,y:Z)`y = 0`->`y*x = 0` *)
- Zplus_simpl (* :(n,m,p,q:Z)`n = m`->`p = q`->`n+p = m+q` *)
+ BinInt.Z_eq_mult (* :(x,y:Z)`y = 0`->`y*x = 0` *)
+ Zplus_eq_compat (* :(n,m,p,q:Z)`n = m`->`p = q`->`n+p = m+q` *)
(* Lemmas ending by Zge *)
- Zge_Zmult_pos_right (* :(a,b,c:Z)`a >= b`->`c >= 0`->`a*c >= b*c` *)
- Zge_Zmult_pos_left (* :(a,b,c:Z)`a >= b`->`c >= 0`->`c*a >= c*b` *)
- Zge_Zmult_pos_compat (* :
- (a,b,c,d:Z)`a >= c`->`b >= d`->`c >= 0`->`d >= 0`->`a*b >= c*d` *)
+ Zorder.Zmult_ge_compat_r (* :(a,b,c:Z)`a >= b`->`c >= 0`->`a*c >= b*c` *)
+ Zorder.Zmult_ge_compat_l (* :(a,b,c:Z)`a >= b`->`c >= 0`->`c*a >= c*b` *)
+ Zorder.Zmult_ge_compat (* :
+ (a,b,c,d:Z)`a >= c`->`b >= d`->`c >= 0`->`d >= 0`->`a*b >= c*d` *)
(* Lemmas ending by Zlt *)
- Zgt_ZERO_mult (* :(a,b:Z)`a > 0`->`b > 0`->`a*b > 0` *)
- Zlt_S (* :(n,m:Z)`n < m`->`n < (Zs m)` *)
+ Zorder.Zmult_gt_0_compat (* :(a,b:Z)`a > 0`->`b > 0`->`a*b > 0` *)
+ Zlt_lt_succ (* :(n,m:Z)`n < m`->`n < (Zs m)` *)
(* Lemmas ending by Zle *)
- Zle_ZERO_mult (* :(x,y:Z)`0 <= x`->`0 <= y`->`0 <= x*y` *)
- Zle_Zmult_pos_right (* :(a,b,c:Z)`a <= b`->`0 <= c`->`a*c <= b*c` *)
- Zle_Zmult_pos_left (* :(a,b,c:Z)`a <= b`->`0 <= c`->`c*a <= c*b` *)
- OMEGA2 (* :(x,y:Z)`0 <= x`->`0 <= y`->`0 <= x+y` *)
- Zle_le_S (* :(x,y:Z)`x <= y`->`x <= (Zs y)` *)
- Zle_plus_plus (* :(n,m,p,q:Z)`n <= m`->`p <= q`->`n+p <= m+q` *)
-
-: zarith.
+ Zorder.Zmult_le_0_compat (* :(x,y:Z)`0 <= x`->`0 <= y`->`0 <= x*y` *)
+ Zorder.Zmult_le_compat_r (* :(a,b,c:Z)`a <= b`->`0 <= c`->`a*c <= b*c` *)
+ Zorder.Zmult_le_compat_l (* :(a,b,c:Z)`a <= b`->`0 <= c`->`c*a <= c*b` *)
+ Zplus_le_0_compat (* :(x,y:Z)`0 <= x`->`0 <= y`->`0 <= x+y` *)
+ Zle_le_succ (* :(x,y:Z)`x <= y`->`x <= (Zs y)` *)
+ Zplus_le_compat (* :(n,m,p,q:Z)`n <= m`->`p <= q`->`n+p <= m+q` *)
+
+ : zarith.
(**********************************************************************)
(* Reversible lemmas relating operators *)
@@ -384,4 +383,4 @@ inj_minus2: (x,y:nat)(gt y x)->`(inject_nat (minus x y)) = 0`
Zred_factor5: (x,y:Z)`x*0+y = y`
*)
-(*i*)
+(*i*) \ No newline at end of file
diff --git a/theories/ZArith/Zlogarithm.v b/theories/ZArith/Zlogarithm.v
index 2879fefe8..ba6d21c4d 100644
--- a/theories/ZArith/Zlogarithm.v
+++ b/theories/ZArith/Zlogarithm.v
@@ -20,161 +20,161 @@
- [Log_nearest]: [y= (Log_nearest x) iff 2^(y-1/2) < x <= 2^(y+1/2)]
i.e. [Log_nearest x] is the integer nearest from [Log x] *)
-Require ZArith_base.
-Require Omega.
-Require Zcomplements.
-Require Zpower.
-V7only [Import Z_scope.].
+Require Import ZArith_base.
+Require Import Omega.
+Require Import Zcomplements.
+Require Import Zpower.
Open Local Scope Z_scope.
Section Log_pos. (* Log of positive integers *)
(** First we build [log_inf] and [log_sup] *)
-Fixpoint log_inf [p:positive] : Z :=
- Cases p of
- xH => `0` (* 1 *)
- | (xO q) => (Zs (log_inf q)) (* 2n *)
- | (xI q) => (Zs (log_inf q)) (* 2n+1 *)
+Fixpoint log_inf (p:positive) : Z :=
+ match p with
+ | xH => 0 (* 1 *)
+ | xO q => Zsucc (log_inf q) (* 2n *)
+ | xI q => Zsucc (log_inf q) (* 2n+1 *)
end.
-Fixpoint log_sup [p:positive] : Z :=
- Cases p of
- xH => `0` (* 1 *)
- | (xO n) => (Zs (log_sup n)) (* 2n *)
- | (xI n) => (Zs (Zs (log_inf n))) (* 2n+1 *)
+Fixpoint log_sup (p:positive) : Z :=
+ match p with
+ | xH => 0 (* 1 *)
+ | xO n => Zsucc (log_sup n) (* 2n *)
+ | xI n => Zsucc (Zsucc (log_inf n)) (* 2n+1 *)
end.
-Hints Unfold log_inf log_sup.
+Hint Unfold log_inf log_sup.
(** Then we give the specifications of [log_inf] and [log_sup]
and prove their validity *)
(*i Hints Resolve ZERO_le_S : zarith. i*)
-Hints Resolve Zle_trans : zarith.
-
-Theorem log_inf_correct : (x:positive) ` 0 <= (log_inf x)` /\
- ` (two_p (log_inf x)) <= (POS x) < (two_p (Zs (log_inf x)))`.
-Induction x; Intros; Simpl;
-[ Elim H; Intros Hp HR; Clear H; Split;
- [ Auto with zarith
- | Conditional (Apply Zle_le_S; Trivial) Rewrite two_p_S with x:=(Zs (log_inf p));
- Conditional Trivial Rewrite two_p_S;
- Conditional Trivial Rewrite two_p_S in HR;
- Rewrite (POS_xI p); Omega ]
-| Elim H; Intros Hp HR; Clear H; Split;
- [ Auto with zarith
- | Conditional (Apply Zle_le_S; Trivial) Rewrite two_p_S with x:=(Zs (log_inf p));
- Conditional Trivial Rewrite two_p_S;
- Conditional Trivial Rewrite two_p_S in HR;
- Rewrite (POS_xO p); Omega ]
-| Unfold two_power_pos; Unfold shift_pos; Simpl; Omega
-].
+Hint Resolve Zle_trans: zarith.
+
+Theorem log_inf_correct :
+ forall x:positive,
+ 0 <= log_inf x /\ two_p (log_inf x) <= Zpos x < two_p (Zsucc (log_inf x)).
+simple induction x; intros; simpl in |- *;
+ [ elim H; intros Hp HR; clear H; split;
+ [ auto with zarith
+ | conditional apply Zle_le_succ; trivial rewrite
+ two_p_S with (x := Zsucc (log_inf p));
+ conditional trivial rewrite two_p_S;
+ conditional trivial rewrite two_p_S in HR; rewrite (BinInt.Zpos_xI p);
+ omega ]
+ | elim H; intros Hp HR; clear H; split;
+ [ auto with zarith
+ | conditional apply Zle_le_succ; trivial rewrite
+ two_p_S with (x := Zsucc (log_inf p));
+ conditional trivial rewrite two_p_S;
+ conditional trivial rewrite two_p_S in HR; rewrite (BinInt.Zpos_xO p);
+ omega ]
+ | unfold two_power_pos in |- *; unfold shift_pos in |- *; simpl in |- *;
+ omega ].
Qed.
-Definition log_inf_correct1 :=
- [p:positive](proj1 ? ? (log_inf_correct p)).
-Definition log_inf_correct2 :=
- [p:positive](proj2 ? ? (log_inf_correct p)).
+Definition log_inf_correct1 (p:positive) := proj1 (log_inf_correct p).
+Definition log_inf_correct2 (p:positive) := proj2 (log_inf_correct p).
Opaque log_inf_correct1 log_inf_correct2.
-Hints Resolve log_inf_correct1 log_inf_correct2 : zarith.
+Hint Resolve log_inf_correct1 log_inf_correct2: zarith.
-Lemma log_sup_correct1 : (p:positive)` 0 <= (log_sup p)`.
-Induction p; Intros; Simpl; Auto with zarith.
+Lemma log_sup_correct1 : forall p:positive, 0 <= log_sup p.
+simple induction p; intros; simpl in |- *; auto with zarith.
Qed.
(** For every [p], either [p] is a power of two and [(log_inf p)=(log_sup p)]
either [(log_sup p)=(log_inf p)+1] *)
-Theorem log_sup_log_inf : (p:positive)
- IF (POS p)=(two_p (log_inf p))
- then (POS p)=(two_p (log_sup p))
- else ` (log_sup p)=(Zs (log_inf p))`.
-
-Induction p; Intros;
-[ Elim H; Right; Simpl;
- Rewrite (two_p_S (log_inf p0) (log_inf_correct1 p0));
- Rewrite POS_xI; Unfold Zs; Omega
-| Elim H; Clear H; Intro Hif;
- [ Left; Simpl;
- Rewrite (two_p_S (log_inf p0) (log_inf_correct1 p0));
- Rewrite (two_p_S (log_sup p0) (log_sup_correct1 p0));
- Rewrite <- (proj1 ? ? Hif); Rewrite <- (proj2 ? ? Hif);
- Auto
- | Right; Simpl;
- Rewrite (two_p_S (log_inf p0) (log_inf_correct1 p0));
- Rewrite POS_xO; Unfold Zs; Omega ]
-| Left; Auto ].
+Theorem log_sup_log_inf :
+ forall p:positive,
+ IF Zpos p = two_p (log_inf p) then Zpos p = two_p (log_sup p)
+ else log_sup p = Zsucc (log_inf p).
+
+simple induction p; intros;
+ [ elim H; right; simpl in |- *;
+ rewrite (two_p_S (log_inf p0) (log_inf_correct1 p0));
+ rewrite BinInt.Zpos_xI; unfold Zsucc in |- *; omega
+ | elim H; clear H; intro Hif;
+ [ left; simpl in |- *;
+ rewrite (two_p_S (log_inf p0) (log_inf_correct1 p0));
+ rewrite (two_p_S (log_sup p0) (log_sup_correct1 p0));
+ rewrite <- (proj1 Hif); rewrite <- (proj2 Hif);
+ auto
+ | right; simpl in |- *;
+ rewrite (two_p_S (log_inf p0) (log_inf_correct1 p0));
+ rewrite BinInt.Zpos_xO; unfold Zsucc in |- *;
+ omega ]
+ | left; auto ].
Qed.
-Theorem log_sup_correct2 : (x:positive)
- ` (two_p (Zpred (log_sup x))) < (POS x) <= (two_p (log_sup x))`.
+Theorem log_sup_correct2 :
+ forall x:positive, two_p (Zpred (log_sup x)) < Zpos x <= two_p (log_sup x).
-Intro.
-Elim (log_sup_log_inf x).
+intro.
+elim (log_sup_log_inf x).
(* x is a power of two and [log_sup = log_inf] *)
-Intros (E1,E2); Rewrite E2.
-Split ; [ Apply two_p_pred; Apply log_sup_correct1 | Apply Zle_n ].
-Intros (E1,E2); Rewrite E2.
-Rewrite <- (Zpred_Sn (log_inf x)).
-Generalize (log_inf_correct2 x); Omega.
+intros [E1 E2]; rewrite E2.
+split; [ apply two_p_pred; apply log_sup_correct1 | apply Zle_refl ].
+intros [E1 E2]; rewrite E2.
+rewrite <- (Zpred_succ (log_inf x)).
+generalize (log_inf_correct2 x); omega.
Qed.
-Lemma log_inf_le_log_sup :
- (p:positive) `(log_inf p) <= (log_sup p)`.
-Induction p; Simpl; Intros; Omega.
+Lemma log_inf_le_log_sup : forall p:positive, log_inf p <= log_sup p.
+simple induction p; simpl in |- *; intros; omega.
Qed.
-Lemma log_sup_le_Slog_inf :
- (p:positive) `(log_sup p) <= (Zs (log_inf p))`.
-Induction p; Simpl; Intros; Omega.
+Lemma log_sup_le_Slog_inf : forall p:positive, log_sup p <= Zsucc (log_inf p).
+simple induction p; simpl in |- *; intros; omega.
Qed.
(** Now it's possible to specify and build the [Log] rounded to the nearest *)
-Fixpoint log_near[x:positive] : Z :=
- Cases x of
- xH => `0`
- | (xO xH) => `1`
- | (xI xH) => `2`
- | (xO y) => (Zs (log_near y))
- | (xI y) => (Zs (log_near y))
+Fixpoint log_near (x:positive) : Z :=
+ match x with
+ | xH => 0
+ | xO xH => 1
+ | xI xH => 2
+ | xO y => Zsucc (log_near y)
+ | xI y => Zsucc (log_near y)
end.
-Theorem log_near_correct1 : (p:positive)` 0 <= (log_near p)`.
-Induction p; Simpl; Intros;
-[Elim p0; Auto with zarith | Elim p0; Auto with zarith | Trivial with zarith ].
-Intros; Apply Zle_le_S.
-Generalize H0; Elim p1; Intros; Simpl;
- [ Assumption | Assumption | Apply ZERO_le_POS ].
-Intros; Apply Zle_le_S.
-Generalize H0; Elim p1; Intros; Simpl;
- [ Assumption | Assumption | Apply ZERO_le_POS ].
+Theorem log_near_correct1 : forall p:positive, 0 <= log_near p.
+simple induction p; simpl in |- *; intros;
+ [ elim p0; auto with zarith
+ | elim p0; auto with zarith
+ | trivial with zarith ].
+intros; apply Zle_le_succ.
+generalize H0; elim p1; intros; simpl in |- *;
+ [ assumption | assumption | apply Zorder.Zle_0_pos ].
+intros; apply Zle_le_succ.
+generalize H0; elim p1; intros; simpl in |- *;
+ [ assumption | assumption | apply Zorder.Zle_0_pos ].
Qed.
-Theorem log_near_correct2: (p:positive)
- (log_near p)=(log_inf p)
-\/(log_near p)=(log_sup p).
-Induction p.
-Intros p0 [Einf|Esup].
-Simpl. Rewrite Einf.
-Case p0; [Left | Left | Right]; Reflexivity.
-Simpl; Rewrite Esup.
-Elim (log_sup_log_inf p0).
-Generalize (log_inf_le_log_sup p0).
-Generalize (log_sup_le_Slog_inf p0).
-Case p0; Auto with zarith.
-Intros; Omega.
-Case p0; Intros; Auto with zarith.
-Intros p0 [Einf|Esup].
-Simpl.
-Repeat Rewrite Einf.
-Case p0; Intros; Auto with zarith.
-Simpl.
-Repeat Rewrite Esup.
-Case p0; Intros; Auto with zarith.
-Auto.
+Theorem log_near_correct2 :
+ forall p:positive, log_near p = log_inf p \/ log_near p = log_sup p.
+simple induction p.
+intros p0 [Einf| Esup].
+simpl in |- *. rewrite Einf.
+case p0; [ left | left | right ]; reflexivity.
+simpl in |- *; rewrite Esup.
+elim (log_sup_log_inf p0).
+generalize (log_inf_le_log_sup p0).
+generalize (log_sup_le_Slog_inf p0).
+case p0; auto with zarith.
+intros; omega.
+case p0; intros; auto with zarith.
+intros p0 [Einf| Esup].
+simpl in |- *.
+repeat rewrite Einf.
+case p0; intros; auto with zarith.
+simpl in |- *.
+repeat rewrite Esup.
+case p0; intros; auto with zarith.
+auto.
Qed.
(*i******************
@@ -205,61 +205,55 @@ Section divers.
(** Number of significative digits. *)
-Definition N_digits :=
- [x:Z]Cases x of
- (POS p) => (log_inf p)
- | (NEG p) => (log_inf p)
- | ZERO => `0`
- end.
-
-Lemma ZERO_le_N_digits : (x:Z) ` 0 <= (N_digits x)`.
-Induction x; Simpl;
-[ Apply Zle_n
-| Exact log_inf_correct1
-| Exact log_inf_correct1].
+Definition N_digits (x:Z) :=
+ match x with
+ | Zpos p => log_inf p
+ | Zneg p => log_inf p
+ | Z0 => 0
+ end.
+
+Lemma ZERO_le_N_digits : forall x:Z, 0 <= N_digits x.
+simple induction x; simpl in |- *;
+ [ apply Zle_refl | exact log_inf_correct1 | exact log_inf_correct1 ].
Qed.
-Lemma log_inf_shift_nat :
- (n:nat)(log_inf (shift_nat n xH))=(inject_nat n).
-Induction n; Intros;
-[ Try Trivial
-| Rewrite -> inj_S; Rewrite <- H; Reflexivity].
+Lemma log_inf_shift_nat : forall n:nat, log_inf (shift_nat n 1) = Z_of_nat n.
+simple induction n; intros;
+ [ try trivial | rewrite Znat.inj_S; rewrite <- H; reflexivity ].
Qed.
-Lemma log_sup_shift_nat :
- (n:nat)(log_sup (shift_nat n xH))=(inject_nat n).
-Induction n; Intros;
-[ Try Trivial
-| Rewrite -> inj_S; Rewrite <- H; Reflexivity].
+Lemma log_sup_shift_nat : forall n:nat, log_sup (shift_nat n 1) = Z_of_nat n.
+simple induction n; intros;
+ [ try trivial | rewrite Znat.inj_S; rewrite <- H; reflexivity ].
Qed.
(** [Is_power p] means that p is a power of two *)
-Fixpoint Is_power[p:positive] : Prop :=
- Cases p of
- xH => True
- | (xO q) => (Is_power q)
- | (xI q) => False
+Fixpoint Is_power (p:positive) : Prop :=
+ match p with
+ | xH => True
+ | xO q => Is_power q
+ | xI q => False
end.
Lemma Is_power_correct :
- (p:positive) (Is_power p) <-> (Ex [y:nat](p=(shift_nat y xH))).
-
-Split;
-[ Elim p;
- [ Simpl; Tauto
- | Simpl; Intros; Generalize (H H0); Intro H1; Elim H1; Intros y0 Hy0;
- Exists (S y0); Rewrite Hy0; Reflexivity
- | Intro; Exists O; Reflexivity]
-| Intros; Elim H; Intros; Rewrite -> H0; Elim x; Intros; Simpl; Trivial].
+ forall p:positive, Is_power p <-> ( exists y : nat | p = shift_nat y 1).
+
+split;
+ [ elim p;
+ [ simpl in |- *; tauto
+ | simpl in |- *; intros; generalize (H H0); intro H1; elim H1;
+ intros y0 Hy0; exists (S y0); rewrite Hy0; reflexivity
+ | intro; exists 0%nat; reflexivity ]
+ | intros; elim H; intros; rewrite H0; elim x; intros; simpl in |- *; trivial ].
Qed.
-Lemma Is_power_or : (p:positive) (Is_power p)\/~(Is_power p).
-Induction p;
-[ Intros; Right; Simpl; Tauto
-| Intros; Elim H;
- [ Intros; Left; Simpl; Exact H0
- | Intros; Right; Simpl; Exact H0]
-| Left; Simpl; Trivial].
+Lemma Is_power_or : forall p:positive, Is_power p \/ ~ Is_power p.
+simple induction p;
+ [ intros; right; simpl in |- *; tauto
+ | intros; elim H;
+ [ intros; left; simpl in |- *; exact H0
+ | intros; right; simpl in |- *; exact H0 ]
+ | left; simpl in |- *; trivial ].
Qed.
End divers.
@@ -269,4 +263,3 @@ End divers.
-
diff --git a/theories/ZArith/Zmin.v b/theories/ZArith/Zmin.v
index 01192c3bc..deab63392 100644
--- a/theories/ZArith/Zmin.v
+++ b/theories/ZArith/Zmin.v
@@ -9,94 +9,98 @@
(** Binary Integers (Pierre Crégut (CNET, Lannion, France) *)
-Require Arith.
-Require BinInt.
-Require Zcompare.
-Require Zorder.
+Require Import Arith.
+Require Import BinInt.
+Require Import Zcompare.
+Require Import Zorder.
Open Local Scope Z_scope.
(**********************************************************************)
(** Minimum on binary integer numbers *)
-Definition Zmin := [n,m:Z]
- <Z>Cases (Zcompare n m) of
- EGAL => n
- | INFERIEUR => n
- | SUPERIEUR => m
- end.
+Definition Zmin (n m:Z) :=
+ match n ?= m return Z with
+ | Eq => n
+ | Lt => n
+ | Gt => m
+ end.
(** Properties of minimum on binary integer numbers *)
-Lemma Zmin_SS : (n,m:Z)((Zs (Zmin n m))=(Zmin (Zs n) (Zs m))).
+Lemma Zmin_SS : forall n m:Z, Zsucc (Zmin n m) = Zmin (Zsucc n) (Zsucc m).
Proof.
-Intros n m;Unfold Zmin; Rewrite (Zcompare_n_S n m);
-(ElimCompare 'n 'm);Intros E;Rewrite E;Auto with arith.
+intros n m; unfold Zmin in |- *; rewrite (Zcompare_succ_compat n m);
+ elim_compare n m; intros E; rewrite E; auto with arith.
Qed.
-Lemma Zle_min_l : (n,m:Z)(Zle (Zmin n m) n).
+Lemma Zle_min_l : forall n m:Z, Zmin n m <= n.
Proof.
-Intros n m;Unfold Zmin ; (ElimCompare 'n 'm);Intros E;Rewrite -> E;
- [ Apply Zle_n | Apply Zle_n | Apply Zlt_le_weak; Apply Zgt_lt;Exact E ].
+intros n m; unfold Zmin in |- *; elim_compare n m; intros E; rewrite E;
+ [ apply Zle_refl
+ | apply Zle_refl
+ | apply Zlt_le_weak; apply Zgt_lt; exact E ].
Qed.
-Lemma Zle_min_r : (n,m:Z)(Zle (Zmin n m) m).
+Lemma Zle_min_r : forall n m:Z, Zmin n m <= m.
Proof.
-Intros n m;Unfold Zmin ; (ElimCompare 'n 'm);Intros E;Rewrite -> E;[
- Unfold Zle ;Rewrite -> E;Discriminate
-| Unfold Zle ;Rewrite -> E;Discriminate
-| Apply Zle_n ].
+intros n m; unfold Zmin in |- *; elim_compare n m; intros E; rewrite E;
+ [ unfold Zle in |- *; rewrite E; discriminate
+ | unfold Zle in |- *; rewrite E; discriminate
+ | apply Zle_refl ].
Qed.
-Lemma Zmin_case : (n,m:Z)(P:Z->Set)(P n)->(P m)->(P (Zmin n m)).
+Lemma Zmin_case : forall (n m:Z) (P:Z -> Set), P n -> P m -> P (Zmin n m).
Proof.
-Intros n m P H1 H2; Unfold Zmin; Case (Zcompare n m);Auto with arith.
+intros n m P H1 H2; unfold Zmin in |- *; case (n ?= m); auto with arith.
Qed.
-Lemma Zmin_or : (n,m:Z)(Zmin n m)=n \/ (Zmin n m)=m.
+Lemma Zmin_or : forall n m:Z, Zmin n m = n \/ Zmin n m = m.
Proof.
-Unfold Zmin; Intros; Elim (Zcompare n m); Auto.
+unfold Zmin in |- *; intros; elim (n ?= m); auto.
Qed.
-Lemma Zmin_n_n : (n:Z) (Zmin n n)=n.
+Lemma Zmin_n_n : forall n:Z, Zmin n n = n.
Proof.
-Unfold Zmin; Intros; Elim (Zcompare n n); Auto.
+unfold Zmin in |- *; intros; elim (n ?= n); auto.
Qed.
-Lemma Zmin_plus :
- (x,y,n:Z)(Zmin (Zplus x n) (Zplus y n))=(Zplus (Zmin x y) n).
+Lemma Zmin_plus : forall n m p:Z, Zmin (n + p) (m + p) = Zmin n m + p.
Proof.
-Intros x y n; Unfold Zmin.
-Rewrite (Zplus_sym x n);
-Rewrite (Zplus_sym y n);
-Rewrite (Zcompare_Zplus_compatible x y n).
-Case (Zcompare x y); Apply Zplus_sym.
+intros x y n; unfold Zmin in |- *.
+rewrite (Zplus_comm x n); rewrite (Zplus_comm y n);
+ rewrite (Zcompare_plus_compat x y n).
+case (x ?= y); apply Zplus_comm.
Qed.
(**********************************************************************)
(** Maximum of two binary integer numbers *)
-V7only [ (* From Zdivides *) ].
-Definition Zmax :=
- [a, b : ?] Cases (Zcompare a b) of INFERIEUR => b | _ => a end.
+Definition Zmax a b := match a ?= b with
+ | Lt => b
+ | _ => a
+ end.
(** Properties of maximum on binary integer numbers *)
-Tactic Definition CaseEq name :=
-Generalize (refl_equal ? name); Pattern -1 name; Case name.
+Ltac CaseEq name :=
+ generalize (refl_equal name); pattern name at -1 in |- *; case name.
-Theorem Zmax1: (a, b : ?) (Zle a (Zmax a b)).
+Theorem Zmax1 : forall a b, a <= Zmax a b.
Proof.
-Intros a b; Unfold Zmax; (CaseEq '(Zcompare a b)); Simpl; Auto with zarith.
-Unfold Zle; Intros H; Rewrite H; Red; Intros; Discriminate.
+intros a b; unfold Zmax in |- *; CaseEq (a ?= b); simpl in |- *;
+ auto with zarith.
+unfold Zle in |- *; intros H; rewrite H; red in |- *; intros; discriminate.
Qed.
-Theorem Zmax2: (a, b : ?) (Zle b (Zmax a b)).
+Theorem Zmax2 : forall a b, b <= Zmax a b.
Proof.
-Intros a b; Unfold Zmax; (CaseEq '(Zcompare a b)); Simpl; Auto with zarith.
-Intros H;
- (Case (Zle_or_lt b a); Auto; Unfold Zlt; Rewrite H; Intros; Discriminate).
-Intros H;
- (Case (Zle_or_lt b a); Auto; Unfold Zlt; Rewrite H; Intros; Discriminate).
+intros a b; unfold Zmax in |- *; CaseEq (a ?= b); simpl in |- *;
+ auto with zarith.
+intros H;
+ (case (Zle_or_lt b a); auto; unfold Zlt in |- *; rewrite H; intros;
+ discriminate).
+intros H;
+ (case (Zle_or_lt b a); auto; unfold Zlt in |- *; rewrite H; intros;
+ discriminate).
Qed.
-
diff --git a/theories/ZArith/Zmisc.v b/theories/ZArith/Zmisc.v
index a8bbcfc00..0ad0ef288 100644
--- a/theories/ZArith/Zmisc.v
+++ b/theories/ZArith/Zmisc.v
@@ -8,181 +8,90 @@
(*i $Id$ i*)
-Require BinInt.
-Require Zcompare.
-Require Zorder.
-Require Zsyntax.
-Require Bool.
-V7only [Import Z_scope.].
+Require Import BinInt.
+Require Import Zcompare.
+Require Import Zorder.
+Require Import Bool.
Open Local Scope Z_scope.
(**********************************************************************)
(** Iterators *)
(** [n]th iteration of the function [f] *)
-Fixpoint iter_nat[n:nat] : (A:Set)(f:A->A)A->A :=
- [A:Set][f:A->A][x:A]
- Cases n of
- O => x
- | (S n') => (f (iter_nat n' A f x))
- end.
+Fixpoint iter_nat (n:nat) (A:Set) (f:A -> A) (x:A) {struct n} : A :=
+ match n with
+ | O => x
+ | S n' => f (iter_nat n' A f x)
+ end.
-Fixpoint iter_pos[n:positive] : (A:Set)(f:A->A)A->A :=
- [A:Set][f:A->A][x:A]
- Cases n of
- xH => (f x)
- | (xO n') => (iter_pos n' A f (iter_pos n' A f x))
- | (xI n') => (f (iter_pos n' A f (iter_pos n' A f x)))
- end.
+Fixpoint iter_pos (n:positive) (A:Set) (f:A -> A) (x:A) {struct n} : A :=
+ match n with
+ | xH => f x
+ | xO n' => iter_pos n' A f (iter_pos n' A f x)
+ | xI n' => f (iter_pos n' A f (iter_pos n' A f x))
+ end.
-Definition iter :=
- [n:Z][A:Set][f:A->A][x:A]Cases n of
- ZERO => x
- | (POS p) => (iter_pos p A f x)
- | (NEG p) => x
+Definition iter (n:Z) (A:Set) (f:A -> A) (x:A) :=
+ match n with
+ | Z0 => x
+ | Zpos p => iter_pos p A f x
+ | Zneg p => x
end.
Theorem iter_nat_plus :
- (n,m:nat)(A:Set)(f:A->A)(x:A)
- (iter_nat (plus n m) A f x)=(iter_nat n A f (iter_nat m A f x)).
+ forall (n m:nat) (A:Set) (f:A -> A) (x:A),
+ iter_nat (n + m) A f x = iter_nat n A f (iter_nat m A f x).
Proof.
-Induction n;
-[ Simpl; Auto with arith
-| Intros; Simpl; Apply f_equal with f:=f; Apply H
-].
+simple induction n;
+ [ simpl in |- *; auto with arith
+ | intros; simpl in |- *; apply f_equal with (f := f); apply H ].
Qed.
-Theorem iter_convert : (n:positive)(A:Set)(f:A->A)(x:A)
- (iter_pos n A f x) = (iter_nat (convert n) A f x).
+Theorem iter_nat_of_P :
+ forall (p:positive) (A:Set) (f:A -> A) (x:A),
+ iter_pos p A f x = iter_nat (nat_of_P p) A f x.
Proof.
-Intro n; NewInduction n as [p H|p H|];
-[ Intros; Simpl; Rewrite -> (H A f x);
- Rewrite -> (H A f (iter_nat (convert p) A f x));
- Rewrite -> (ZL6 p); Symmetry; Apply f_equal with f:=f;
- Apply iter_nat_plus
-| Intros; Unfold convert; Simpl; Rewrite -> (H A f x);
- Rewrite -> (H A f (iter_nat (convert p) A f x));
- Rewrite -> (ZL6 p); Symmetry;
- Apply iter_nat_plus
-| Simpl; Auto with arith
-].
+intro n; induction n as [p H| p H| ];
+ [ intros; simpl in |- *; rewrite (H A f x);
+ rewrite (H A f (iter_nat (nat_of_P p) A f x));
+ rewrite (ZL6 p); symmetry in |- *; apply f_equal with (f := f);
+ apply iter_nat_plus
+ | intros; unfold nat_of_P in |- *; simpl in |- *; rewrite (H A f x);
+ rewrite (H A f (iter_nat (nat_of_P p) A f x));
+ rewrite (ZL6 p); symmetry in |- *; apply iter_nat_plus
+ | simpl in |- *; auto with arith ].
Qed.
-Theorem iter_pos_add :
- (n,m:positive)(A:Set)(f:A->A)(x:A)
- (iter_pos (add n m) A f x)=(iter_pos n A f (iter_pos m A f x)).
+Theorem iter_pos_plus :
+ forall (p q:positive) (A:Set) (f:A -> A) (x:A),
+ iter_pos (p + q) A f x = iter_pos p A f (iter_pos q A f x).
Proof.
-Intros n m; Intros.
-Rewrite -> (iter_convert m A f x).
-Rewrite -> (iter_convert n A f (iter_nat (convert m) A f x)).
-Rewrite -> (iter_convert (add n m) A f x).
-Rewrite -> (convert_add n m).
-Apply iter_nat_plus.
+intros n m; intros.
+rewrite (iter_nat_of_P m A f x).
+rewrite (iter_nat_of_P n A f (iter_nat (nat_of_P m) A f x)).
+rewrite (iter_nat_of_P (n + m) A f x).
+rewrite (nat_of_P_plus_morphism n m).
+apply iter_nat_plus.
Qed.
(** Preservation of invariants : if [f : A->A] preserves the invariant [Inv],
then the iterates of [f] also preserve it. *)
Theorem iter_nat_invariant :
- (n:nat)(A:Set)(f:A->A)(Inv:A->Prop)
- ((x:A)(Inv x)->(Inv (f x)))->(x:A)(Inv x)->(Inv (iter_nat n A f x)).
+ forall (n:nat) (A:Set) (f:A -> A) (Inv:A -> Prop),
+ (forall x:A, Inv x -> Inv (f x)) ->
+ forall x:A, Inv x -> Inv (iter_nat n A f x).
Proof.
-Induction n; Intros;
-[ Trivial with arith
-| Simpl; Apply H0 with x:=(iter_nat n0 A f x); Apply H; Trivial with arith].
+simple induction n; intros;
+ [ trivial with arith
+ | simpl in |- *; apply H0 with (x := iter_nat n0 A f x); apply H;
+ trivial with arith ].
Qed.
Theorem iter_pos_invariant :
- (n:positive)(A:Set)(f:A->A)(Inv:A->Prop)
- ((x:A)(Inv x)->(Inv (f x)))->(x:A)(Inv x)->(Inv (iter_pos n A f x)).
+ forall (p:positive) (A:Set) (f:A -> A) (Inv:A -> Prop),
+ (forall x:A, Inv x -> Inv (f x)) ->
+ forall x:A, Inv x -> Inv (iter_pos p A f x).
Proof.
-Intros; Rewrite iter_convert; Apply iter_nat_invariant; Trivial with arith.
+intros; rewrite iter_nat_of_P; apply iter_nat_invariant; trivial with arith.
Qed.
-
-V7only [
-(* Compatibility *)
-Require Zbool.
-Require Zeven.
-Require Zabs.
-Require Zmin.
-Notation rename := rename.
-Notation POS_xI := POS_xI.
-Notation POS_xO := POS_xO.
-Notation NEG_xI := NEG_xI.
-Notation NEG_xO := NEG_xO.
-Notation POS_add := POS_add.
-Notation NEG_add := NEG_add.
-Notation Zle_cases := Zle_cases.
-Notation Zlt_cases := Zlt_cases.
-Notation Zge_cases := Zge_cases.
-Notation Zgt_cases := Zgt_cases.
-Notation POS_gt_ZERO := POS_gt_ZERO.
-Notation ZERO_le_POS := ZERO_le_POS.
-Notation Zlt_ZERO_pred_le_ZERO := Zlt_ZERO_pred_le_ZERO.
-Notation NEG_lt_ZERO := NEG_lt_ZERO.
-Notation Zeven_not_Zodd := Zeven_not_Zodd.
-Notation Zodd_not_Zeven := Zodd_not_Zeven.
-Notation Zeven_Sn := Zeven_Sn.
-Notation Zodd_Sn := Zodd_Sn.
-Notation Zeven_pred := Zeven_pred.
-Notation Zodd_pred := Zodd_pred.
-Notation Zeven_div2 := Zeven_div2.
-Notation Zodd_div2 := Zodd_div2.
-Notation Zodd_div2_neg := Zodd_div2_neg.
-Notation Z_modulo_2 := Z_modulo_2.
-Notation Zsplit2 := Zsplit2.
-Notation Zminus_Zplus_compatible := Zminus_Zplus_compatible.
-Notation Zcompare_egal_dec := Zcompare_egal_dec.
-Notation Zcompare_elim := Zcompare_elim.
-Notation Zcompare_x_x := Zcompare_x_x.
-Notation Zlt_not_eq := Zlt_not_eq.
-Notation Zcompare_eq_case := Zcompare_eq_case.
-Notation Zle_Zcompare := Zle_Zcompare.
-Notation Zlt_Zcompare := Zlt_Zcompare.
-Notation Zge_Zcompare := Zge_Zcompare.
-Notation Zgt_Zcompare := Zgt_Zcompare.
-Notation Zmin_plus := Zmin_plus.
-Notation absolu_lt := absolu_lt.
-Notation Zle_bool_imp_le := Zle_bool_imp_le.
-Notation Zle_imp_le_bool := Zle_imp_le_bool.
-Notation Zle_bool_refl := Zle_bool_refl.
-Notation Zle_bool_antisym := Zle_bool_antisym.
-Notation Zle_bool_trans := Zle_bool_trans.
-Notation Zle_bool_plus_mono := Zle_bool_plus_mono.
-Notation Zone_pos := Zone_pos.
-Notation Zone_min_pos := Zone_min_pos.
-Notation Zle_is_le_bool := Zle_is_le_bool.
-Notation Zge_is_le_bool := Zge_is_le_bool.
-Notation Zlt_is_le_bool := Zlt_is_le_bool.
-Notation Zgt_is_le_bool := Zgt_is_le_bool.
-Notation Zle_plus_swap := Zle_plus_swap.
-Notation Zge_iff_le := Zge_iff_le.
-Notation Zlt_plus_swap := Zlt_plus_swap.
-Notation Zgt_iff_lt := Zgt_iff_lt.
-Notation Zeq_plus_swap := Zeq_plus_swap.
-(* Definitions *)
-Notation entier_of_Z := entier_of_Z.
-Notation Z_of_entier := Z_of_entier.
-Notation Zle_bool := Zle_bool.
-Notation Zge_bool := Zge_bool.
-Notation Zlt_bool := Zlt_bool.
-Notation Zgt_bool := Zgt_bool.
-Notation Zeq_bool := Zeq_bool.
-Notation Zneq_bool := Zneq_bool.
-Notation Zeven := Zeven.
-Notation Zodd := Zodd.
-Notation Zeven_bool := Zeven_bool.
-Notation Zodd_bool := Zodd_bool.
-Notation Zeven_odd_dec := Zeven_odd_dec.
-Notation Zeven_dec := Zeven_dec.
-Notation Zodd_dec := Zodd_dec.
-Notation Zdiv2_pos := Zdiv2_pos.
-Notation Zdiv2 := Zdiv2.
-Notation Zle_bool_total := Zle_bool_total.
-Export Zbool.
-Export Zeven.
-Export Zabs.
-Export Zmin.
-Export Zorder.
-Export Zcompare.
-].
diff --git a/theories/ZArith/Znat.v b/theories/ZArith/Znat.v
index fe53fce90..d9bc4d1b2 100644
--- a/theories/ZArith/Znat.v
+++ b/theories/ZArith/Znat.v
@@ -11,128 +11,128 @@
(** Binary Integers (Pierre Crégut, CNET, Lannion, France) *)
Require Export Arith.
-Require BinPos.
-Require BinInt.
-Require Zcompare.
-Require Zorder.
-Require Decidable.
-Require Peano_dec.
+Require Import BinPos.
+Require Import BinInt.
+Require Import Zcompare.
+Require Import Zorder.
+Require Import Decidable.
+Require Import Peano_dec.
Require Export Compare_dec.
Open Local Scope Z_scope.
-Definition neq := [x,y:nat] ~(x=y).
+Definition neq (x y:nat) := x <> y.
(**********************************************************************)
(** Properties of the injection from nat into Z *)
-Theorem inj_S : (y:nat) (inject_nat (S y)) = (Zs (inject_nat y)).
+Theorem inj_S : forall n:nat, Z_of_nat (S n) = Zsucc (Z_of_nat n).
Proof.
-Intro y; NewInduction y as [|n H]; [
- Unfold Zs ; Simpl; Trivial with arith
-| Change (POS (add_un (anti_convert n)))=(Zs (inject_nat (S n)));
- Rewrite add_un_Zs; Trivial with arith].
+intro y; induction y as [| n H];
+ [ unfold Zsucc in |- *; simpl in |- *; trivial with arith
+ | change (Zpos (Psucc (P_of_succ_nat n)) = Zsucc (Z_of_nat (S n))) in |- *;
+ rewrite Zpos_succ_morphism; trivial with arith ].
Qed.
-Theorem inj_plus :
- (x,y:nat) (inject_nat (plus x y)) = (Zplus (inject_nat x) (inject_nat y)).
+Theorem inj_plus : forall n m:nat, Z_of_nat (n + m) = Z_of_nat n + Z_of_nat m.
Proof.
-Intro x; NewInduction x as [|n H]; Intro y; NewDestruct y as [|m]; [
- Simpl; Trivial with arith
-| Simpl; Trivial with arith
-| Simpl; Rewrite <- plus_n_O; Trivial with arith
-| Change (inject_nat (S (plus n (S m))))=
- (Zplus (inject_nat (S n)) (inject_nat (S m)));
- Rewrite inj_S; Rewrite H; Do 2 Rewrite inj_S; Rewrite Zplus_S_n; Trivial with arith].
+intro x; induction x as [| n H]; intro y; destruct y as [| m];
+ [ simpl in |- *; trivial with arith
+ | simpl in |- *; trivial with arith
+ | simpl in |- *; rewrite <- plus_n_O; trivial with arith
+ | change (Z_of_nat (S (n + S m)) = Z_of_nat (S n) + Z_of_nat (S m)) in |- *;
+ rewrite inj_S; rewrite H; do 2 rewrite inj_S; rewrite Zplus_succ_l;
+ trivial with arith ].
Qed.
-Theorem inj_mult :
- (x,y:nat) (inject_nat (mult x y)) = (Zmult (inject_nat x) (inject_nat y)).
+Theorem inj_mult : forall n m:nat, Z_of_nat (n * m) = Z_of_nat n * Z_of_nat m.
Proof.
-Intro x; NewInduction x as [|n H]; [
- Simpl; Trivial with arith
-| Intro y; Rewrite -> inj_S; Rewrite <- Zmult_Sm_n;
- Rewrite <- H;Rewrite <- inj_plus; Simpl; Rewrite plus_sym; Trivial with arith].
+intro x; induction x as [| n H];
+ [ simpl in |- *; trivial with arith
+ | intro y; rewrite inj_S; rewrite <- Zmult_succ_l_reverse; rewrite <- H;
+ rewrite <- inj_plus; simpl in |- *; rewrite plus_comm;
+ trivial with arith ].
Qed.
-Theorem inj_neq:
- (x,y:nat) (neq x y) -> (Zne (inject_nat x) (inject_nat y)).
+Theorem inj_neq : forall n m:nat, neq n m -> Zne (Z_of_nat n) (Z_of_nat m).
Proof.
-Unfold neq Zne not ; Intros x y H1 H2; Apply H1; Generalize H2;
-Case x; Case y; Intros; [
- Auto with arith
-| Discriminate H0
-| Discriminate H0
-| Simpl in H0; Injection H0; Do 2 Rewrite <- bij1; Intros E; Rewrite E; Auto with arith].
+unfold neq, Zne, not in |- *; intros x y H1 H2; apply H1; generalize H2;
+ case x; case y; intros;
+ [ auto with arith
+ | discriminate H0
+ | discriminate H0
+ | simpl in H0; injection H0;
+ do 2 rewrite <- nat_of_P_o_P_of_succ_nat_eq_succ;
+ intros E; rewrite E; auto with arith ].
Qed.
-Theorem inj_le:
- (x,y:nat) (le x y) -> (Zle (inject_nat x) (inject_nat y)).
+Theorem inj_le : forall n m:nat, (n <= m)%nat -> Z_of_nat n <= Z_of_nat m.
Proof.
-Intros x y; Intros H; Elim H; [
- Unfold Zle ; Elim (Zcompare_EGAL (inject_nat x) (inject_nat x));
- Intros H1 H2; Rewrite H2; [ Discriminate | Trivial with arith]
-| Intros m H1 H2; Apply Zle_trans with (inject_nat m);
- [Assumption | Rewrite inj_S; Apply Zle_n_Sn]].
+intros x y; intros H; elim H;
+ [ unfold Zle in |- *; elim (Zcompare_Eq_iff_eq (Z_of_nat x) (Z_of_nat x));
+ intros H1 H2; rewrite H2; [ discriminate | trivial with arith ]
+ | intros m H1 H2; apply Zle_trans with (Z_of_nat m);
+ [ assumption | rewrite inj_S; apply Zle_succ ] ].
Qed.
-Theorem inj_lt: (x,y:nat) (lt x y) -> (Zlt (inject_nat x) (inject_nat y)).
+Theorem inj_lt : forall n m:nat, (n < m)%nat -> Z_of_nat n < Z_of_nat m.
Proof.
-Intros x y H; Apply Zgt_lt; Apply Zle_S_gt; Rewrite <- inj_S; Apply inj_le;
-Exact H.
+intros x y H; apply Zgt_lt; apply Zlt_succ_gt; rewrite <- inj_S; apply inj_le;
+ exact H.
Qed.
-Theorem inj_gt: (x,y:nat) (gt x y) -> (Zgt (inject_nat x) (inject_nat y)).
+Theorem inj_gt : forall n m:nat, (n > m)%nat -> Z_of_nat n > Z_of_nat m.
Proof.
-Intros x y H; Apply Zlt_gt; Apply inj_lt; Exact H.
+intros x y H; apply Zlt_gt; apply inj_lt; exact H.
Qed.
-Theorem inj_ge: (x,y:nat) (ge x y) -> (Zge (inject_nat x) (inject_nat y)).
+Theorem inj_ge : forall n m:nat, (n >= m)%nat -> Z_of_nat n >= Z_of_nat m.
Proof.
-Intros x y H; Apply Zle_ge; Apply inj_le; Apply H.
+intros x y H; apply Zle_ge; apply inj_le; apply H.
Qed.
-Theorem inj_eq: (x,y:nat) x=y -> (inject_nat x) = (inject_nat y).
+Theorem inj_eq : forall n m:nat, n = m -> Z_of_nat n = Z_of_nat m.
Proof.
-Intros x y H; Rewrite H; Trivial with arith.
+intros x y H; rewrite H; trivial with arith.
Qed.
-Theorem intro_Z :
- (x:nat) (EX y:Z | (inject_nat x)=y /\
- (Zle ZERO (Zplus (Zmult y (POS xH)) ZERO))).
+Theorem intro_Z :
+ forall n:nat, exists y : Z | Z_of_nat n = y /\ 0 <= y * 1 + 0.
Proof.
-Intros x; Exists (inject_nat x); Split; [
- Trivial with arith
-| Rewrite Zmult_sym; Rewrite Zmult_one; Rewrite Zero_right;
- Unfold Zle ; Elim x; Intros;Simpl; Discriminate ].
+intros x; exists (Z_of_nat x); split;
+ [ trivial with arith
+ | rewrite Zmult_comm; rewrite Zmult_1_l; rewrite Zplus_0_r;
+ unfold Zle in |- *; elim x; intros; simpl in |- *;
+ discriminate ].
Qed.
Theorem inj_minus1 :
- (x,y:nat) (le y x) ->
- (inject_nat (minus x y)) = (Zminus (inject_nat x) (inject_nat y)).
+ forall n m:nat, (m <= n)%nat -> Z_of_nat (n - m) = Z_of_nat n - Z_of_nat m.
Proof.
-Intros x y H; Apply (Zsimpl_plus_l (inject_nat y)); Unfold Zminus ;
-Rewrite Zplus_permute; Rewrite Zplus_inverse_r; Rewrite <- inj_plus;
-Rewrite <- (le_plus_minus y x H);Rewrite Zero_right; Trivial with arith.
+intros x y H; apply (Zplus_reg_l (Z_of_nat y)); unfold Zminus in |- *;
+ rewrite Zplus_permute; rewrite Zplus_opp_r; rewrite <- inj_plus;
+ rewrite <- (le_plus_minus y x H); rewrite Zplus_0_r;
+ trivial with arith.
Qed.
-Theorem inj_minus2: (x,y:nat) (gt y x) -> (inject_nat (minus x y)) = ZERO.
+Theorem inj_minus2 : forall n m:nat, (m > n)%nat -> Z_of_nat (n - m) = 0.
Proof.
-Intros x y H; Rewrite inj_minus_aux; [ Trivial with arith | Apply gt_not_le; Assumption].
+intros x y H; rewrite not_le_minus_0;
+ [ trivial with arith | apply gt_not_le; assumption ].
Qed.
-V7only [ (* From Zdivides *) ].
-Theorem POS_inject: (x : positive) (POS x) = (inject_nat (convert x)).
+Theorem Zpos_eq_Z_of_nat_o_nat_of_P :
+ forall p:positive, Zpos p = Z_of_nat (nat_of_P p).
Proof.
-Intros x; Elim x; Simpl; Auto.
-Intros p H; Rewrite ZL6.
-Apply f_equal with f := POS.
-Apply convert_intro.
-Rewrite bij1; Unfold convert; Simpl.
-Rewrite ZL6; Auto.
-Intros p H; Unfold convert; Simpl.
-Rewrite ZL6; Simpl.
-Rewrite inj_plus; Repeat Rewrite <- H.
-Rewrite POS_xO; Simpl; Rewrite add_x_x; Reflexivity.
+intros x; elim x; simpl in |- *; auto.
+intros p H; rewrite ZL6.
+apply f_equal with (f := Zpos).
+apply nat_of_P_inj.
+rewrite nat_of_P_o_P_of_succ_nat_eq_succ; unfold nat_of_P in |- *;
+ simpl in |- *.
+rewrite ZL6; auto.
+intros p H; unfold nat_of_P in |- *; simpl in |- *.
+rewrite ZL6; simpl in |- *.
+rewrite inj_plus; repeat rewrite <- H.
+rewrite Zpos_xO; simpl in |- *; rewrite Pplus_diag; reflexivity.
Qed.
-
diff --git a/theories/ZArith/Znumtheory.v b/theories/ZArith/Znumtheory.v
index dfe1c31fd..ed6272c44 100644
--- a/theories/ZArith/Znumtheory.v
+++ b/theories/ZArith/Znumtheory.v
@@ -8,11 +8,10 @@
(*i $Id$ i*)
-Require ZArith_base.
-Require ZArithRing.
-Require Zcomplements.
-Require Zdiv.
-V7only [Import Z_scope.].
+Require Import ZArith_base.
+Require Import ZArithRing.
+Require Import Zcomplements.
+Require Import Zdiv.
Open Local Scope Z_scope.
(** This file contains some notions of number theory upon Z numbers:
@@ -26,176 +25,173 @@ Open Local Scope Z_scope.
(** * Divisibility *)
-Inductive Zdivide [a,b:Z] : Prop :=
- Zdivide_intro : (q:Z) `b = q * a` -> (Zdivide a b).
+Inductive Zdivide (a b:Z) : Prop :=
+ Zdivide_intro : forall q:Z, b = q * a -> Zdivide a b.
(** Syntax for divisibility *)
-Notation "( a | b )" := (Zdivide a b)
- (at level 0, a,b at level 10) : Z_scope
- V8only (at level 0, a,b at level 250).
+Notation "( a | b )" := (Zdivide a b) (at level 0, a, b at level 250) :
+ Z_scope.
(** Results concerning divisibility*)
-Lemma Zdivide_refl : (a:Z) (a|a).
+Lemma Zdivide_refl : forall a:Z, (a | a).
Proof.
-Intros; Apply Zdivide_intro with `1`; Ring.
-Save.
+intros; apply Zdivide_intro with 1; ring.
+Qed.
-Lemma Zone_divide : (a:Z) (1|a).
+Lemma Zone_divide : forall a:Z, (1 | a).
Proof.
-Intros; Apply Zdivide_intro with `a`; Ring.
-Save.
+intros; apply Zdivide_intro with a; ring.
+Qed.
-Lemma Zdivide_0 : (a:Z) (a|0).
+Lemma Zdivide_0 : forall a:Z, (a | 0).
Proof.
-Intros; Apply Zdivide_intro with `0`; Ring.
-Save.
+intros; apply Zdivide_intro with 0; ring.
+Qed.
-Hints Resolve Zdivide_refl Zone_divide Zdivide_0 : zarith.
+Hint Resolve Zdivide_refl Zone_divide Zdivide_0: zarith.
-Lemma Zdivide_mult_left : (a,b,c:Z) (a|b) -> (`c*a`|`c*b`).
+Lemma Zmult_divide_compat_l : forall a b c:Z, (a | b) -> (c * a | c * b).
Proof.
-Induction 1; Intros; Apply Zdivide_intro with q.
-Rewrite H0; Ring.
-Save.
+simple induction 1; intros; apply Zdivide_intro with q.
+rewrite H0; ring.
+Qed.
-Lemma Zdivide_mult_right : (a,b,c:Z) (a|b) -> (`a*c`|`b*c`).
+Lemma Zmult_divide_compat_r : forall a b c:Z, (a | b) -> (a * c | b * c).
Proof.
-Intros a b c; Rewrite (Zmult_sym a c); Rewrite (Zmult_sym b c).
-Apply Zdivide_mult_left; Trivial.
-Save.
+intros a b c; rewrite (Zmult_comm a c); rewrite (Zmult_comm b c).
+apply Zmult_divide_compat_l; trivial.
+Qed.
-Hints Resolve Zdivide_mult_left Zdivide_mult_right : zarith.
+Hint Resolve Zmult_divide_compat_l Zmult_divide_compat_r: zarith.
-Lemma Zdivide_plus : (a,b,c:Z) (a|b) -> (a|c) -> (a|`b+c`).
+Lemma Zdivide_plus_r : forall a b c:Z, (a | b) -> (a | c) -> (a | b + c).
Proof.
-Induction 1; Intros q Hq; Induction 1; Intros q' Hq'.
-Apply Zdivide_intro with `q+q'`.
-Rewrite Hq; Rewrite Hq'; Ring.
-Save.
+simple induction 1; intros q Hq; simple induction 1; intros q' Hq'.
+apply Zdivide_intro with (q + q').
+rewrite Hq; rewrite Hq'; ring.
+Qed.
-Lemma Zdivide_opp : (a,b:Z) (a|b) -> (a|`-b`).
+Lemma Zdivide_opp_r : forall a b:Z, (a | b) -> (a | - b).
Proof.
-Induction 1; Intros; Apply Zdivide_intro with `-q`.
-Rewrite H0; Ring.
-Save.
+simple induction 1; intros; apply Zdivide_intro with (- q).
+rewrite H0; ring.
+Qed.
-Lemma Zdivide_opp_rev : (a,b:Z) (a|`-b`) -> (a| b).
+Lemma Zdivide_opp_r_rev : forall a b:Z, (a | - b) -> (a | b).
Proof.
-Intros; Replace b with `-(-b)`. Apply Zdivide_opp; Trivial. Ring.
-Save.
+intros; replace b with (- - b). apply Zdivide_opp_r; trivial. ring.
+Qed.
-Lemma Zdivide_opp_left : (a,b:Z) (a|b) -> (`-a`|b).
+Lemma Zdivide_opp_l : forall a b:Z, (a | b) -> (- a | b).
Proof.
-Induction 1; Intros; Apply Zdivide_intro with `-q`.
-Rewrite H0; Ring.
-Save.
+simple induction 1; intros; apply Zdivide_intro with (- q).
+rewrite H0; ring.
+Qed.
-Lemma Zdivide_opp_left_rev : (a,b:Z) (`-a`|b) -> (a|b).
+Lemma Zdivide_opp_l_rev : forall a b:Z, (- a | b) -> (a | b).
Proof.
-Intros; Replace a with `-(-a)`. Apply Zdivide_opp_left; Trivial. Ring.
-Save.
+intros; replace a with (- - a). apply Zdivide_opp_l; trivial. ring.
+Qed.
-Lemma Zdivide_minus : (a,b,c:Z) (a|b) -> (a|c) -> (a|`b-c`).
+Lemma Zdivide_minus_l : forall a b c:Z, (a | b) -> (a | c) -> (a | b - c).
Proof.
-Induction 1; Intros q Hq; Induction 1; Intros q' Hq'.
-Apply Zdivide_intro with `q-q'`.
-Rewrite Hq; Rewrite Hq'; Ring.
-Save.
+simple induction 1; intros q Hq; simple induction 1; intros q' Hq'.
+apply Zdivide_intro with (q - q').
+rewrite Hq; rewrite Hq'; ring.
+Qed.
-Lemma Zdivide_left : (a,b,c:Z) (a|b) -> (a|`b*c`).
+Lemma Zdivide_mult_l : forall a b c:Z, (a | b) -> (a | b * c).
Proof.
-Induction 1; Intros q Hq; Apply Zdivide_intro with `q*c`.
-Rewrite Hq; Ring.
-Save.
+simple induction 1; intros q Hq; apply Zdivide_intro with (q * c).
+rewrite Hq; ring.
+Qed.
-Lemma Zdivide_right : (a,b,c:Z) (a|c) -> (a|`b*c`).
+Lemma Zdivide_mult_r : forall a b c:Z, (a | c) -> (a | b * c).
Proof.
-Induction 1; Intros q Hq; Apply Zdivide_intro with `q*b`.
-Rewrite Hq; Ring.
-Save.
+simple induction 1; intros q Hq; apply Zdivide_intro with (q * b).
+rewrite Hq; ring.
+Qed.
-Lemma Zdivide_a_ab : (a,b:Z) (a|`a*b`).
+Lemma Zdivide_factor_r : forall a b:Z, (a | a * b).
Proof.
-Intros; Apply Zdivide_intro with b; Ring.
-Save.
+intros; apply Zdivide_intro with b; ring.
+Qed.
-Lemma Zdivide_a_ba : (a,b:Z) (a|`b*a`).
+Lemma Zdivide_factor_l : forall a b:Z, (a | b * a).
Proof.
-Intros; Apply Zdivide_intro with b; Ring.
-Save.
+intros; apply Zdivide_intro with b; ring.
+Qed.
-Hints Resolve Zdivide_plus Zdivide_opp Zdivide_opp_rev
- Zdivide_opp_left Zdivide_opp_left_rev
- Zdivide_minus Zdivide_left Zdivide_right
- Zdivide_a_ab Zdivide_a_ba : zarith.
+Hint Resolve Zdivide_plus_r Zdivide_opp_r Zdivide_opp_r_rev Zdivide_opp_l
+ Zdivide_opp_l_rev Zdivide_minus_l Zdivide_mult_l Zdivide_mult_r
+ Zdivide_factor_r Zdivide_factor_l: zarith.
(** Auxiliary result. *)
-Lemma Zmult_one :
- (x,y:Z) `x>=0` -> `x*y=1` -> `x=1`.
+Lemma Zmult_one : forall x y:Z, x >= 0 -> x * y = 1 -> x = 1.
Proof.
-Intros x y H H0; NewDestruct (Zmult_1_inversion_l ? ? H0) as [Hpos|Hneg].
- Assumption.
- Rewrite Hneg in H; Simpl in H.
- Contradiction (Zle_not_lt `0` `-1`).
- Apply Zge_le; Assumption.
- Apply NEG_lt_ZERO.
-Save.
+intros x y H H0; destruct (Zmult_1_inversion_l _ _ H0) as [Hpos| Hneg].
+ assumption.
+ rewrite Hneg in H; simpl in H.
+ contradiction (Zle_not_lt 0 (-1)).
+ apply Zge_le; assumption.
+ apply Zorder.Zlt_neg_0.
+Qed.
(** Only [1] and [-1] divide [1]. *)
-Lemma Zdivide_1 : (x:Z) (x|1) -> `x=1` \/ `x=-1`.
+Lemma Zdivide_1 : forall x:Z, (x | 1) -> x = 1 \/ x = -1.
Proof.
-Induction 1; Intros.
-Elim (Z_lt_ge_dec `0` x); [Left|Right].
-Apply Zmult_one with q; Auto with zarith; Rewrite H0; Ring.
-Assert `(-x) = 1`; Auto with zarith.
-Apply Zmult_one with (-q); Auto with zarith; Rewrite H0; Ring.
-Save.
+simple induction 1; intros.
+elim (Z_lt_ge_dec 0 x); [ left | right ].
+apply Zmult_one with q; auto with zarith; rewrite H0; ring.
+assert (- x = 1); auto with zarith.
+apply Zmult_one with (- q); auto with zarith; rewrite H0; ring.
+Qed.
(** If [a] divides [b] and [b] divides [a] then [a] is [b] or [-b]. *)
-Lemma Zdivide_antisym : (a,b:Z) (a|b) -> (b|a) -> `a=b` \/ `a=-b`.
-Proof.
-Induction 1; Intros.
-Inversion H1.
-Rewrite H0 in H2; Clear H H1.
-Case (Z_zerop a); Intro.
-Left; Rewrite H0; Rewrite e; Ring.
-Assert Hqq0: `q0*q = 1`.
-Apply Zmult_reg_left with a.
-Assumption.
-Ring.
-Pattern 2 a; Rewrite H2; Ring.
-Assert (q|1).
-Rewrite <- Hqq0; Auto with zarith.
-Elim (Zdivide_1 q H); Intros.
-Rewrite H1 in H0; Left; Omega.
-Rewrite H1 in H0; Right; Omega.
-Save.
+Lemma Zdivide_antisym : forall a b:Z, (a | b) -> (b | a) -> a = b \/ a = - b.
+Proof.
+simple induction 1; intros.
+inversion H1.
+rewrite H0 in H2; clear H H1.
+case (Z_zerop a); intro.
+left; rewrite H0; rewrite e; ring.
+assert (Hqq0 : q0 * q = 1).
+apply Zmult_reg_l with a.
+assumption.
+ring.
+pattern a at 2 in |- *; rewrite H2; ring.
+assert (q | 1).
+rewrite <- Hqq0; auto with zarith.
+elim (Zdivide_1 q H); intros.
+rewrite H1 in H0; left; omega.
+rewrite H1 in H0; right; omega.
+Qed.
(** If [a] divides [b] and [b<>0] then [|a| <= |b|]. *)
-Lemma Zdivide_bounds : (a,b:Z) (a|b) -> `b<>0` -> `|a| <= |b|`.
-Proof.
-Induction 1; Intros.
-Assert `|b|=|q|*|a|`.
- Subst; Apply Zabs_Zmult.
-Rewrite H2.
-Assert H3 := (Zabs_pos q).
-Assert H4 := (Zabs_pos a).
-Assert `|q|*|a|>=1*|a|`; Auto with zarith.
-Apply Zge_Zmult_pos_compat; Auto with zarith.
-Elim (Z_lt_ge_dec `|q|` `1`); [ Intros | Auto with zarith ].
-Assert `|q|=0`.
- Omega.
-Assert `q=0`.
- Rewrite <- (Zabs_Zsgn q).
-Rewrite H5; Auto with zarith.
-Subst q; Omega.
-Save.
+Lemma Zdivide_bounds : forall a b:Z, (a | b) -> b <> 0 -> Zabs a <= Zabs b.
+Proof.
+simple induction 1; intros.
+assert (Zabs b = Zabs q * Zabs a).
+ subst; apply Zabs_Zmult.
+rewrite H2.
+assert (H3 := Zabs_pos q).
+assert (H4 := Zabs_pos a).
+assert (Zabs q * Zabs a >= 1 * Zabs a); auto with zarith.
+apply Zmult_ge_compat; auto with zarith.
+elim (Z_lt_ge_dec (Zabs q) 1); [ intros | auto with zarith ].
+assert (Zabs q = 0).
+ omega.
+assert (q = 0).
+ rewrite <- (Zabs_Zsgn q).
+rewrite H5; auto with zarith.
+subst q; omega.
+Qed.
(** * Greatest common divisor (gcd). *)
@@ -203,53 +199,54 @@ Save.
expressing that [d] is a gcd of [a] and [b].
(We show later that the [gcd] is actually unique if we discard its sign.) *)
-Inductive gcd [a,b,d:Z] : Prop :=
- gcd_intro :
- (d|a) -> (d|b) -> ((x:Z) (x|a) -> (x|b) -> (x|d)) -> (gcd a b d).
+Inductive Zis_gcd (a b d:Z) : Prop :=
+ Zis_gcd_intro :
+ (d | a) ->
+ (d | b) -> (forall x:Z, (x | a) -> (x | b) -> (x | d)) -> Zis_gcd a b d.
(** Trivial properties of [gcd] *)
-Lemma gcd_sym : (a,b,d:Z)(gcd a b d) -> (gcd b a d).
+Lemma Zis_gcd_sym : forall a b d:Z, Zis_gcd a b d -> Zis_gcd b a d.
Proof.
-Induction 1; Constructor; Intuition.
-Save.
+simple induction 1; constructor; intuition.
+Qed.
-Lemma gcd_0 : (a:Z)(gcd a `0` a).
+Lemma Zis_gcd_0 : forall a:Z, Zis_gcd a 0 a.
Proof.
-Constructor; Auto with zarith.
-Save.
+constructor; auto with zarith.
+Qed.
-Lemma gcd_minus :(a,b,d:Z)(gcd a `-b` d) -> (gcd b a d).
+Lemma Zis_gcd_minus : forall a b d:Z, Zis_gcd a (- b) d -> Zis_gcd b a d.
Proof.
-Induction 1; Constructor; Intuition.
-Save.
+simple induction 1; constructor; intuition.
+Qed.
-Lemma gcd_opp :(a,b,d:Z)(gcd a b d) -> (gcd b a `-d`).
+Lemma Zis_gcd_opp : forall a b d:Z, Zis_gcd a b d -> Zis_gcd b a (- d).
Proof.
-Induction 1; Constructor; Intuition.
-Save.
+simple induction 1; constructor; intuition.
+Qed.
-Hints Resolve gcd_sym gcd_0 gcd_minus gcd_opp : zarith.
+Hint Resolve Zis_gcd_sym Zis_gcd_0 Zis_gcd_minus Zis_gcd_opp: zarith.
(** * Extended Euclid algorithm. *)
(** Euclid's algorithm to compute the [gcd] mainly relies on
the following property. *)
-Lemma gcd_for_euclid :
- (a,b,d,q:Z) (gcd b `a-q*b` d) -> (gcd a b d).
+Lemma Zis_gcd_for_euclid :
+ forall a b d q:Z, Zis_gcd b (a - q * b) d -> Zis_gcd a b d.
Proof.
-Induction 1; Constructor; Intuition.
-Replace a with `a-q*b+q*b`. Auto with zarith. Ring.
-Save.
+simple induction 1; constructor; intuition.
+replace a with (a - q * b + q * b). auto with zarith. ring.
+Qed.
-Lemma gcd_for_euclid2 :
- (b,d,q,r:Z) (gcd r b d) -> (gcd b `b*q+r` d).
+Lemma Zis_gcd_for_euclid2 :
+ forall b d q r:Z, Zis_gcd r b d -> Zis_gcd b (b * q + r) d.
Proof.
-Induction 1; Constructor; Intuition.
-Apply H2; Auto.
-Replace r with `b*q+r-b*q`. Auto with zarith. Ring.
-Save.
+simple induction 1; constructor; intuition.
+apply H2; auto.
+replace r with (b * q + r - b * q). auto with zarith. ring.
+Qed.
(** We implement the extended version of Euclid's algorithm,
i.e. the one computing Bezout's coefficients as it computes
@@ -258,14 +255,14 @@ Save.
Section extended_euclid_algorithm.
-Variable a,b : Z.
+Variables a b : Z.
(** The specification of Euclid's algorithm is the existence of
[u], [v] and [d] such that [ua+vb=d] and [(gcd a b d)]. *)
Inductive Euclid : Set :=
- Euclid_intro :
- (u,v,d:Z) `u*a+v*b=d` -> (gcd a b d) -> Euclid.
+ Euclid_intro :
+ forall u v d:Z, u * a + v * b = d -> Zis_gcd a b d -> Euclid.
(** The recursive part of Euclid's algorithm uses well-founded
recursion of non-negative integers. It maintains 6 integers
@@ -274,356 +271,371 @@ Inductive Euclid : Set :=
*)
Lemma euclid_rec :
- (v3:Z) `0 <= v3` -> (u1,u2,u3,v1,v2:Z) `u1*a+u2*b=u3` -> `v1*a+v2*b=v3` ->
- ((d:Z)(gcd u3 v3 d) -> (gcd a b d)) -> Euclid.
-Proof.
-Intros v3 Hv3; Generalize Hv3; Pattern v3.
-Apply Z_lt_rec.
-Clear v3 Hv3; Intros.
-Elim (Z_zerop x); Intro.
-Apply Euclid_intro with u:=u1 v:=u2 d:=u3.
-Assumption.
-Apply H2.
-Rewrite a0; Auto with zarith.
-LetTac q := (Zdiv u3 x).
-Assert Hq: `0 <= u3-q*x < x`.
-Replace `u3-q*x` with `u3%x`.
-Apply Z_mod_lt; Omega.
-Assert xpos : `x > 0`. Omega.
-Generalize (Z_div_mod_eq u3 x xpos).
-Unfold q.
-Intro eq; Pattern 2 u3; Rewrite eq; Ring.
-Apply (H `u3-q*x` Hq (proj1 ? ? Hq) v1 v2 x `u1-q*v1` `u2-q*v2`).
-Tauto.
-Replace `(u1-q*v1)*a+(u2-q*v2)*b` with `(u1*a+u2*b)-q*(v1*a+v2*b)`.
-Rewrite H0; Rewrite H1; Trivial.
-Ring.
-Intros; Apply H2.
-Apply gcd_for_euclid with q; Assumption.
-Assumption.
-Save.
+ forall v3:Z,
+ 0 <= v3 ->
+ forall u1 u2 u3 v1 v2:Z,
+ u1 * a + u2 * b = u3 ->
+ v1 * a + v2 * b = v3 ->
+ (forall d:Z, Zis_gcd u3 v3 d -> Zis_gcd a b d) -> Euclid.
+Proof.
+intros v3 Hv3; generalize Hv3; pattern v3 in |- *.
+apply Z_lt_rec.
+clear v3 Hv3; intros.
+elim (Z_zerop x); intro.
+apply Euclid_intro with (u := u1) (v := u2) (d := u3).
+assumption.
+apply H2.
+rewrite a0; auto with zarith.
+set (q := u3 / x) in *.
+assert (Hq : 0 <= u3 - q * x < x).
+replace (u3 - q * x) with (u3 mod x).
+apply Z_mod_lt; omega.
+assert (xpos : x > 0). omega.
+generalize (Z_div_mod_eq u3 x xpos).
+unfold q in |- *.
+intro eq; pattern u3 at 2 in |- *; rewrite eq; ring.
+apply (H (u3 - q * x) Hq (proj1 Hq) v1 v2 x (u1 - q * v1) (u2 - q * v2)).
+tauto.
+replace ((u1 - q * v1) * a + (u2 - q * v2) * b) with
+ (u1 * a + u2 * b - q * (v1 * a + v2 * b)).
+rewrite H0; rewrite H1; trivial.
+ring.
+intros; apply H2.
+apply Zis_gcd_for_euclid with q; assumption.
+assumption.
+Qed.
(** We get Euclid's algorithm by applying [euclid_rec] on
[1,0,a,0,1,b] when [b>=0] and [1,0,a,0,-1,-b] when [b<0]. *)
Lemma euclid : Euclid.
Proof.
-Case (Z_le_gt_dec `0` b); Intro.
-Intros; Apply euclid_rec with u1:=`1` u2:=`0` u3:=a
- v1:=`0` v2:=`1` v3:=b;
-Auto with zarith; Ring.
-Intros; Apply euclid_rec with u1:=`1` u2:=`0` u3:=a
- v1:=`0` v2:=`-1` v3:=`-b`;
-Auto with zarith; Try Ring.
-Save.
+case (Z_le_gt_dec 0 b); intro.
+intros;
+ apply euclid_rec with
+ (u1 := 1) (u2 := 0) (u3 := a) (v1 := 0) (v2 := 1) (v3 := b);
+ auto with zarith; ring.
+intros;
+ apply euclid_rec with
+ (u1 := 1) (u2 := 0) (u3 := a) (v1 := 0) (v2 := -1) (v3 := - b);
+ auto with zarith; try ring.
+Qed.
End extended_euclid_algorithm.
-Theorem gcd_uniqueness_apart_sign :
- (a,b,d,d':Z) (gcd a b d) -> (gcd a b d') -> `d = d'` \/ `d = -d'`.
+Theorem Zis_gcd_uniqueness_apart_sign :
+ forall a b d d':Z, Zis_gcd a b d -> Zis_gcd a b d' -> d = d' \/ d = - d'.
Proof.
-Induction 1.
-Intros H1 H2 H3; Induction 1; Intros.
-Generalize (H3 d' H4 H5); Intro Hd'd.
-Generalize (H6 d H1 H2); Intro Hdd'.
-Exact (Zdivide_antisym d d' Hdd' Hd'd).
-Save.
+simple induction 1.
+intros H1 H2 H3; simple induction 1; intros.
+generalize (H3 d' H4 H5); intro Hd'd.
+generalize (H6 d H1 H2); intro Hdd'.
+exact (Zdivide_antisym d d' Hdd' Hd'd).
+Qed.
(** * Bezout's coefficients *)
-Inductive Bezout [a,b,d:Z] : Prop :=
- Bezout_intro : (u,v:Z) `u*a + v*b = d` -> (Bezout a b d).
+Inductive Bezout (a b d:Z) : Prop :=
+ Bezout_intro : forall u v:Z, u * a + v * b = d -> Bezout a b d.
(** Existence of Bezout's coefficients for the [gcd] of [a] and [b] *)
-Lemma gcd_bezout : (a,b,d:Z) (gcd a b d) -> (Bezout a b d).
+Lemma Zis_gcd_bezout : forall a b d:Z, Zis_gcd a b d -> Bezout a b d.
Proof.
-Intros a b d Hgcd.
-Elim (euclid a b); Intros u v d0 e g.
-Generalize (gcd_uniqueness_apart_sign a b d d0 Hgcd g).
-Intro H; Elim H; Clear H; Intros.
-Apply Bezout_intro with u v.
-Rewrite H; Assumption.
-Apply Bezout_intro with `-u` `-v`.
-Rewrite H; Rewrite <- e; Ring.
-Save.
+intros a b d Hgcd.
+elim (euclid a b); intros u v d0 e g.
+generalize (Zis_gcd_uniqueness_apart_sign a b d d0 Hgcd g).
+intro H; elim H; clear H; intros.
+apply Bezout_intro with u v.
+rewrite H; assumption.
+apply Bezout_intro with (- u) (- v).
+rewrite H; rewrite <- e; ring.
+Qed.
(** gcd of [ca] and [cb] is [c gcd(a,b)]. *)
-Lemma gcd_mult : (a,b,c,d:Z) (gcd a b d) -> (gcd `c*a` `c*b` `c*d`).
-Proof.
-Intros a b c d; Induction 1; Constructor; Intuition.
-Elim (gcd_bezout a b d H); Intros.
-Elim H3; Intros.
-Elim H4; Intros.
-Apply Zdivide_intro with `u*q+v*q0`.
-Rewrite <- H5.
-Replace `c*(u*a+v*b)` with `u*(c*a)+v*(c*b)`.
-Rewrite H6; Rewrite H7; Ring.
-Ring.
-Save.
+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 H3; intros.
+elim H4; intros.
+apply Zdivide_intro with (u * q + v * q0).
+rewrite <- H5.
+replace (c * (u * a + v * b)) with (u * (c * a) + v * (c * b)).
+rewrite H6; rewrite H7; ring.
+ring.
+Qed.
(** We could obtain a [Zgcd] function via [euclid]. But we propose
here a more direct version of a [Zgcd], with better extraction
(no bezout coeffs). *)
-Definition Zgcd_pos : (a:Z)`0<=a` -> (b:Z)
- { g:Z | `0<=a` -> (gcd a b g) /\ `g>=0` }.
-Proof.
-Intros a Ha.
-Apply (Z_lt_rec [a:Z](b:Z) { g:Z | `0<=a` -> (gcd a b g) /\`g>=0` }); Try Assumption.
-Intro x; Case x.
-Intros _ b; Exists (Zabs b).
- Elim (Z_le_lt_eq_dec ? ? (Zabs_pos b)).
- Intros H0; Split.
- Apply Zabs_ind.
- Intros; Apply gcd_sym; Apply gcd_0; Auto.
- Intros; Apply gcd_opp; Apply gcd_0; Auto.
- Auto with zarith.
+Definition Zgcd_pos :
+ forall a:Z,
+ 0 <= a -> forall b:Z, {g : Z | 0 <= a -> Zis_gcd a b g /\ g >= 0}.
+Proof.
+intros a Ha.
+apply
+ (Z_lt_rec
+ (fun a:Z => forall b:Z, {g : Z | 0 <= a -> Zis_gcd a b g /\ g >= 0}));
+ try assumption.
+intro x; case x.
+intros _ b; exists (Zabs b).
+ elim (Z_le_lt_eq_dec _ _ (Zabs_pos b)).
+ intros H0; split.
+ apply Zabs_ind.
+ intros; apply Zis_gcd_sym; apply Zis_gcd_0; auto.
+ intros; apply Zis_gcd_opp; apply Zis_gcd_0; auto.
+ auto with zarith.
- Intros H0; Rewrite <- H0.
- Rewrite <- (Zabs_Zsgn b); Rewrite <- H0; Simpl.
- Split; [Apply gcd_0|Idtac];Auto with zarith.
+ intros H0; rewrite <- H0.
+ rewrite <- (Zabs_Zsgn b); rewrite <- H0; simpl in |- *.
+ split; [ apply Zis_gcd_0 | idtac ]; auto with zarith.
-Intros p Hrec b.
-Generalize (Z_div_mod b (POS p)).
-Case (Zdiv_eucl b (POS p)); Intros q r Hqr.
-Elim Hqr; Clear Hqr; Intros; Auto with zarith.
-Elim (Hrec r H0 (POS p)); Intros g Hgkl.
-Inversion_clear H0.
-Elim (Hgkl H1); Clear Hgkl; Intros H3 H4.
-Exists g; Intros.
-Split; Auto.
-Rewrite H.
-Apply gcd_for_euclid2; Auto.
-
-Intros p Hrec b.
-Exists `0`; Intros.
-Elim H; Auto.
+intros p Hrec b.
+generalize (Z_div_mod b (Zpos p)).
+case (Zdiv_eucl b (Zpos p)); intros q r Hqr.
+elim Hqr; clear Hqr; intros; auto with zarith.
+elim (Hrec r H0 (Zpos p)); intros g Hgkl.
+inversion_clear H0.
+elim (Hgkl H1); clear Hgkl; intros H3 H4.
+exists g; intros.
+split; auto.
+rewrite H.
+apply Zis_gcd_for_euclid2; auto.
+
+intros p Hrec b.
+exists 0; intros.
+elim H; auto.
Defined.
-Definition Zgcd_spec : (a,b:Z){ g : Z | (gcd a b g) /\ `g>=0` }.
+Definition Zgcd_spec : forall a b:Z, {g : Z | Zis_gcd a b g /\ g >= 0}.
Proof.
-Intros a; Case (Z_gt_le_dec `0` a).
-Intros; Assert `0 <= -a`.
-Omega.
-Elim (Zgcd_pos `-a` H b); Intros g Hgkl.
-Exists g.
-Intuition.
-Intros Ha b; Elim (Zgcd_pos a Ha b); Intros g; Exists g; Intuition.
+intros a; case (Z_gt_le_dec 0 a).
+intros; assert (0 <= - a).
+omega.
+elim (Zgcd_pos (- a) H b); intros g Hgkl.
+exists g.
+intuition.
+intros Ha b; elim (Zgcd_pos a Ha b); intros g; exists g; intuition.
Defined.
-Definition Zgcd := [a,b:Z](let (g,_) = (Zgcd_spec a b) in g).
+Definition Zgcd (a b:Z) := let (g, _) := Zgcd_spec a b in g.
-Lemma Zgcd_is_pos : (a,b:Z)`(Zgcd a b) >=0`.
-Intros a b; Unfold Zgcd; Case (Zgcd_spec a b); Tauto.
+Lemma Zgcd_is_pos : forall a b:Z, Zgcd a b >= 0.
+intros a b; unfold Zgcd in |- *; case (Zgcd_spec a b); tauto.
Qed.
-Lemma Zgcd_is_gcd : (a,b:Z)(gcd a b (Zgcd a b)).
-Intros a b; Unfold Zgcd; Case (Zgcd_spec a b); Tauto.
+Lemma Zgcd_is_gcd : forall a b:Z, Zis_gcd a b (Zgcd a b).
+intros a b; unfold Zgcd in |- *; case (Zgcd_spec a b); tauto.
Qed.
(** * Relative primality *)
-Definition rel_prime [a,b:Z] : Prop := (gcd a b `1`).
+Definition rel_prime (a b:Z) : Prop := Zis_gcd a b 1.
(** Bezout's theorem: [a] and [b] are relatively prime if and
only if there exist [u] and [v] such that [ua+vb = 1]. *)
-Lemma rel_prime_bezout :
- (a,b:Z) (rel_prime a b) -> (Bezout a b `1`).
+Lemma rel_prime_bezout : forall a b:Z, rel_prime a b -> Bezout a b 1.
Proof.
-Intros a b; Exact (gcd_bezout a b `1`).
-Save.
+intros a b; exact (Zis_gcd_bezout a b 1).
+Qed.
-Lemma bezout_rel_prime :
- (a,b:Z) (Bezout a b `1`) -> (rel_prime a b).
+Lemma bezout_rel_prime : forall a b:Z, Bezout a b 1 -> rel_prime a b.
Proof.
-Induction 1; Constructor; Auto with zarith.
-Intros. Rewrite <- H0; Auto with zarith.
-Save.
+simple induction 1; constructor; auto with zarith.
+intros. rewrite <- H0; auto with zarith.
+Qed.
(** Gauss's theorem: if [a] divides [bc] and if [a] and [b] are
relatively prime, then [a] divides [c]. *)
-Theorem Gauss : (a,b,c:Z) (a |`b*c`) -> (rel_prime a b) -> (a | c).
+Theorem Gauss : forall a b c:Z, (a | b * c) -> rel_prime a b -> (a | c).
Proof.
-Intros. Elim (rel_prime_bezout a b H0); Intros.
-Replace c with `c*1`; [ Idtac | Ring ].
-Rewrite <- H1.
-Replace `c*(u*a+v*b)` with `(c*u)*a + v*(b*c)`; [ EAuto with zarith | Ring ].
-Save.
+intros. elim (rel_prime_bezout a b H0); intros.
+replace c with (c * 1); [ idtac | ring ].
+rewrite <- H1.
+replace (c * (u * a + v * b)) with (c * u * a + v * (b * c));
+ [ eauto with zarith | ring ].
+Qed.
(** If [a] is relatively prime to [b] and [c], then it is to [bc] *)
-Lemma rel_prime_mult :
- (a,b,c:Z) (rel_prime a b) -> (rel_prime a c) -> (rel_prime a `b*c`).
-Proof.
-Intros a b c Hb Hc.
-Elim (rel_prime_bezout a b Hb); Intros.
-Elim (rel_prime_bezout a c Hc); Intros.
-Apply bezout_rel_prime.
-Apply Bezout_intro with u:=`u*u0*a+v0*c*u+u0*v*b` v:=`v*v0`.
-Rewrite <- H.
-Replace `u*a+v*b` with `(u*a+v*b) * 1`; [ Idtac | Ring ].
-Rewrite <- H0.
-Ring.
-Save.
+Lemma rel_prime_mult :
+ forall a b c:Z, rel_prime a b -> rel_prime a c -> rel_prime a (b * c).
+Proof.
+intros a b c Hb Hc.
+elim (rel_prime_bezout a b Hb); intros.
+elim (rel_prime_bezout a c Hc); intros.
+apply bezout_rel_prime.
+apply Bezout_intro with
+ (u := u * u0 * a + v0 * c * u + u0 * v * b) (v := v * v0).
+rewrite <- H.
+replace (u * a + v * b) with ((u * a + v * b) * 1); [ idtac | ring ].
+rewrite <- H0.
+ring.
+Qed.
Lemma rel_prime_cross_prod :
- (a,b,c,d:Z) (rel_prime a b) -> (rel_prime c d) -> `b>0` -> `d>0` ->
- `a*d = b*c` -> (a=c /\ b=d).
-Proof.
-Intros a b c d; Intros.
-Elim (Zdivide_antisym b d).
-Split; Auto with zarith.
-Rewrite H4 in H3.
-Rewrite Zmult_sym in H3.
-Apply Zmult_reg_left with d; Auto with zarith.
-Intros; Omega.
-Apply Gauss with a.
-Rewrite H3.
-Auto with zarith.
-Red; Auto with zarith.
-Apply Gauss with c.
-Rewrite Zmult_sym.
-Rewrite <- H3.
-Auto with zarith.
-Red; Auto with zarith.
-Save.
+ forall a b c d:Z,
+ rel_prime a b ->
+ rel_prime c d -> b > 0 -> d > 0 -> a * d = b * c -> a = c /\ b = d.
+Proof.
+intros a b c d; intros.
+elim (Zdivide_antisym b d).
+split; auto with zarith.
+rewrite H4 in H3.
+rewrite Zmult_comm in H3.
+apply Zmult_reg_l with d; auto with zarith.
+intros; omega.
+apply Gauss with a.
+rewrite H3.
+auto with zarith.
+red in |- *; auto with zarith.
+apply Gauss with c.
+rewrite Zmult_comm.
+rewrite <- H3.
+auto with zarith.
+red in |- *; auto with zarith.
+Qed.
(** After factorization by a gcd, the original numbers are relatively prime. *)
-Lemma gcd_rel_prime :
- (a,b,g:Z)`b>0` -> `g>=0`-> (gcd a b g) -> (rel_prime `a/g` `b/g`).
-Intros a b g; Intros.
-Assert `g <> 0`.
- Intro.
- Elim H1; Intros.
- Elim H4; Intros.
- Rewrite H2 in H6; Subst b; Omega.
-Unfold rel_prime.
-Elim (Zgcd_spec `a/g` `b/g`); Intros g' (H3,H4).
-Assert H5 := (gcd_mult ? ? g ? H3).
-Rewrite <- Z_div_exact_2 in H5; Auto with zarith.
-Rewrite <- Z_div_exact_2 in H5; Auto with zarith.
-Elim (gcd_uniqueness_apart_sign ? ? ? ? H1 H5).
-Intros; Rewrite (!Zmult_reg_left `1` g' g); Auto with zarith.
-Intros; Rewrite (!Zmult_reg_left `1` `-g'` g); Auto with zarith.
-Pattern 1 g; Rewrite H6; Ring.
-
-Elim H1; Intros.
-Elim H7; Intros.
-Rewrite H9.
-Replace `q*g` with `0+q*g`.
-Rewrite Z_mod_plus.
-Compute; Auto.
-Omega.
-Ring.
-
-Elim H1; Intros.
-Elim H6; Intros.
-Rewrite H9.
-Replace `q*g` with `0+q*g`.
-Rewrite Z_mod_plus.
-Compute; Auto.
-Omega.
-Ring.
-Save.
+Lemma Zis_gcd_rel_prime :
+ forall a b g:Z,
+ b > 0 -> g >= 0 -> Zis_gcd a b g -> rel_prime (a / g) (b / g).
+intros a b g; intros.
+assert (g <> 0).
+ intro.
+ elim H1; intros.
+ elim H4; intros.
+ rewrite H2 in H6; subst b; omega.
+unfold rel_prime in |- *.
+elim (Zgcd_spec (a / g) (b / g)); intros g' [H3 H4].
+assert (H5 := Zis_gcd_mult _ _ g _ H3).
+rewrite <- Z_div_exact_2 in H5; auto with zarith.
+rewrite <- Z_div_exact_2 in H5; auto with zarith.
+elim (Zis_gcd_uniqueness_apart_sign _ _ _ _ H1 H5).
+intros; rewrite (Zmult_reg_l 1 g' g); auto with zarith.
+intros; rewrite (Zmult_reg_l 1 (- g') g); auto with zarith.
+pattern g at 1 in |- *; rewrite H6; ring.
+
+elim H1; intros.
+elim H7; intros.
+rewrite H9.
+replace (q * g) with (0 + q * g).
+rewrite Z_mod_plus.
+compute in |- *; auto.
+omega.
+ring.
+
+elim H1; intros.
+elim H6; intros.
+rewrite H9.
+replace (q * g) with (0 + q * g).
+rewrite Z_mod_plus.
+compute in |- *; auto.
+omega.
+ring.
+Qed.
(** * Primality *)
-Inductive prime [p:Z] : Prop :=
- prime_intro :
- `1 < p` -> ((n:Z) `1 <= n < p` -> (rel_prime n p)) -> (prime p).
+Inductive prime (p:Z) : Prop :=
+ prime_intro :
+ 1 < p -> (forall n:Z, 1 <= n < p -> rel_prime n p) -> prime p.
(** The sole divisors of a prime number [p] are [-1], [1], [p] and [-p]. *)
-Lemma prime_divisors :
- (p:Z) (prime p) ->
- (a:Z) (a|p) -> `a = -1` \/ `a = 1` \/ a = p \/ `a = -p`.
-Proof.
-Induction 1; Intros.
-Assert `a = (-p)`\/`-p<a< -1`\/`a = -1`\/`a=0`\/`a = 1`\/`1<a<p`\/`a = p`.
-Assert `|a| <= |p|`. Apply Zdivide_bounds; [ Assumption | Omega ].
-Generalize H3.
-Pattern `|a|`; Apply Zabs_ind; Pattern `|p|`; Apply Zabs_ind; Intros; Omega.
-Intuition Idtac.
+Lemma prime_divisors :
+ forall p:Z,
+ prime p -> forall a:Z, (a | p) -> a = -1 \/ a = 1 \/ a = p \/ a = - p.
+Proof.
+simple induction 1; intros.
+assert
+ (a = - p \/ - p < a < -1 \/ a = -1 \/ a = 0 \/ a = 1 \/ 1 < a < p \/ a = p).
+assert (Zabs a <= Zabs p). apply Zdivide_bounds; [ assumption | omega ].
+generalize H3.
+pattern (Zabs a) in |- *; apply Zabs_ind; pattern (Zabs p) in |- *;
+ apply Zabs_ind; intros; omega.
+intuition idtac.
(* -p < a < -1 *)
-Absurd (rel_prime `-a` p); Intuition.
-Inversion H3.
-Assert (`-a` | `-a`); Auto with zarith.
-Assert (`-a` | p); Auto with zarith.
-Generalize (H8 `-a` H9 H10); Intuition Idtac.
-Generalize (Zdivide_1 `-a` H11); Intuition.
+absurd (rel_prime (- a) p); intuition.
+inversion H3.
+assert (- a | - a); auto with zarith.
+assert (- a | p); auto with zarith.
+generalize (H8 (- a) H9 H10); intuition idtac.
+generalize (Zdivide_1 (- a) H11); intuition.
(* a = 0 *)
-Inversion H2. Subst a; Omega.
+inversion H2. subst a; omega.
(* 1 < a < p *)
-Absurd (rel_prime a p); Intuition.
-Inversion H3.
-Assert (a | a); Auto with zarith.
-Assert (a | p); Auto with zarith.
-Generalize (H8 a H9 H10); Intuition Idtac.
-Generalize (Zdivide_1 a H11); Intuition.
-Save.
+absurd (rel_prime a p); intuition.
+inversion H3.
+assert (a | a); auto with zarith.
+assert (a | p); auto with zarith.
+generalize (H8 a H9 H10); intuition idtac.
+generalize (Zdivide_1 a H11); intuition.
+Qed.
(** A prime number is relatively prime with any number it does not divide *)
-Lemma prime_rel_prime :
- (p:Z) (prime p) -> (a:Z) ~ (p|a) -> (rel_prime p a).
+Lemma prime_rel_prime :
+ forall p:Z, prime p -> forall a:Z, ~ (p | a) -> rel_prime p a.
Proof.
-Induction 1; Intros.
-Constructor; Intuition.
-Elim (prime_divisors p H x H3); Intuition; Subst; Auto with zarith.
-Absurd (p | a); Auto with zarith.
-Absurd (p | a); Intuition.
-Save.
+simple induction 1; intros.
+constructor; intuition.
+elim (prime_divisors p H x H3); intuition; subst; auto with zarith.
+absurd (p | a); auto with zarith.
+absurd (p | a); intuition.
+Qed.
-Hints Resolve prime_rel_prime : zarith.
+Hint Resolve prime_rel_prime: zarith.
(** [Zdivide] can be expressed using [Zmod]. *)
-Lemma Zmod_Zdivide : (a,b:Z) `b>0` -> `a%b = 0` -> (b|a).
-Intros a b H H0.
-Apply Zdivide_intro with `(a/b)`.
-Pattern 1 a; Rewrite (Z_div_mod_eq a b H).
-Rewrite H0; Ring.
-Save.
+Lemma Zmod_divide : forall a b:Z, b > 0 -> a mod b = 0 -> (b | a).
+intros a b H H0.
+apply Zdivide_intro with (a / b).
+pattern a at 1 in |- *; rewrite (Z_div_mod_eq a b H).
+rewrite H0; ring.
+Qed.
-Lemma Zdivide_Zmod : (a,b:Z) `b>0` -> (b|a) -> `a%b = 0`.
-Intros a b; Destruct 2; Intros; Subst.
-Change `q*b` with `0+q*b`.
-Rewrite Z_mod_plus; Auto.
-Save.
+Lemma Zdivide_mod : forall a b:Z, b > 0 -> (b | a) -> a mod b = 0.
+intros a b; simple destruct 2; intros; subst.
+change (q * b) with (0 + q * b) in |- *.
+rewrite Z_mod_plus; auto.
+Qed.
(** [Zdivide] is hence decidable *)
-Lemma Zdivide_dec : (a,b:Z) { (a|b) } + { ~ (a|b) }.
+Lemma Zdivide_dec : forall a b:Z, {(a | b)} + {~ (a | b)}.
Proof.
-Intros a b; Elim (Ztrichotomy_inf a `0`).
+intros a b; elim (Ztrichotomy_inf a 0).
(* a<0 *)
-Intros H; Elim H; Intros.
-Case (Z_eq_dec `b%(-a)` `0`).
-Left; Apply Zdivide_opp_left_rev; Apply Zmod_Zdivide; Auto with zarith.
-Intro H1; Right; Intro; Elim H1; Apply Zdivide_Zmod; Auto with zarith.
+intros H; elim H; intros.
+case (Z_eq_dec (b mod - a) 0).
+left; apply Zdivide_opp_l_rev; apply Zmod_divide; auto with zarith.
+intro H1; right; intro; elim H1; apply Zdivide_mod; auto with zarith.
(* a=0 *)
-Case (Z_eq_dec b `0`); Intro.
-Left; Subst; Auto with zarith.
-Right; Subst; Intro H0; Inversion H0; Omega.
+case (Z_eq_dec b 0); intro.
+left; subst; auto with zarith.
+right; subst; intro H0; inversion H0; omega.
(* a>0 *)
-Intro H; Case (Z_eq_dec `b%a` `0`).
-Left; Apply Zmod_Zdivide; Auto with zarith.
-Intro H1; Right; Intro; Elim H1; Apply Zdivide_Zmod; Auto with zarith.
-Save.
+intro H; case (Z_eq_dec (b mod a) 0).
+left; apply Zmod_divide; auto with zarith.
+intro H1; right; intro; elim H1; apply Zdivide_mod; auto with zarith.
+Qed.
(** If a prime [p] divides [ab] then it divides either [a] or [b] *)
-Lemma prime_mult :
- (p:Z) (prime p) -> (a,b:Z) (p | `a*b`) -> (p | a) \/ (p | b).
+Lemma prime_mult :
+ forall p:Z, prime p -> forall a b:Z, (p | a * b) -> (p | a) \/ (p | b).
Proof.
-Intro p; Induction 1; Intros.
-Case (Zdivide_dec p a); Intuition.
-Right; Apply Gauss with a; Auto with zarith.
-Save.
-
+intro p; simple induction 1; intros.
+case (Zdivide_dec p a); intuition.
+right; apply Gauss with a; auto with zarith.
+Qed.
diff --git a/theories/ZArith/Zorder.v b/theories/ZArith/Zorder.v
index bfe56b82e..eeb9f681b 100644
--- a/theories/ZArith/Zorder.v
+++ b/theories/ZArith/Zorder.v
@@ -9,961 +9,957 @@
(** Binary Integers (Pierre Crégut (CNET, Lannion, France) *)
-Require BinPos.
-Require BinInt.
-Require Arith.
-Require Decidable.
-Require Zsyntax.
-Require Zcompare.
-
-V7only [Import nat_scope.].
+Require Import BinPos.
+Require Import BinInt.
+Require Import Arith.
+Require Import Decidable.
+Require Import Zcompare.
+
Open Local Scope Z_scope.
-Implicit Variable Type x,y,z:Z.
+Implicit Types x y z : Z.
(**********************************************************************)
(** Properties of the order relations on binary integers *)
(** Trichotomy *)
-Theorem Ztrichotomy_inf : (m,n:Z) {`m<n`} + {m=n} + {`m>n`}.
+Theorem Ztrichotomy_inf : forall n m:Z, {n < m} + {n = m} + {n > m}.
Proof.
-Unfold Zgt Zlt; Intros m n; Assert H:=(refl_equal ? (Zcompare m n)).
- LetTac x := (Zcompare m n) in 2 H Goal.
- NewDestruct x;
- [Left; Right;Rewrite Zcompare_EGAL_eq with 1:=H
- | Left; Left
- | Right ]; Reflexivity.
+unfold Zgt, Zlt in |- *; intros m n; assert (H := refl_equal (m ?= n)).
+ set (x := m ?= n) in H at 2 |- *.
+ destruct x;
+ [ left; right; rewrite Zcompare_Eq_eq with (1 := H) | left; left | right ];
+ reflexivity.
Qed.
-Theorem Ztrichotomy : (m,n:Z) `m<n` \/ m=n \/ `m>n`.
+Theorem Ztrichotomy : forall n m:Z, n < m \/ n = m \/ n > m.
Proof.
- Intros m n; NewDestruct (Ztrichotomy_inf m n) as [[Hlt|Heq]|Hgt];
- [Left | Right; Left |Right; Right]; Assumption.
+ intros m n; destruct (Ztrichotomy_inf m n) as [[Hlt| Heq]| Hgt];
+ [ left | right; left | right; right ]; assumption.
Qed.
(**********************************************************************)
(** Decidability of equality and order on Z *)
-Theorem dec_eq: (x,y:Z) (decidable (x=y)).
+Theorem dec_eq : forall n m:Z, decidable (n = m).
Proof.
-Intros x y; Unfold decidable ; Elim (Zcompare_EGAL x y);
-Intros H1 H2; Elim (Dcompare (Zcompare x y)); [
- Tauto
- | Intros H3; Right; Unfold not ; Intros H4;
- Elim H3; Rewrite (H2 H4); Intros H5; Discriminate H5].
+intros x y; unfold decidable in |- *; elim (Zcompare_Eq_iff_eq x y);
+ intros H1 H2; elim (Dcompare (x ?= y));
+ [ tauto
+ | intros H3; right; unfold not in |- *; intros H4; elim H3; rewrite (H2 H4);
+ intros H5; discriminate H5 ].
Qed.
-Theorem dec_Zne: (x,y:Z) (decidable (Zne x y)).
+Theorem dec_Zne : forall n m:Z, decidable (Zne n m).
Proof.
-Intros x y; Unfold decidable Zne ; Elim (Zcompare_EGAL x y).
-Intros H1 H2; Elim (Dcompare (Zcompare x y));
- [ Right; Rewrite H1; Auto
- | Left; Unfold not; Intro; Absurd (Zcompare x y)=EGAL;
- [ Elim H; Intros HR; Rewrite HR; Discriminate
- | Auto]].
+intros x y; unfold decidable, Zne in |- *; elim (Zcompare_Eq_iff_eq x y).
+intros H1 H2; elim (Dcompare (x ?= y));
+ [ right; rewrite H1; auto
+ | left; unfold not in |- *; intro; absurd ((x ?= y) = Eq);
+ [ elim H; intros HR; rewrite HR; discriminate | auto ] ].
Qed.
-Theorem dec_Zle: (x,y:Z) (decidable `x<=y`).
+Theorem dec_Zle : forall n m:Z, decidable (n <= m).
Proof.
-Intros x y; Unfold decidable Zle ; Elim (Zcompare x y); [
- Left; Discriminate
- | Left; Discriminate
- | Right; Unfold not ; Intros H; Apply H; Trivial with arith].
+intros x y; unfold decidable, Zle in |- *; elim (x ?= y);
+ [ left; discriminate
+ | left; discriminate
+ | right; unfold not in |- *; intros H; apply H; trivial with arith ].
Qed.
-Theorem dec_Zgt: (x,y:Z) (decidable `x>y`).
+Theorem dec_Zgt : forall n m:Z, decidable (n > m).
Proof.
-Intros x y; Unfold decidable Zgt ; Elim (Zcompare x y);
- [ Right; Discriminate | Right; Discriminate | Auto with arith].
+intros x y; unfold decidable, Zgt in |- *; elim (x ?= y);
+ [ right; discriminate | right; discriminate | auto with arith ].
Qed.
-Theorem dec_Zge: (x,y:Z) (decidable `x>=y`).
+Theorem dec_Zge : forall n m:Z, decidable (n >= m).
Proof.
-Intros x y; Unfold decidable Zge ; Elim (Zcompare x y); [
- Left; Discriminate
-| Right; Unfold not ; Intros H; Apply H; Trivial with arith
-| Left; Discriminate].
+intros x y; unfold decidable, Zge in |- *; elim (x ?= y);
+ [ left; discriminate
+ | right; unfold not in |- *; intros H; apply H; trivial with arith
+ | left; discriminate ].
Qed.
-Theorem dec_Zlt: (x,y:Z) (decidable `x<y`).
+Theorem dec_Zlt : forall n m:Z, decidable (n < m).
Proof.
-Intros x y; Unfold decidable Zlt ; Elim (Zcompare x y);
- [ Right; Discriminate | Auto with arith | Right; Discriminate].
+intros x y; unfold decidable, Zlt in |- *; elim (x ?= y);
+ [ right; discriminate | auto with arith | right; discriminate ].
Qed.
-Theorem not_Zeq : (x,y:Z) ~ x=y -> `x<y` \/ `y<x`.
+Theorem not_Zeq : forall n m:Z, n <> m -> n < m \/ m < n.
Proof.
-Intros x y; Elim (Dcompare (Zcompare x y)); [
- Intros H1 H2; Absurd x=y; [ Assumption | Elim (Zcompare_EGAL x y); Auto with arith]
-| Unfold Zlt ; Intros H; Elim H; Intros H1;
- [Auto with arith | Right; Elim (Zcompare_ANTISYM x y); Auto with arith]].
+intros x y; elim (Dcompare (x ?= y));
+ [ intros H1 H2; absurd (x = y);
+ [ assumption | elim (Zcompare_Eq_iff_eq x y); auto with arith ]
+ | unfold Zlt in |- *; intros H; elim H; intros H1;
+ [ auto with arith
+ | right; elim (Zcompare_Gt_Lt_antisym x y); auto with arith ] ].
Qed.
(** Relating strict and large orders *)
-Lemma Zgt_lt : (m,n:Z) `m>n` -> `n<m`.
+Lemma Zgt_lt : forall n m:Z, n > m -> m < n.
Proof.
-Unfold Zgt Zlt ;Intros m n H; Elim (Zcompare_ANTISYM m n); Auto with arith.
+unfold Zgt, Zlt in |- *; intros m n H; elim (Zcompare_Gt_Lt_antisym m n);
+ auto with arith.
Qed.
-Lemma Zlt_gt : (m,n:Z) `m<n` -> `n>m`.
+Lemma Zlt_gt : forall n m:Z, n < m -> m > n.
Proof.
-Unfold Zgt Zlt ;Intros m n H; Elim (Zcompare_ANTISYM n m); Auto with arith.
+unfold Zgt, Zlt in |- *; intros m n H; elim (Zcompare_Gt_Lt_antisym n m);
+ auto with arith.
Qed.
-Lemma Zge_le : (m,n:Z) `m>=n` -> `n<=m`.
+Lemma Zge_le : forall n m:Z, n >= m -> m <= n.
Proof.
-Intros m n; Change ~`m<n`-> ~`n>m`;
-Unfold not; Intros H1 H2; Apply H1; Apply Zgt_lt; Assumption.
+intros m n; change (~ m < n -> ~ n > m) in |- *; unfold not in |- *;
+ intros H1 H2; apply H1; apply Zgt_lt; assumption.
Qed.
-Lemma Zle_ge : (m,n:Z) `m<=n` -> `n>=m`.
+Lemma Zle_ge : forall n m:Z, n <= m -> m >= n.
Proof.
-Intros m n; Change ~`m>n`-> ~`n<m`;
-Unfold not; Intros H1 H2; Apply H1; Apply Zlt_gt; Assumption.
+intros m n; change (~ m > n -> ~ n < m) in |- *; unfold not in |- *;
+ intros H1 H2; apply H1; apply Zlt_gt; assumption.
Qed.
-Lemma Zle_not_gt : (n,m:Z)`n<=m` -> ~`n>m`.
+Lemma Zle_not_gt : forall n m:Z, n <= m -> ~ n > m.
Proof.
-Trivial.
+trivial.
Qed.
-Lemma Zgt_not_le : (n,m:Z)`n>m` -> ~`n<=m`.
+Lemma Zgt_not_le : forall n m:Z, n > m -> ~ n <= m.
Proof.
-Intros n m H1 H2; Apply H2; Assumption.
+intros n m H1 H2; apply H2; assumption.
Qed.
-Lemma Zle_not_lt : (n,m:Z)`n<=m` -> ~`m<n`.
+Lemma Zle_not_lt : forall n m:Z, n <= m -> ~ m < n.
Proof.
-Intros n m H1 H2.
-Assert H3:=(Zlt_gt ? ? H2).
-Apply Zle_not_gt with n m; Assumption.
+intros n m H1 H2.
+assert (H3 := Zlt_gt _ _ H2).
+apply Zle_not_gt with n m; assumption.
Qed.
-Lemma Zlt_not_le : (n,m:Z)`n<m` -> ~`m<=n`.
+Lemma Zlt_not_le : forall n m:Z, n < m -> ~ m <= n.
Proof.
-Intros n m H1 H2.
-Apply Zle_not_lt with m n; Assumption.
+intros n m H1 H2.
+apply Zle_not_lt with m n; assumption.
Qed.
-Lemma not_Zge : (x,y:Z) ~`x>=y` -> `x<y`.
+Lemma Znot_ge_lt : forall n m:Z, ~ n >= m -> n < m.
Proof.
-Unfold Zge Zlt ; Intros x y H; Apply dec_not_not;
- [ Exact (dec_Zlt x y) | Assumption].
+unfold Zge, Zlt in |- *; intros x y H; apply dec_not_not;
+ [ exact (dec_Zlt x y) | assumption ].
Qed.
-Lemma not_Zlt : (x,y:Z) ~`x<y` -> `x>=y`.
+Lemma Znot_lt_ge : forall n m:Z, ~ n < m -> n >= m.
Proof.
-Unfold Zlt Zge; Auto with arith.
+unfold Zlt, Zge in |- *; auto with arith.
Qed.
-Lemma not_Zgt : (x,y:Z)~`x>y` -> `x<=y`.
+Lemma Znot_gt_le : forall n m:Z, ~ n > m -> n <= m.
Proof.
-Trivial.
+trivial.
Qed.
-Lemma not_Zle : (x,y:Z) ~`x<=y` -> `x>y`.
+Lemma Znot_le_gt : forall n m:Z, ~ n <= m -> n > m.
Proof.
-Unfold Zle Zgt ; Intros x y H; Apply dec_not_not;
- [ Exact (dec_Zgt x y) | Assumption].
+unfold Zle, Zgt in |- *; intros x y H; apply dec_not_not;
+ [ exact (dec_Zgt x y) | assumption ].
Qed.
-Lemma Zge_iff_le : (x,y:Z) `x>=y` <-> `y<=x`.
+Lemma Zge_iff_le : forall n m:Z, n >= m <-> m <= n.
Proof.
- Intros x y; Intros. Split. Intro. Apply Zge_le. Assumption.
- Intro. Apply Zle_ge. Assumption.
+ intros x y; intros. split. intro. apply Zge_le. assumption.
+ intro. apply Zle_ge. assumption.
Qed.
-Lemma Zgt_iff_lt : (x,y:Z) `x>y` <-> `y<x`.
+Lemma Zgt_iff_lt : forall n m:Z, n > m <-> m < n.
Proof.
- Intros x y. Split. Intro. Apply Zgt_lt. Assumption.
- Intro. Apply Zlt_gt. Assumption.
+ intros x y. split. intro. apply Zgt_lt. assumption.
+ intro. apply Zlt_gt. assumption.
Qed.
(** Reflexivity *)
-Lemma Zle_n : (n:Z) (Zle n n).
+Lemma Zle_refl : forall n:Z, n <= n.
Proof.
-Intros n; Unfold Zle; Rewrite (Zcompare_x_x n); Discriminate.
+intros n; unfold Zle in |- *; rewrite (Zcompare_refl n); discriminate.
Qed.
-Lemma Zle_refl : (n,m:Z) n=m -> `n<=m`.
+Lemma Zeq_le : forall n m:Z, n = m -> n <= m.
Proof.
-Intros; Rewrite H; Apply Zle_n.
+intros; rewrite H; apply Zle_refl.
Qed.
-Hints Resolve Zle_n : zarith.
+Hint Resolve Zle_refl: zarith.
(** Antisymmetry *)
-Lemma Zle_antisym : (n,m:Z)`n<=m`->`m<=n`->n=m.
+Lemma Zle_antisym : forall n m:Z, n <= m -> m <= n -> n = m.
Proof.
-Intros n m H1 H2; NewDestruct (Ztrichotomy n m) as [Hlt|[Heq|Hgt]].
- Absurd `m>n`; [ Apply Zle_not_gt | Apply Zlt_gt]; Assumption.
- Assumption.
- Absurd `n>m`; [ Apply Zle_not_gt | Idtac]; Assumption.
+intros n m H1 H2; destruct (Ztrichotomy n m) as [Hlt| [Heq| Hgt]].
+ absurd (m > n); [ apply Zle_not_gt | apply Zlt_gt ]; assumption.
+ assumption.
+ absurd (n > m); [ apply Zle_not_gt | idtac ]; assumption.
Qed.
(** Asymmetry *)
-Lemma Zgt_not_sym : (n,m:Z)`n>m` -> ~`m>n`.
+Lemma Zgt_asym : forall n m:Z, n > m -> ~ m > n.
Proof.
-Unfold Zgt ;Intros n m H; Elim (Zcompare_ANTISYM n m); Intros H1 H2;
-Rewrite -> H1; [ Discriminate | Assumption ].
+unfold Zgt in |- *; intros n m H; elim (Zcompare_Gt_Lt_antisym n m);
+ intros H1 H2; rewrite H1; [ discriminate | assumption ].
Qed.
-Lemma Zlt_not_sym : (n,m:Z)`n<m` -> ~`m<n`.
+Lemma Zlt_asym : forall n m:Z, n < m -> ~ m < n.
Proof.
-Intros n m H H1;
-Assert H2:`m>n`. Apply Zlt_gt; Assumption.
-Assert H3: `n>m`. Apply Zlt_gt; Assumption.
-Apply Zgt_not_sym with m n; Assumption.
+intros n m H H1; assert (H2 : m > n). apply Zlt_gt; assumption.
+assert (H3 : n > m). apply Zlt_gt; assumption.
+apply Zgt_asym with m n; assumption.
Qed.
(** Irreflexivity *)
-Lemma Zgt_antirefl : (n:Z)~`n>n`.
+Lemma Zgt_irrefl : forall n:Z, ~ n > n.
Proof.
-Intros n H; Apply (Zgt_not_sym n n H H).
+intros n H; apply (Zgt_asym n n H H).
Qed.
-Lemma Zlt_n_n : (n:Z)~`n<n`.
+Lemma Zlt_irrefl : forall n:Z, ~ n < n.
Proof.
-Intros n H; Apply (Zlt_not_sym n n H H).
+intros n H; apply (Zlt_asym n n H H).
Qed.
-Lemma Zlt_not_eq : (x,y:Z)`x<y` -> ~x=y.
+Lemma Zlt_not_eq : forall n m:Z, n < m -> n <> m.
Proof.
-Unfold not; Intros x y H H0.
-Rewrite H0 in H.
-Apply (Zlt_n_n ? H).
+unfold not in |- *; intros x y H H0.
+rewrite H0 in H.
+apply (Zlt_irrefl _ H).
Qed.
(** Large = strict or equal *)
-Lemma Zlt_le_weak : (n,m:Z)`n<m`->`n<=m`.
+Lemma Zlt_le_weak : forall n m:Z, n < m -> n <= m.
Proof.
-Intros n m Hlt; Apply not_Zgt; Apply Zgt_not_sym; Apply Zlt_gt; Assumption.
+intros n m Hlt; apply Znot_gt_le; apply Zgt_asym; apply Zlt_gt; assumption.
Qed.
-Lemma Zle_lt_or_eq : (n,m:Z)`n<=m`->(`n<m` \/ n=m).
+Lemma Zle_lt_or_eq : forall n m:Z, n <= m -> n < m \/ n = m.
Proof.
-Intros n m H; NewDestruct (Ztrichotomy n m) as [Hlt|[Heq|Hgt]]; [
- Left; Assumption
-| Right; Assumption
-| Absurd `n>m`; [Apply Zle_not_gt|Idtac]; Assumption ].
+intros n m H; destruct (Ztrichotomy n m) as [Hlt| [Heq| Hgt]];
+ [ left; assumption
+ | right; assumption
+ | absurd (n > m); [ apply Zle_not_gt | idtac ]; assumption ].
Qed.
(** Dichotomy *)
-Lemma Zle_or_lt : (n,m:Z)`n<=m`\/`m<n`.
+Lemma Zle_or_lt : forall n m:Z, n <= m \/ m < n.
Proof.
-Intros n m; NewDestruct (Ztrichotomy n m) as [Hlt|[Heq|Hgt]]; [
- Left; Apply not_Zgt; Intro Hgt; Assert Hgt':=(Zlt_gt ? ? Hlt);
- Apply Zgt_not_sym with m n; Assumption
-| Left; Rewrite Heq; Apply Zle_n
-| Right; Apply Zgt_lt; Assumption ].
+intros n m; destruct (Ztrichotomy n m) as [Hlt| [Heq| Hgt]];
+ [ left; apply Znot_gt_le; intro Hgt; assert (Hgt' := Zlt_gt _ _ Hlt);
+ apply Zgt_asym with m n; assumption
+ | left; rewrite Heq; apply Zle_refl
+ | right; apply Zgt_lt; assumption ].
Qed.
(** Transitivity of strict orders *)
-Lemma Zgt_trans : (n,m,p:Z)`n>m`->`m>p`->`n>p`.
+Lemma Zgt_trans : forall n m p:Z, n > m -> m > p -> n > p.
Proof.
-Exact Zcompare_trans_SUPERIEUR.
+exact Zcompare_Gt_trans.
Qed.
-Lemma Zlt_trans : (n,m,p:Z)`n<m`->`m<p`->`n<p`.
+Lemma Zlt_trans : forall n m p:Z, n < m -> m < p -> n < p.
Proof.
-Intros n m p H1 H2; Apply Zgt_lt; Apply Zgt_trans with m:= m;
-Apply Zlt_gt; Assumption.
+intros n m p H1 H2; apply Zgt_lt; apply Zgt_trans with (m := m); apply Zlt_gt;
+ assumption.
Qed.
(** Mixed transitivity *)
-Lemma Zle_gt_trans : (n,m,p:Z)`m<=n`->`m>p`->`n>p`.
+Lemma Zle_gt_trans : forall n m p:Z, m <= n -> m > p -> n > p.
Proof.
-Intros n m p H1 H2; NewDestruct (Zle_lt_or_eq m n H1) as [Hlt|Heq]; [
- Apply Zgt_trans with m; [Apply Zlt_gt; Assumption | Assumption ]
-| Rewrite <- Heq; Assumption ].
+intros n m p H1 H2; destruct (Zle_lt_or_eq m n H1) as [Hlt| Heq];
+ [ apply Zgt_trans with m; [ apply Zlt_gt; assumption | assumption ]
+ | rewrite <- Heq; assumption ].
Qed.
-Lemma Zgt_le_trans : (n,m,p:Z)`n>m`->`p<=m`->`n>p`.
+Lemma Zgt_le_trans : forall n m p:Z, n > m -> p <= m -> n > p.
Proof.
-Intros n m p H1 H2; NewDestruct (Zle_lt_or_eq p m H2) as [Hlt|Heq]; [
- Apply Zgt_trans with m; [Assumption|Apply Zlt_gt; Assumption]
-| Rewrite Heq; Assumption ].
+intros n m p H1 H2; destruct (Zle_lt_or_eq p m H2) as [Hlt| Heq];
+ [ apply Zgt_trans with m; [ assumption | apply Zlt_gt; assumption ]
+ | rewrite Heq; assumption ].
Qed.
-Lemma Zlt_le_trans : (n,m,p:Z)`n<m`->`m<=p`->`n<p`.
-Intros n m p H1 H2;Apply Zgt_lt;Apply Zle_gt_trans with m:=m;
- [ Assumption | Apply Zlt_gt;Assumption ].
+Lemma Zlt_le_trans : forall n m p:Z, n < m -> m <= p -> n < p.
+intros n m p H1 H2; apply Zgt_lt; apply Zle_gt_trans with (m := m);
+ [ assumption | apply Zlt_gt; assumption ].
Qed.
-Lemma Zle_lt_trans : (n,m,p:Z)`n<=m`->`m<p`->`n<p`.
+Lemma Zle_lt_trans : forall n m p:Z, n <= m -> m < p -> n < p.
Proof.
-Intros n m p H1 H2;Apply Zgt_lt;Apply Zgt_le_trans with m:=m;
- [ Apply Zlt_gt;Assumption | Assumption ].
+intros n m p H1 H2; apply Zgt_lt; apply Zgt_le_trans with (m := m);
+ [ apply Zlt_gt; assumption | assumption ].
Qed.
(** Transitivity of large orders *)
-Lemma Zle_trans : (n,m,p:Z)`n<=m`->`m<=p`->`n<=p`.
+Lemma Zle_trans : forall n m p:Z, n <= m -> m <= p -> n <= p.
Proof.
-Intros n m p H1 H2; Apply not_Zgt.
-Intro Hgt; Apply Zle_not_gt with n m. Assumption.
-Exact (Zgt_le_trans n p m Hgt H2).
+intros n m p H1 H2; apply Znot_gt_le.
+intro Hgt; apply Zle_not_gt with n m. assumption.
+exact (Zgt_le_trans n p m Hgt H2).
Qed.
-Lemma Zge_trans : (n, m, p : Z) `n>=m` -> `m>=p` -> `n>=p`.
+Lemma Zge_trans : forall n m p:Z, n >= m -> m >= p -> n >= p.
Proof.
-Intros n m p H1 H2.
-Apply Zle_ge.
-Apply Zle_trans with m; Apply Zge_le; Trivial.
+intros n m p H1 H2.
+apply Zle_ge.
+apply Zle_trans with m; apply Zge_le; trivial.
Qed.
-Hints Resolve Zle_trans : zarith.
+Hint Resolve Zle_trans: zarith.
(** Compatibility of successor wrt to order *)
-Lemma Zle_n_S : (n,m:Z) `m<=n` -> `(Zs m)<=(Zs n)`.
+Lemma Zsucc_le_compat : forall n m:Z, m <= n -> Zsucc m <= Zsucc n.
Proof.
-Unfold Zle not ;Intros m n H1 H2; Apply H1;
-Rewrite <- (Zcompare_Zplus_compatible n m (POS xH));
-Do 2 Rewrite (Zplus_sym (POS xH)); Exact H2.
+unfold Zle, not in |- *; intros m n H1 H2; apply H1;
+ rewrite <- (Zcompare_plus_compat n m 1); do 2 rewrite (Zplus_comm 1);
+ exact H2.
Qed.
-Lemma Zgt_n_S : (n,m:Z)`m>n` -> `(Zs m)>(Zs n)`.
+Lemma Zsucc_gt_compat : forall n m:Z, m > n -> Zsucc m > Zsucc n.
Proof.
-Unfold Zgt; Intros n m H; Rewrite Zcompare_n_S; Auto with arith.
+unfold Zgt in |- *; intros n m H; rewrite Zcompare_succ_compat;
+ auto with arith.
Qed.
-Lemma Zlt_n_S : (n,m:Z)`n<m`->`(Zs n)<(Zs m)`.
+Lemma Zsucc_lt_compat : forall n m:Z, n < m -> Zsucc n < Zsucc m.
Proof.
-Intros n m H;Apply Zgt_lt;Apply Zgt_n_S;Apply Zlt_gt; Assumption.
+intros n m H; apply Zgt_lt; apply Zsucc_gt_compat; apply Zlt_gt; assumption.
Qed.
-Hints Resolve Zle_n_S : zarith.
+Hint Resolve Zsucc_le_compat: zarith.
(** Simplification of successor wrt to order *)
-Lemma Zgt_S_n : (n,p:Z)`(Zs p)>(Zs n)`->`p>n`.
+Lemma Zsucc_gt_reg : forall n m:Z, Zsucc m > Zsucc n -> m > n.
Proof.
-Unfold Zs Zgt;Intros n p;Do 2 Rewrite -> [m:Z](Zplus_sym m (POS xH));
-Rewrite -> (Zcompare_Zplus_compatible p n (POS xH));Trivial with arith.
+unfold Zsucc, Zgt in |- *; intros n p;
+ do 2 rewrite (fun m:Z => Zplus_comm m 1);
+ rewrite (Zcompare_plus_compat p n 1); trivial with arith.
Qed.
-Lemma Zle_S_n : (n,m:Z) `(Zs m)<=(Zs n)` -> `m<=n`.
+Lemma Zsucc_le_reg : forall n m:Z, Zsucc m <= Zsucc n -> m <= n.
Proof.
-Unfold Zle not ;Intros m n H1 H2;Apply H1;
-Unfold Zs ;Do 2 Rewrite <- (Zplus_sym (POS xH));
-Rewrite -> (Zcompare_Zplus_compatible n m (POS xH));Assumption.
+unfold Zle, not in |- *; intros m n H1 H2; apply H1; unfold Zsucc in |- *;
+ do 2 rewrite <- (Zplus_comm 1); rewrite (Zcompare_plus_compat n m 1);
+ assumption.
Qed.
-Lemma Zlt_S_n : (n,m:Z)`(Zs n)<(Zs m)`->`n<m`.
+Lemma Zsucc_lt_reg : forall n m:Z, Zsucc n < Zsucc m -> n < m.
Proof.
-Intros n m H;Apply Zgt_lt;Apply Zgt_S_n;Apply Zlt_gt; Assumption.
+intros n m H; apply Zgt_lt; apply Zsucc_gt_reg; apply Zlt_gt; assumption.
Qed.
(** Compatibility of addition wrt to order *)
-Lemma Zgt_reg_l : (n,m,p:Z)`n>m`->`p+n>p+m`.
+Lemma Zplus_gt_compat_l : forall n m p:Z, n > m -> p + n > p + m.
Proof.
-Unfold Zgt; Intros n m p H; Rewrite (Zcompare_Zplus_compatible n m p);
-Assumption.
+unfold Zgt in |- *; intros n m p H; rewrite (Zcompare_plus_compat n m p);
+ assumption.
Qed.
-Lemma Zgt_reg_r : (n,m,p:Z)`n>m`->`n+p>m+p`.
+Lemma Zplus_gt_compat_r : forall n m p:Z, n > m -> n + p > m + p.
Proof.
-Intros n m p H; Rewrite (Zplus_sym n p); Rewrite (Zplus_sym m p); Apply Zgt_reg_l; Trivial.
+intros n m p H; rewrite (Zplus_comm n p); rewrite (Zplus_comm m p);
+ apply Zplus_gt_compat_l; trivial.
Qed.
-Lemma Zle_reg_l : (n,m,p:Z)`n<=m`->`p+n<=p+m`.
+Lemma Zplus_le_compat_l : forall n m p:Z, n <= m -> p + n <= p + m.
Proof.
-Intros n m p; Unfold Zle not ;Intros H1 H2;Apply H1;
-Rewrite <- (Zcompare_Zplus_compatible n m p); Assumption.
+intros n m p; unfold Zle, not in |- *; intros H1 H2; apply H1;
+ rewrite <- (Zcompare_plus_compat n m p); assumption.
Qed.
-Lemma Zle_reg_r : (n,m,p:Z) `n<=m`->`n+p<=m+p`.
+Lemma Zplus_le_compat_r : forall n m p:Z, n <= m -> n + p <= m + p.
Proof.
-Intros a b c;Do 2 Rewrite [n:Z](Zplus_sym n c); Exact (Zle_reg_l a b c).
+intros a b c; do 2 rewrite (fun n:Z => Zplus_comm n c);
+ exact (Zplus_le_compat_l a b c).
Qed.
-Lemma Zlt_reg_l : (n,m,p:Z)`n<m`->`p+n<p+m`.
+Lemma Zplus_lt_compat_l : forall n m p:Z, n < m -> p + n < p + m.
Proof.
-Unfold Zlt ;Intros n m p; Rewrite Zcompare_Zplus_compatible;Trivial with arith.
+unfold Zlt in |- *; intros n m p; rewrite Zcompare_plus_compat;
+ trivial with arith.
Qed.
-Lemma Zlt_reg_r : (n,m,p:Z)`n<m`->`n+p<m+p`.
+Lemma Zplus_lt_compat_r : forall n m p:Z, n < m -> n + p < m + p.
Proof.
-Intros n m p H; Rewrite (Zplus_sym n p); Rewrite (Zplus_sym m p); Apply Zlt_reg_l; Trivial.
+intros n m p H; rewrite (Zplus_comm n p); rewrite (Zplus_comm m p);
+ apply Zplus_lt_compat_l; trivial.
Qed.
-Lemma Zlt_le_reg : (a,b,c,d:Z) `a<b`->`c<=d`->`a+c<b+d`.
+Lemma Zplus_lt_le_compat : forall n m p q:Z, n < m -> p <= q -> n + p < m + q.
Proof.
-Intros a b c d H0 H1.
-Apply Zlt_le_trans with (Zplus b c).
-Apply Zlt_reg_r; Trivial.
-Apply Zle_reg_l; Trivial.
+intros a b c d H0 H1.
+apply Zlt_le_trans with (b + c).
+apply Zplus_lt_compat_r; trivial.
+apply Zplus_le_compat_l; trivial.
Qed.
-Lemma Zle_lt_reg : (a,b,c,d:Z) `a<=b`->`c<d`->`a+c<b+d`.
+Lemma Zplus_le_lt_compat : forall n m p q:Z, n <= m -> p < q -> n + p < m + q.
Proof.
-Intros a b c d H0 H1.
-Apply Zle_lt_trans with (Zplus b c).
-Apply Zle_reg_r; Trivial.
-Apply Zlt_reg_l; Trivial.
+intros a b c d H0 H1.
+apply Zle_lt_trans with (b + c).
+apply Zplus_le_compat_r; trivial.
+apply Zplus_lt_compat_l; trivial.
Qed.
-Lemma Zle_plus_plus : (n,m,p,q:Z) `n<=m`->(Zle p q)->`n+p<=m+q`.
+Lemma Zplus_le_compat : forall n m p q:Z, n <= m -> p <= q -> n + p <= m + q.
Proof.
-Intros n m p q; Intros H1 H2;Apply Zle_trans with m:=(Zplus n q); [
- Apply Zle_reg_l;Assumption | Apply Zle_reg_r;Assumption ].
+intros n m p q; intros H1 H2; apply Zle_trans with (m := n + q);
+ [ apply Zplus_le_compat_l; assumption
+ | apply Zplus_le_compat_r; assumption ].
Qed.
-V7only [Set Implicit Arguments.].
-Lemma Zlt_Zplus : (x1,x2,y1,y2:Z)`x1 < x2` -> `y1 < y2` -> `x1 + y1 < x2 + y2`.
-Intros; Apply Zle_lt_reg. Apply Zlt_le_weak; Assumption. Assumption.
+Lemma Zplus_lt_compat : forall n m p q:Z, n < m -> p < q -> n + p < m + q.
+intros; apply Zplus_le_lt_compat. apply Zlt_le_weak; assumption. assumption.
Qed.
-V7only [Unset Implicit Arguments.].
(** Compatibility of addition wrt to being positive *)
-Lemma Zle_0_plus : (x,y:Z) `0<=x` -> `0<=y` -> `0<=x+y`.
+Lemma Zplus_le_0_compat : forall n m:Z, 0 <= n -> 0 <= m -> 0 <= n + m.
Proof.
-Intros x y H1 H2;Rewrite <- (Zero_left ZERO); Apply Zle_plus_plus; Assumption.
+intros x y H1 H2; rewrite <- (Zplus_0_l 0); apply Zplus_le_compat; assumption.
Qed.
(** Simplification of addition wrt to order *)
-Lemma Zsimpl_gt_plus_l : (n,m,p:Z)`p+n>p+m`->`n>m`.
+Lemma Zplus_gt_reg_l : forall n m p:Z, p + n > p + m -> n > m.
Proof.
-Unfold Zgt; Intros n m p H;
- Rewrite <- (Zcompare_Zplus_compatible n m p); Assumption.
+unfold Zgt in |- *; intros n m p H; rewrite <- (Zcompare_plus_compat n m p);
+ assumption.
Qed.
-Lemma Zsimpl_gt_plus_r : (n,m,p:Z)`n+p>m+p`->`n>m`.
+Lemma Zplus_gt_reg_r : forall n m p:Z, n + p > m + p -> n > m.
Proof.
-Intros n m p H; Apply Zsimpl_gt_plus_l with p.
-Rewrite (Zplus_sym p n); Rewrite (Zplus_sym p m); Trivial.
+intros n m p H; apply Zplus_gt_reg_l with p.
+rewrite (Zplus_comm p n); rewrite (Zplus_comm p m); trivial.
Qed.
-Lemma Zsimpl_le_plus_l : (n,m,p:Z)`p+n<=p+m`->`n<=m`.
+Lemma Zplus_le_reg_l : forall n m p:Z, p + n <= p + m -> n <= m.
Proof.
-Intros n m p; Unfold Zle not ;Intros H1 H2;Apply H1;
-Rewrite (Zcompare_Zplus_compatible n m p); Assumption.
+intros n m p; unfold Zle, not in |- *; intros H1 H2; apply H1;
+ rewrite (Zcompare_plus_compat n m p); assumption.
Qed.
-Lemma Zsimpl_le_plus_r : (n,m,p:Z)`n+p<=m+p`->`n<=m`.
+Lemma Zplus_le_reg_r : forall n m p:Z, n + p <= m + p -> n <= m.
Proof.
-Intros n m p H; Apply Zsimpl_le_plus_l with p.
-Rewrite (Zplus_sym p n); Rewrite (Zplus_sym p m); Trivial.
+intros n m p H; apply Zplus_le_reg_l with p.
+rewrite (Zplus_comm p n); rewrite (Zplus_comm p m); trivial.
Qed.
-Lemma Zsimpl_lt_plus_l : (n,m,p:Z)`p+n<p+m`->`n<m`.
+Lemma Zplus_lt_reg_l : forall n m p:Z, p + n < p + m -> n < m.
Proof.
-Unfold Zlt ;Intros n m p;
- Rewrite Zcompare_Zplus_compatible;Trivial with arith.
+unfold Zlt in |- *; intros n m p; rewrite Zcompare_plus_compat;
+ trivial with arith.
Qed.
-Lemma Zsimpl_lt_plus_r : (n,m,p:Z)`n+p<m+p`->`n<m`.
+Lemma Zplus_lt_reg_r : forall n m p:Z, n + p < m + p -> n < m.
Proof.
-Intros n m p H; Apply Zsimpl_lt_plus_l with p.
-Rewrite (Zplus_sym p n); Rewrite (Zplus_sym p m); Trivial.
+intros n m p H; apply Zplus_lt_reg_l with p.
+rewrite (Zplus_comm p n); rewrite (Zplus_comm p m); trivial.
Qed.
(** Special base instances of order *)
-Lemma Zgt_Sn_n : (n:Z)`(Zs n)>n`.
+Lemma Zgt_succ : forall n:Z, Zsucc n > n.
Proof.
-Exact Zcompare_Zs_SUPERIEUR.
+exact Zcompare_succ_Gt.
Qed.
-Lemma Zle_Sn_n : (n:Z)~`(Zs n)<=n`.
+Lemma Znot_le_succ : forall n:Z, ~ Zsucc n <= n.
Proof.
-Intros n; Apply Zgt_not_le; Apply Zgt_Sn_n.
+intros n; apply Zgt_not_le; apply Zgt_succ.
Qed.
-Lemma Zlt_n_Sn : (n:Z)`n<(Zs n)`.
+Lemma Zlt_succ : forall n:Z, n < Zsucc n.
Proof.
-Intro n; Apply Zgt_lt; Apply Zgt_Sn_n.
+intro n; apply Zgt_lt; apply Zgt_succ.
Qed.
-Lemma Zlt_pred_n_n : (n:Z)`(Zpred n)<n`.
+Lemma Zlt_pred : forall n:Z, Zpred n < n.
Proof.
-Intros n; Apply Zlt_S_n; Rewrite <- Zs_pred; Apply Zlt_n_Sn.
+intros n; apply Zsucc_lt_reg; rewrite <- Zsucc_pred; apply Zlt_succ.
Qed.
(** Relating strict and large order using successor or predecessor *)
-Lemma Zgt_le_S : (n,p:Z)`p>n`->`(Zs n)<=p`.
+Lemma Zgt_le_succ : forall n m:Z, m > n -> Zsucc n <= m.
Proof.
-Unfold Zgt Zle; Intros n p H; Elim (Zcompare_et_un p n); Intros H1 H2;
-Unfold not ;Intros H3; Unfold not in H1; Apply H1; [
- Assumption
-| Elim (Zcompare_ANTISYM (Zplus n (POS xH)) p);Intros H4 H5;Apply H4;Exact H3].
+unfold Zgt, Zle in |- *; intros n p H; elim (Zcompare_Gt_not_Lt p n);
+ intros H1 H2; unfold not in |- *; intros H3; unfold not in H1;
+ apply H1;
+ [ assumption
+ | elim (Zcompare_Gt_Lt_antisym (n + 1) p); intros H4 H5; apply H4; exact H3 ].
Qed.
-Lemma Zle_gt_S : (n,p:Z)`n<=p`->`(Zs p)>n`.
+Lemma Zlt_gt_succ : forall n m:Z, n <= m -> Zsucc m > n.
Proof.
-Intros n p H; Apply Zgt_le_trans with p.
- Apply Zgt_Sn_n.
- Assumption.
+intros n p H; apply Zgt_le_trans with p.
+ apply Zgt_succ.
+ assumption.
Qed.
-Lemma Zle_lt_n_Sm : (n,m:Z)`n<=m`->`n<(Zs m)`.
+Lemma Zle_lt_succ : forall n m:Z, n <= m -> n < Zsucc m.
Proof.
-Intros n m H; Apply Zgt_lt; Apply Zle_gt_S; Assumption.
+intros n m H; apply Zgt_lt; apply Zlt_gt_succ; assumption.
Qed.
-Lemma Zlt_le_S : (n,p:Z)`n<p`->`(Zs n)<=p`.
+Lemma Zlt_le_succ : forall n m:Z, n < m -> Zsucc n <= m.
Proof.
-Intros n p H; Apply Zgt_le_S; Apply Zlt_gt; Assumption.
+intros n p H; apply Zgt_le_succ; apply Zlt_gt; assumption.
Qed.
-Lemma Zgt_S_le : (n,p:Z)`(Zs p)>n`->`n<=p`.
+Lemma Zgt_succ_le : forall n m:Z, Zsucc m > n -> n <= m.
Proof.
-Intros n p H;Apply Zle_S_n; Apply Zgt_le_S; Assumption.
+intros n p H; apply Zsucc_le_reg; apply Zgt_le_succ; assumption.
Qed.
-Lemma Zlt_n_Sm_le : (n,m:Z)`n<(Zs m)`->`n<=m`.
+Lemma Zlt_succ_le : forall n m:Z, n < Zsucc m -> n <= m.
Proof.
-Intros n m H; Apply Zgt_S_le; Apply Zlt_gt; Assumption.
+intros n m H; apply Zgt_succ_le; apply Zlt_gt; assumption.
Qed.
-Lemma Zle_S_gt : (n,m:Z) `(Zs n)<=m` -> `m>n`.
+Lemma Zlt_succ_gt : forall n m:Z, Zsucc n <= m -> m > n.
Proof.
-Intros n m H;Apply Zle_gt_trans with m:=(Zs n);
- [ Assumption | Apply Zgt_Sn_n ].
+intros n m H; apply Zle_gt_trans with (m := Zsucc n);
+ [ assumption | apply Zgt_succ ].
Qed.
(** Weakening order *)
-Lemma Zle_n_Sn : (n:Z)`n<=(Zs n)`.
+Lemma Zle_succ : forall n:Z, n <= Zsucc n.
Proof.
-Intros n; Apply Zgt_S_le;Apply Zgt_trans with m:=(Zs n) ;Apply Zgt_Sn_n.
+intros n; apply Zgt_succ_le; apply Zgt_trans with (m := Zsucc n);
+ apply Zgt_succ.
Qed.
-Hints Resolve Zle_n_Sn : zarith.
+Hint Resolve Zle_succ: zarith.
-Lemma Zle_pred_n : (n:Z)`(Zpred n)<=n`.
+Lemma Zle_pred : forall n:Z, Zpred n <= n.
Proof.
-Intros n;Pattern 2 n ;Rewrite Zs_pred; Apply Zle_n_Sn.
+intros n; pattern n at 2 in |- *; rewrite Zsucc_pred; apply Zle_succ.
Qed.
-Lemma Zlt_S : (n,m:Z)`n<m`->`n<(Zs m)`.
-Intros n m H;Apply Zgt_lt; Apply Zgt_trans with m:=m; [
- Apply Zgt_Sn_n
-| Apply Zlt_gt; Assumption ].
+Lemma Zlt_lt_succ : forall n m:Z, n < m -> n < Zsucc m.
+intros n m H; apply Zgt_lt; apply Zgt_trans with (m := m);
+ [ apply Zgt_succ | apply Zlt_gt; assumption ].
Qed.
-Lemma Zle_le_S : (x,y:Z)`x<=y`->`x<=(Zs y)`.
+Lemma Zle_le_succ : forall n m:Z, n <= m -> n <= Zsucc m.
Proof.
-Intros x y H.
-Apply Zle_trans with y; Trivial with zarith.
+intros x y H.
+apply Zle_trans with y; trivial with zarith.
Qed.
-Lemma Zle_trans_S : (n,m:Z)`(Zs n)<=m`->`n<=m`.
+Lemma Zle_succ_le : forall n m:Z, Zsucc n <= m -> n <= m.
Proof.
-Intros n m H;Apply Zle_trans with m:=(Zs n); [ Apply Zle_n_Sn | Assumption ].
+intros n m H; apply Zle_trans with (m := Zsucc n);
+ [ apply Zle_succ | assumption ].
Qed.
-Hints Resolve Zle_le_S : zarith.
+Hint Resolve Zle_le_succ: zarith.
(** Relating order wrt successor and order wrt predecessor *)
-Lemma Zgt_pred : (n,p:Z)`p>(Zs n)`->`(Zpred p)>n`.
+Lemma Zgt_succ_pred : forall n m:Z, m > Zsucc n -> Zpred m > n.
Proof.
-Unfold Zgt Zs Zpred ;Intros n p H;
-Rewrite <- [x,y:Z](Zcompare_Zplus_compatible x y (POS xH));
-Rewrite (Zplus_sym p); Rewrite Zplus_assoc; Rewrite [x:Z](Zplus_sym x n);
-Simpl; Assumption.
+unfold Zgt, Zsucc, Zpred in |- *; intros n p H;
+ rewrite <- (fun x y => Zcompare_plus_compat x y 1);
+ rewrite (Zplus_comm p); rewrite Zplus_assoc;
+ rewrite (fun x => Zplus_comm x n); simpl in |- *;
+ assumption.
Qed.
-Lemma Zlt_pred : (n,p:Z)`(Zs n)<p`->`n<(Zpred p)`.
+Lemma Zlt_succ_pred : forall n m:Z, Zsucc n < m -> n < Zpred m.
Proof.
-Intros n p H;Apply Zlt_S_n; Rewrite <- Zs_pred; Assumption.
+intros n p H; apply Zsucc_lt_reg; rewrite <- Zsucc_pred; assumption.
Qed.
(** Relating strict order and large order on positive *)
-Lemma Zlt_ZERO_pred_le_ZERO : (n:Z) `0<n` -> `0<=(Zpred n)`.
-Intros x H.
-Rewrite (Zs_pred x) in H.
-Apply Zgt_S_le.
-Apply Zlt_gt.
-Assumption.
+Lemma Zlt_0_le_0_pred : forall n:Z, 0 < n -> 0 <= Zpred n.
+intros x H.
+rewrite (Zsucc_pred x) in H.
+apply Zgt_succ_le.
+apply Zlt_gt.
+assumption.
Qed.
-V7only [Set Implicit Arguments.].
-Lemma Zgt0_le_pred : (y:Z) `y > 0` -> `0 <= (Zpred y)`.
-Intros; Apply Zlt_ZERO_pred_le_ZERO; Apply Zgt_lt. Assumption.
+Lemma Zgt_0_le_0_pred : forall n:Z, n > 0 -> 0 <= Zpred n.
+intros; apply Zlt_0_le_0_pred; apply Zgt_lt. assumption.
Qed.
-V7only [Unset Implicit Arguments.].
(** Special cases of ordered integers *)
-V7only [ (* Relevance confirmed from Zdivides *) ].
-Lemma Z_O_1: `0<1`.
+Lemma Zlt_0_1 : 0 < 1.
Proof.
-Change `0<(Zs 0)`. Apply Zlt_n_Sn.
+change (0 < Zsucc 0) in |- *. apply Zlt_succ.
Qed.
-Lemma Zle_0_1: `0<=1`.
+Lemma Zle_0_1 : 0 <= 1.
Proof.
-Change `0<=(Zs 0)`. Apply Zle_n_Sn.
+change (0 <= Zsucc 0) in |- *. apply Zle_succ.
Qed.
-V7only [ (* Relevance confirmed from Zdivides *) ].
-Lemma Zle_NEG_POS: (p,q:positive) `(NEG p)<=(POS q)`.
+Lemma Zle_neg_pos : forall p q:positive, Zneg p <= Zpos q.
Proof.
-Intros p; Red; Simpl; Red; Intros H; Discriminate.
+intros p; red in |- *; simpl in |- *; red in |- *; intros H; discriminate.
Qed.
-Lemma POS_gt_ZERO : (p:positive) `(POS p)>0`.
-Unfold Zgt; Trivial.
+Lemma Zgt_pos_0 : forall p:positive, Zpos p > 0.
+unfold Zgt in |- *; trivial.
Qed.
(* weaker but useful (in [Zpower] for instance) *)
-Lemma ZERO_le_POS : (p:positive) `0<=(POS p)`.
-Intro; Unfold Zle; Discriminate.
+Lemma Zle_0_pos : forall p:positive, 0 <= Zpos p.
+intro; unfold Zle in |- *; discriminate.
Qed.
-Lemma NEG_lt_ZERO : (p:positive)`(NEG p)<0`.
-Unfold Zlt; Trivial.
+Lemma Zlt_neg_0 : forall p:positive, Zneg p < 0.
+unfold Zlt in |- *; trivial.
Qed.
-Lemma ZERO_le_inj :
- (n:nat) `0 <= (inject_nat n)`.
-Induction n; Simpl; Intros;
-[ Apply Zle_n
-| Unfold Zle; Simpl; Discriminate].
+Lemma Zle_0_nat : forall n:nat, 0 <= Z_of_nat n.
+simple induction n; simpl in |- *; intros;
+ [ apply Zle_refl | unfold Zle in |- *; simpl in |- *; discriminate ].
Qed.
-Hints Immediate Zle_refl : zarith.
+Hint Immediate Zeq_le: zarith.
(** Transitivity using successor *)
-Lemma Zgt_trans_S : (n,m,p:Z)`(Zs n)>m`->`m>p`->`n>p`.
+Lemma Zge_trans_succ : forall n m p:Z, Zsucc n > m -> m > p -> n > p.
Proof.
-Intros n m p H1 H2;Apply Zle_gt_trans with m:=m;
- [ Apply Zgt_S_le; Assumption | Assumption ].
+intros n m p H1 H2; apply Zle_gt_trans with (m := m);
+ [ apply Zgt_succ_le; assumption | assumption ].
Qed.
(** Derived lemma *)
-Lemma Zgt_S : (n,m:Z)`(Zs n)>m`->(`n>m`\/(m=n)).
+Lemma Zgt_succ_gt_or_eq : forall n m:Z, Zsucc n > m -> n > m \/ m = n.
Proof.
-Intros n m H.
-Assert Hle : `m<=n`.
- Apply Zgt_S_le; Assumption.
-NewDestruct (Zle_lt_or_eq ? ? Hle) as [Hlt|Heq].
- Left; Apply Zlt_gt; Assumption.
- Right; Assumption.
+intros n m H.
+assert (Hle : m <= n).
+ apply Zgt_succ_le; assumption.
+destruct (Zle_lt_or_eq _ _ Hle) as [Hlt| Heq].
+ left; apply Zlt_gt; assumption.
+ right; assumption.
Qed.
(** Compatibility of multiplication by a positive wrt to order *)
-V7only [Set Implicit Arguments.].
-Lemma Zle_Zmult_pos_right : (a,b,c : Z) `a<=b` -> `0<=c` -> `a*c<=b*c`.
+Lemma Zmult_le_compat_r : forall n m p:Z, n <= m -> 0 <= p -> n * p <= m * p.
Proof.
-Intros a b c H H0; NewDestruct c.
- Do 2 Rewrite Zero_mult_right; Assumption.
- Rewrite (Zmult_sym a); Rewrite (Zmult_sym b).
- Unfold Zle; Rewrite Zcompare_Zmult_compatible; Assumption.
- Unfold Zle in H0; Contradiction H0; Reflexivity.
+intros a b c H H0; destruct c.
+ do 2 rewrite Zmult_0_r; assumption.
+ rewrite (Zmult_comm a); rewrite (Zmult_comm b).
+ unfold Zle in |- *; rewrite Zcompare_mult_compat; assumption.
+ unfold Zle in H0; contradiction H0; reflexivity.
Qed.
-Lemma Zle_Zmult_pos_left : (a,b,c : Z) `a<=b` -> `0<=c` -> `c*a<=c*b`.
+Lemma Zmult_le_compat_l : forall n m p:Z, n <= m -> 0 <= p -> p * n <= p * m.
Proof.
-Intros a b c H1 H2; Rewrite (Zmult_sym c a);Rewrite (Zmult_sym c b).
-Apply Zle_Zmult_pos_right; Trivial.
+intros a b c H1 H2; rewrite (Zmult_comm c a); rewrite (Zmult_comm c b).
+apply Zmult_le_compat_r; trivial.
Qed.
-V7only [ (* Relevance confirmed from Zextensions *) ].
-Lemma Zmult_lt_compat_r : (x,y,z:Z)`0<z` -> `x < y` -> `x*z < y*z`.
+Lemma Zmult_lt_compat_r : forall n m p:Z, 0 < p -> n < m -> n * p < m * p.
Proof.
-Intros x y z H H0; NewDestruct z.
- Contradiction (Zlt_n_n `0`).
- Rewrite (Zmult_sym x); Rewrite (Zmult_sym y).
- Unfold Zlt; Rewrite Zcompare_Zmult_compatible; Assumption.
- Discriminate H.
-Save.
+intros x y z H H0; destruct z.
+ contradiction (Zlt_irrefl 0).
+ rewrite (Zmult_comm x); rewrite (Zmult_comm y).
+ unfold Zlt in |- *; rewrite Zcompare_mult_compat; assumption.
+ discriminate H.
+Qed.
-Lemma Zgt_Zmult_right : (x,y,z:Z)`z>0` -> `x > y` -> `x*z > y*z`.
+Lemma Zmult_gt_compat_r : forall n m p:Z, p > 0 -> n > m -> n * p > m * p.
Proof.
-Intros x y z; Intros; Apply Zlt_gt; Apply Zmult_lt_compat_r;
- Apply Zgt_lt; Assumption.
+intros x y z; intros; apply Zlt_gt; apply Zmult_lt_compat_r; apply Zgt_lt;
+ assumption.
Qed.
-Lemma Zlt_Zmult_right : (x,y,z:Z)`z>0` -> `x < y` -> `x*z < y*z`.
+Lemma Zmult_gt_0_lt_compat_r :
+ forall n m p:Z, p > 0 -> n < m -> n * p < m * p.
Proof.
-Intros x y z; Intros; Apply Zmult_lt_compat_r;
- [Apply Zgt_lt; Assumption | Assumption].
+intros x y z; intros; apply Zmult_lt_compat_r;
+ [ apply Zgt_lt; assumption | assumption ].
Qed.
-Lemma Zle_Zmult_right : (x,y,z:Z)`z>0` -> `x <= y` -> `x*z <= y*z`.
+Lemma Zmult_gt_0_le_compat_r :
+ forall n m p:Z, p > 0 -> n <= m -> n * p <= m * p.
Proof.
-Intros x y z Hz Hxy.
-Elim (Zle_lt_or_eq x y Hxy).
-Intros; Apply Zlt_le_weak.
-Apply Zlt_Zmult_right; Trivial.
-Intros; Apply Zle_refl.
-Rewrite H; Trivial.
+intros x y z Hz Hxy.
+elim (Zle_lt_or_eq x y Hxy).
+intros; apply Zlt_le_weak.
+apply Zmult_gt_0_lt_compat_r; trivial.
+intros; apply Zeq_le.
+rewrite H; trivial.
Qed.
-V7only [ (* Relevance confirmed from Zextensions *) ].
-Lemma Zmult_lt_0_le_compat_r : (x,y,z:Z)`0 < z`->`x <= y`->`x*z <= y*z`.
+Lemma Zmult_lt_0_le_compat_r :
+ forall n m p:Z, 0 < p -> n <= m -> n * p <= m * p.
Proof.
-Intros x y z; Intros; Apply Zle_Zmult_right; Try Apply Zlt_gt; Assumption.
+intros x y z; intros; apply Zmult_gt_0_le_compat_r; try apply Zlt_gt;
+ assumption.
Qed.
-Lemma Zlt_Zmult_left : (x,y,z:Z)`z>0` -> `x < y` -> `z*x < z*y`.
+Lemma Zmult_gt_0_lt_compat_l :
+ forall n m p:Z, p > 0 -> n < m -> p * n < p * m.
Proof.
-Intros x y z; Intros.
-Rewrite (Zmult_sym z x); Rewrite (Zmult_sym z y);
-Apply Zlt_Zmult_right; Assumption.
+intros x y z; intros.
+rewrite (Zmult_comm z x); rewrite (Zmult_comm z y);
+ apply Zmult_gt_0_lt_compat_r; assumption.
Qed.
-V7only [ (* Relevance confirmed from Zextensions *) ].
-Lemma Zmult_lt_compat_l : (x,y,z:Z)`0<z` -> `x < y` -> `z*x < z*y`.
+Lemma Zmult_lt_compat_l : forall n m p:Z, 0 < p -> n < m -> p * n < p * m.
Proof.
-Intros x y z; Intros.
-Rewrite (Zmult_sym z x); Rewrite (Zmult_sym z y);
-Apply Zlt_Zmult_right; Try Apply Zlt_gt; Assumption.
-Save.
+intros x y z; intros.
+rewrite (Zmult_comm z x); rewrite (Zmult_comm z y);
+ apply Zmult_gt_0_lt_compat_r; try apply Zlt_gt; assumption.
+Qed.
-Lemma Zgt_Zmult_left : (x,y,z:Z)`z>0` -> `x > y` -> `z*x > z*y`.
+Lemma Zmult_gt_compat_l : forall n m p:Z, p > 0 -> n > m -> p * n > p * m.
Proof.
-Intros x y z; Intros;
-Rewrite (Zmult_sym z x); Rewrite (Zmult_sym z y);
-Apply Zgt_Zmult_right; Assumption.
+intros x y z; intros; rewrite (Zmult_comm z x); rewrite (Zmult_comm z y);
+ apply Zmult_gt_compat_r; assumption.
Qed.
-Lemma Zge_Zmult_pos_right : (a,b,c : Z) `a>=b` -> `c>=0` -> `a*c>=b*c`.
+Lemma Zmult_ge_compat_r : forall n m p:Z, n >= m -> p >= 0 -> n * p >= m * p.
Proof.
-Intros a b c H1 H2; Apply Zle_ge.
-Apply Zle_Zmult_pos_right; Apply Zge_le; Trivial.
+intros a b c H1 H2; apply Zle_ge.
+apply Zmult_le_compat_r; apply Zge_le; trivial.
Qed.
-Lemma Zge_Zmult_pos_left : (a,b,c : Z) `a>=b` -> `c>=0` -> `c*a>=c*b`.
+Lemma Zmult_ge_compat_l : forall n m p:Z, n >= m -> p >= 0 -> p * n >= p * m.
Proof.
-Intros a b c H1 H2; Apply Zle_ge.
-Apply Zle_Zmult_pos_left; Apply Zge_le; Trivial.
+intros a b c H1 H2; apply Zle_ge.
+apply Zmult_le_compat_l; apply Zge_le; trivial.
Qed.
-Lemma Zge_Zmult_pos_compat :
- (a,b,c,d : Z) `a>=c` -> `b>=d` -> `c>=0` -> `d>=0` -> `a*b>=c*d`.
+Lemma Zmult_ge_compat :
+ forall n m p q:Z, n >= p -> m >= q -> p >= 0 -> q >= 0 -> n * m >= p * q.
Proof.
-Intros a b c d H0 H1 H2 H3.
-Apply Zge_trans with (Zmult a d).
-Apply Zge_Zmult_pos_left; Trivial.
-Apply Zge_trans with c; Trivial.
-Apply Zge_Zmult_pos_right; Trivial.
+intros a b c d H0 H1 H2 H3.
+apply Zge_trans with (a * d).
+apply Zmult_ge_compat_l; trivial.
+apply Zge_trans with c; trivial.
+apply Zmult_ge_compat_r; trivial.
Qed.
-V7only [ (* Relevance confirmed from Zextensions *) ].
-Lemma Zmult_le_compat: (a, b, c, d : Z)
- `a<=c` -> `b<=d` -> `0<=a` -> `0<=b` -> `a*b<=c*d`.
+Lemma Zmult_le_compat :
+ forall n m p q:Z, n <= p -> m <= q -> 0 <= n -> 0 <= m -> n * m <= p * q.
Proof.
-Intros a b c d H0 H1 H2 H3.
-Apply Zle_trans with (Zmult c b).
-Apply Zle_Zmult_pos_right; Assumption.
-Apply Zle_Zmult_pos_left.
-Assumption.
-Apply Zle_trans with a; Assumption.
+intros a b c d H0 H1 H2 H3.
+apply Zle_trans with (c * b).
+apply Zmult_le_compat_r; assumption.
+apply Zmult_le_compat_l.
+assumption.
+apply Zle_trans with a; assumption.
Qed.
(** Simplification of multiplication by a positive wrt to being positive *)
-Lemma Zlt_Zmult_right2 : (x,y,z:Z)`z>0` -> `x*z < y*z` -> `x < y`.
+Lemma Zmult_gt_0_lt_reg_r : forall n m p:Z, p > 0 -> n * p < m * p -> n < m.
Proof.
-Intros x y z; Intros; NewDestruct z.
- Contradiction (Zgt_antirefl `0`).
- Rewrite (Zmult_sym x) in H0; Rewrite (Zmult_sym y) in H0.
- Unfold Zlt in H0; Rewrite Zcompare_Zmult_compatible in H0; Assumption.
- Discriminate H.
+intros x y z; intros; destruct z.
+ contradiction (Zgt_irrefl 0).
+ rewrite (Zmult_comm x) in H0; rewrite (Zmult_comm y) in H0.
+ unfold Zlt in H0; rewrite Zcompare_mult_compat in H0; assumption.
+ discriminate H.
Qed.
-V7only [ (* Relevance confirmed from Zextensions *) ].
-Lemma Zmult_lt_reg_r : (a, b, c : Z) `0<c` -> `a*c<b*c` -> `a<b`.
+Lemma Zmult_lt_reg_r : forall n m p:Z, 0 < p -> n * p < m * p -> n < m.
Proof.
-Intros a b c H0 H1.
-Apply Zlt_Zmult_right2 with c; Try Apply Zlt_gt; Assumption.
+intros a b c H0 H1.
+apply Zmult_gt_0_lt_reg_r with c; try apply Zlt_gt; assumption.
Qed.
-Lemma Zle_mult_simpl : (a,b,c:Z)`c>0`->`a*c<=b*c`->`a<=b`.
+Lemma Zmult_le_reg_r : forall n m p:Z, p > 0 -> n * p <= m * p -> n <= m.
Proof.
-Intros x y z Hz Hxy.
-Elim (Zle_lt_or_eq `x*z` `y*z` Hxy).
-Intros; Apply Zlt_le_weak.
-Apply Zlt_Zmult_right2 with z; Trivial.
-Intros; Apply Zle_refl.
-Apply Zmult_reg_right with z.
- Intro. Rewrite H0 in Hz. Contradiction (Zgt_antirefl `0`).
-Assumption.
+intros x y z Hz Hxy.
+elim (Zle_lt_or_eq (x * z) (y * z) Hxy).
+intros; apply Zlt_le_weak.
+apply Zmult_gt_0_lt_reg_r with z; trivial.
+intros; apply Zeq_le.
+apply Zmult_reg_r with z.
+ intro. rewrite H0 in Hz. contradiction (Zgt_irrefl 0).
+assumption.
Qed.
-V7only [Notation Zle_Zmult_right2 := Zle_mult_simpl.
-(* Zle_Zmult_right2 : (x,y,z:Z)`z>0` -> `x*z <= y*z` -> `x <= y`. *)
-].
-V7only [ (* Relevance confirmed from Zextensions *) ].
-Lemma Zmult_lt_0_le_reg_r: (x,y,z:Z)`0 <z`->`x*z <= y*z`->`x <= y`.
-Intros x y z; Intros ; Apply Zle_mult_simpl with z.
-Try Apply Zlt_gt; Assumption.
-Assumption.
+Lemma Zmult_lt_0_le_reg_r : forall n m p:Z, 0 < p -> n * p <= m * p -> n <= m.
+intros x y z; intros; apply Zmult_le_reg_r with z.
+try apply Zlt_gt; assumption.
+assumption.
Qed.
-V7only [Unset Implicit Arguments.].
-Lemma Zge_mult_simpl : (a,b,c:Z) `c>0`->`a*c>=b*c`->`a>=b`.
-Intros a b c H1 H2; Apply Zle_ge; Apply Zle_mult_simpl with c; Trivial.
-Apply Zge_le; Trivial.
+Lemma Zmult_ge_reg_r : forall n m p:Z, p > 0 -> n * p >= m * p -> n >= m.
+intros a b c H1 H2; apply Zle_ge; apply Zmult_le_reg_r with c; trivial.
+apply Zge_le; trivial.
Qed.
-Lemma Zgt_mult_simpl : (a,b,c:Z) `c>0`->`a*c>b*c`->`a>b`.
-Intros a b c H1 H2; Apply Zlt_gt; Apply Zlt_Zmult_right2 with c; Trivial.
-Apply Zgt_lt; Trivial.
+Lemma Zmult_gt_reg_r : forall n m p:Z, p > 0 -> n * p > m * p -> n > m.
+intros a b c H1 H2; apply Zlt_gt; apply Zmult_gt_0_lt_reg_r with c; trivial.
+apply Zgt_lt; trivial.
Qed.
(** Compatibility of multiplication by a positive wrt to being positive *)
-Lemma Zle_ZERO_mult : (x,y:Z) `0<=x` -> `0<=y` -> `0<=x*y`.
+Lemma Zmult_le_0_compat : forall n m:Z, 0 <= n -> 0 <= m -> 0 <= n * m.
Proof.
-Intros x y; Case x.
-Intros; Rewrite Zero_mult_left; Trivial.
-Intros p H1; Unfold Zle.
- Pattern 2 ZERO ; Rewrite <- (Zero_mult_right (POS p)).
- Rewrite Zcompare_Zmult_compatible; Trivial.
-Intros p H1 H2; Absurd (Zgt ZERO (NEG p)); Trivial.
-Unfold Zgt; Simpl; Auto with zarith.
+intros x y; case x.
+intros; rewrite Zmult_0_l; trivial.
+intros p H1; unfold Zle in |- *.
+ pattern 0 at 2 in |- *; rewrite <- (Zmult_0_r (Zpos p)).
+ rewrite Zcompare_mult_compat; trivial.
+intros p H1 H2; absurd (0 > Zneg p); trivial.
+unfold Zgt in |- *; simpl in |- *; auto with zarith.
Qed.
-Lemma Zgt_ZERO_mult: (a,b:Z) `a>0`->`b>0`->`a*b>0`.
+Lemma Zmult_gt_0_compat : forall n m:Z, n > 0 -> m > 0 -> n * m > 0.
Proof.
-Intros x y; Case x.
-Intros H; Discriminate H.
-Intros p H1; Unfold Zgt;
-Pattern 2 ZERO ; Rewrite <- (Zero_mult_right (POS p)).
- Rewrite Zcompare_Zmult_compatible; Trivial.
-Intros p H; Discriminate H.
+intros x y; case x.
+intros H; discriminate H.
+intros p H1; unfold Zgt in |- *; pattern 0 at 2 in |- *;
+ rewrite <- (Zmult_0_r (Zpos p)).
+ rewrite Zcompare_mult_compat; trivial.
+intros p H; discriminate H.
Qed.
-V7only [ (* Relevance confirmed from Zextensions *) ].
-Lemma Zmult_lt_O_compat : (a, b : Z) `0<a` -> `0<b` -> `0<a*b`.
-Intros a b apos bpos.
-Apply Zgt_lt.
-Apply Zgt_ZERO_mult; Try Apply Zlt_gt; Assumption.
+Lemma Zmult_lt_O_compat : forall n m:Z, 0 < n -> 0 < m -> 0 < n * m.
+intros a b apos bpos.
+apply Zgt_lt.
+apply Zmult_gt_0_compat; try apply Zlt_gt; assumption.
Qed.
-Lemma Zle_mult: (x,y:Z) `x>0` -> `0<=y` -> `0<=(Zmult y x)`.
+Lemma Zmult_gt_0_le_0_compat : forall n m:Z, n > 0 -> 0 <= m -> 0 <= m * n.
Proof.
-Intros x y H1 H2; Apply Zle_ZERO_mult; Trivial.
-Apply Zlt_le_weak; Apply Zgt_lt; Trivial.
+intros x y H1 H2; apply Zmult_le_0_compat; trivial.
+apply Zlt_le_weak; apply Zgt_lt; trivial.
Qed.
(** Simplification of multiplication by a positive wrt to being positive *)
-Lemma Zmult_le: (x,y:Z) `x>0` -> `0<=(Zmult y x)` -> `0<=y`.
+Lemma Zmult_le_0_reg_r : forall n m:Z, n > 0 -> 0 <= m * n -> 0 <= m.
Proof.
-Intros x y; Case x; [
- Simpl; Unfold Zgt ; Simpl; Intros H; Discriminate H
-| Intros p H1; Unfold Zle; Rewrite -> Zmult_sym;
- Pattern 1 ZERO ; Rewrite <- (Zero_mult_right (POS p));
- Rewrite Zcompare_Zmult_compatible; Auto with arith
-| Intros p; Unfold Zgt ; Simpl; Intros H; Discriminate H].
+intros x y; case x;
+ [ simpl in |- *; unfold Zgt in |- *; simpl in |- *; intros H; discriminate H
+ | intros p H1; unfold Zle in |- *; rewrite Zmult_comm;
+ pattern 0 at 1 in |- *; rewrite <- (Zmult_0_r (Zpos p));
+ rewrite Zcompare_mult_compat; auto with arith
+ | intros p; unfold Zgt in |- *; simpl in |- *; intros H; discriminate H ].
Qed.
-Lemma Zmult_lt: (x,y:Z) `x>0` -> `0<y*x` -> `0<y`.
+Lemma Zmult_gt_0_lt_0_reg_r : forall n m:Z, n > 0 -> 0 < m * n -> 0 < m.
Proof.
-Intros x y; Case x; [
- Simpl; Unfold Zgt ; Simpl; Intros H; Discriminate H
-| Intros p H1; Unfold Zlt; Rewrite -> Zmult_sym;
- Pattern 1 ZERO ; Rewrite <- (Zero_mult_right (POS p));
- Rewrite Zcompare_Zmult_compatible; Auto with arith
-| Intros p; Unfold Zgt ; Simpl; Intros H; Discriminate H].
+intros x y; case x;
+ [ simpl in |- *; unfold Zgt in |- *; simpl in |- *; intros H; discriminate H
+ | intros p H1; unfold Zlt in |- *; rewrite Zmult_comm;
+ pattern 0 at 1 in |- *; rewrite <- (Zmult_0_r (Zpos p));
+ rewrite Zcompare_mult_compat; auto with arith
+ | intros p; unfold Zgt in |- *; simpl in |- *; intros H; discriminate H ].
Qed.
-V7only [ (* Relevance confirmed from Zextensions *) ].
-Lemma Zmult_lt_0_reg_r : (x,y:Z)`0 < x`->`0 < y*x`->`0 < y`.
+Lemma Zmult_lt_0_reg_r : forall n m:Z, 0 < n -> 0 < m * n -> 0 < m.
Proof.
-Intros x y; Intros; EApply Zmult_lt with x ; Try Apply Zlt_gt; Assumption.
+intros x y; intros; eapply Zmult_gt_0_lt_0_reg_r with x; try apply Zlt_gt;
+ assumption.
Qed.
-Lemma Zmult_gt: (x,y:Z) `x>0` -> `x*y>0` -> `y>0`.
+Lemma Zmult_gt_0_reg_l : forall n m:Z, n > 0 -> n * m > 0 -> m > 0.
Proof.
-Intros x y; Case x.
- Intros H; Discriminate H.
- Intros p H1; Unfold Zgt.
- Pattern 1 ZERO ; Rewrite <- (Zero_mult_right (POS p)).
- Rewrite Zcompare_Zmult_compatible; Trivial.
-Intros p H; Discriminate H.
+intros x y; case x.
+ intros H; discriminate H.
+ intros p H1; unfold Zgt in |- *.
+ pattern 0 at 1 in |- *; rewrite <- (Zmult_0_r (Zpos p)).
+ rewrite Zcompare_mult_compat; trivial.
+intros p H; discriminate H.
Qed.
(** Simplification of square wrt order *)
-Lemma Zgt_square_simpl: (x, y : Z) `x>=0` -> `y>=0` -> `x*x>y*y` -> `x>y`.
+Lemma Zgt_square_simpl :
+ forall n m:Z, n >= 0 -> m >= 0 -> n * n > m * m -> n > m.
Proof.
-Intros x y H0 H1 H2.
-Case (dec_Zlt y x).
-Intro; Apply Zlt_gt; Trivial.
-Intros H3; Cut (Zge y x).
-Intros H.
-Elim Zgt_not_le with 1 := H2.
-Apply Zge_le.
-Apply Zge_Zmult_pos_compat; Auto.
-Apply not_Zlt; Trivial.
+intros x y H0 H1 H2.
+case (dec_Zlt y x).
+intro; apply Zlt_gt; trivial.
+intros H3; cut (y >= x).
+intros H.
+elim Zgt_not_le with (1 := H2).
+apply Zge_le.
+apply Zmult_ge_compat; auto.
+apply Znot_lt_ge; trivial.
Qed.
-Lemma Zlt_square_simpl: (x,y:Z) `0<=x` -> `0<=y` -> `y*y<x*x` -> `y<x`.
+Lemma Zlt_square_simpl :
+ forall n m:Z, 0 <= n -> 0 <= m -> m * m < n * n -> m < n.
Proof.
-Intros x y H0 H1 H2.
-Apply Zgt_lt.
-Apply Zgt_square_simpl; Try Apply Zle_ge; Try Apply Zlt_gt; Assumption.
+intros x y H0 H1 H2.
+apply Zgt_lt.
+apply Zgt_square_simpl; try apply Zle_ge; try apply Zlt_gt; assumption.
Qed.
(** Equivalence between inequalities *)
-Lemma Zle_plus_swap : (x,y,z:Z) `x+z<=y` <-> `x<=y-z`.
+Lemma Zle_plus_swap : forall n m p:Z, n + p <= m <-> n <= m - p.
Proof.
- Intros x y z; Intros. Split. Intro. Rewrite <- (Zero_right x). Rewrite <- (Zplus_inverse_r z).
- Rewrite Zplus_assoc_l. Exact (Zle_reg_r ? ? ? H).
- Intro. Rewrite <- (Zero_right y). Rewrite <- (Zplus_inverse_l z). Rewrite Zplus_assoc_l.
- Apply Zle_reg_r. Assumption.
+ intros x y z; intros. split. intro. rewrite <- (Zplus_0_r x). rewrite <- (Zplus_opp_r z).
+ rewrite Zplus_assoc. exact (Zplus_le_compat_r _ _ _ H).
+ intro. rewrite <- (Zplus_0_r y). rewrite <- (Zplus_opp_l z). rewrite Zplus_assoc.
+ apply Zplus_le_compat_r. assumption.
Qed.
-Lemma Zlt_plus_swap : (x,y,z:Z) `x+z<y` <-> `x<y-z`.
+Lemma Zlt_plus_swap : forall n m p:Z, n + p < m <-> n < m - p.
Proof.
- Intros x y z; Intros. Split. Intro. Unfold Zminus. Rewrite Zplus_sym. Rewrite <- (Zero_left x).
- Rewrite <- (Zplus_inverse_l z). Rewrite Zplus_assoc_r. Apply Zlt_reg_l. Rewrite Zplus_sym.
- Assumption.
- Intro. Rewrite Zplus_sym. Rewrite <- (Zero_left y). Rewrite <- (Zplus_inverse_r z).
- Rewrite Zplus_assoc_r. Apply Zlt_reg_l. Rewrite Zplus_sym. Assumption.
+ intros x y z; intros. split. intro. unfold Zminus in |- *. rewrite Zplus_comm. rewrite <- (Zplus_0_l x).
+ rewrite <- (Zplus_opp_l z). rewrite Zplus_assoc_reverse. apply Zplus_lt_compat_l. rewrite Zplus_comm.
+ assumption.
+ intro. rewrite Zplus_comm. rewrite <- (Zplus_0_l y). rewrite <- (Zplus_opp_r z).
+ rewrite Zplus_assoc_reverse. apply Zplus_lt_compat_l. rewrite Zplus_comm. assumption.
Qed.
-Lemma Zeq_plus_swap : (x,y,z:Z)`x+z=y` <-> `x=y-z`.
+Lemma Zeq_plus_swap : forall n m p:Z, n + p = m <-> n = m - p.
Proof.
-Intros x y z; Intros. Split. Intro. Apply Zplus_minus. Symmetry. Rewrite Zplus_sym.
- Assumption.
-Intro. Rewrite H. Unfold Zminus. Rewrite Zplus_assoc_r.
- Rewrite Zplus_inverse_l. Apply Zero_right.
+intros x y z; intros. split. intro. apply Zplus_minus_eq. symmetry in |- *. rewrite Zplus_comm.
+ assumption.
+intro. rewrite H. unfold Zminus in |- *. rewrite Zplus_assoc_reverse.
+ rewrite Zplus_opp_l. apply Zplus_0_r.
Qed.
-Lemma Zlt_minus : (n,m:Z)`0<m`->`n-m<n`.
+Lemma Zlt_minus_simpl_swap : forall n m:Z, 0 < m -> n - m < n.
Proof.
-Intros n m H; Apply Zsimpl_lt_plus_l with p:=m; Rewrite Zle_plus_minus;
-Pattern 1 n ;Rewrite <- (Zero_right n); Rewrite (Zplus_sym m n);
-Apply Zlt_reg_l; Assumption.
+intros n m H; apply Zplus_lt_reg_l with (p := m); rewrite Zplus_minus;
+ pattern n at 1 in |- *; rewrite <- (Zplus_0_r n);
+ rewrite (Zplus_comm m n); apply Zplus_lt_compat_l;
+ assumption.
Qed.
-Lemma Zlt_O_minus_lt : (n,m:Z)`0<n-m`->`m<n`.
+Lemma Zlt_O_minus_lt : forall n m:Z, 0 < n - m -> m < n.
Proof.
-Intros n m H; Apply Zsimpl_lt_plus_l with p:=(Zopp m); Rewrite Zplus_inverse_l;
-Rewrite Zplus_sym;Exact H.
-Qed.
+intros n m H; apply Zplus_lt_reg_l with (p := - m); rewrite Zplus_opp_l;
+ rewrite Zplus_comm; exact H.
+Qed. \ No newline at end of file
diff --git a/theories/ZArith/Zpower.v b/theories/ZArith/Zpower.v
index 73e8a08da..c19ef4499 100644
--- a/theories/ZArith/Zpower.v
+++ b/theories/ZArith/Zpower.v
@@ -8,10 +8,9 @@
(*i $Id$ i*)
-Require ZArith_base.
-Require Omega.
-Require Zcomplements.
-V7only [Import Z_scope.].
+Require Import ZArith_base.
+Require Import Omega.
+Require Import Zcomplements.
Open Local Scope Z_scope.
Section section1.
@@ -19,86 +18,85 @@ Section section1.
(** [Zpower_nat z n] is the n-th power of [z] when [n] is an unary
integer (type [nat]) and [z] a signed integer (type [Z]) *)
-Definition Zpower_nat :=
- [z:Z][n:nat] (iter_nat n Z ([x:Z]` z * x `) `1`).
+Definition Zpower_nat (z:Z) (n:nat) := iter_nat n Z (fun x:Z => z * x) 1.
(** [Zpower_nat_is_exp] says [Zpower_nat] is a morphism for
[plus : nat->nat] and [Zmult : Z->Z] *)
-Lemma Zpower_nat_is_exp :
- (n,m:nat)(z:Z)
- `(Zpower_nat z (plus n m)) = (Zpower_nat z n)*(Zpower_nat z m)`.
+Lemma Zpower_nat_is_exp :
+ forall (n m:nat) (z:Z),
+ Zpower_nat z (n + m) = Zpower_nat z n * Zpower_nat z m.
-Intros; Elim n;
-[ Simpl; Elim (Zpower_nat z m); Auto with zarith
-| Unfold Zpower_nat; Intros; Simpl; Rewrite H;
- Apply Zmult_assoc].
+intros; elim n;
+ [ simpl in |- *; elim (Zpower_nat z m); auto with zarith
+ | unfold Zpower_nat in |- *; intros; simpl in |- *; rewrite H;
+ apply Zmult_assoc ].
Qed.
(** [Zpower_pos z n] is the n-th power of [z] when [n] is an binary
integer (type [positive]) and [z] a signed integer (type [Z]) *)
-Definition Zpower_pos :=
- [z:Z][n:positive] (iter_pos n Z ([x:Z]`z * x`) `1`).
+Definition Zpower_pos (z:Z) (n:positive) := iter_pos n Z (fun x:Z => z * x) 1.
(** This theorem shows that powers of unary and binary integers
are the same thing, modulo the function convert : [positive -> nat] *)
-Theorem Zpower_pos_nat :
- (z:Z)(p:positive)(Zpower_pos z p) = (Zpower_nat z (convert p)).
+Theorem Zpower_pos_nat :
+ forall (z:Z) (p:positive), Zpower_pos z p = Zpower_nat z (nat_of_P p).
-Intros; Unfold Zpower_pos; Unfold Zpower_nat; Apply iter_convert.
+intros; unfold Zpower_pos in |- *; unfold Zpower_nat in |- *;
+ apply iter_nat_of_P.
Qed.
(** Using the theorem [Zpower_pos_nat] and the lemma [Zpower_nat_is_exp] we
deduce that the function [[n:positive](Zpower_pos z n)] is a morphism
for [add : positive->positive] and [Zmult : Z->Z] *)
-Theorem Zpower_pos_is_exp :
- (n,m:positive)(z:Z)
- ` (Zpower_pos z (add n m)) = (Zpower_pos z n)*(Zpower_pos z m)`.
+Theorem Zpower_pos_is_exp :
+ forall (n m:positive) (z:Z),
+ Zpower_pos z (n + m) = Zpower_pos z n * Zpower_pos z m.
-Intros.
-Rewrite -> (Zpower_pos_nat z n).
-Rewrite -> (Zpower_pos_nat z m).
-Rewrite -> (Zpower_pos_nat z (add n m)).
-Rewrite -> (convert_add n m).
-Apply Zpower_nat_is_exp.
+intros.
+rewrite (Zpower_pos_nat z n).
+rewrite (Zpower_pos_nat z m).
+rewrite (Zpower_pos_nat z (n + m)).
+rewrite (nat_of_P_plus_morphism n m).
+apply Zpower_nat_is_exp.
Qed.
-Definition Zpower :=
- [x,y:Z]Cases y of
- (POS p) => (Zpower_pos x p)
- | ZERO => `1`
- | (NEG p) => `0`
+Definition Zpower (x y:Z) :=
+ match y with
+ | Zpos p => Zpower_pos x p
+ | Z0 => 1
+ | Zneg p => 0
end.
-Infix "^" Zpower (at level 2, left associativity) : Z_scope V8only.
+Infix "^" := Zpower : Z_scope.
-Hints Immediate Zpower_nat_is_exp : zarith.
-Hints Immediate Zpower_pos_is_exp : zarith.
-Hints Unfold Zpower_pos : zarith.
-Hints Unfold Zpower_nat : zarith.
+Hint Immediate Zpower_nat_is_exp: zarith.
+Hint Immediate Zpower_pos_is_exp: zarith.
+Hint Unfold Zpower_pos: zarith.
+Hint Unfold Zpower_nat: zarith.
-Lemma Zpower_exp : (x:Z)(n,m:Z)
- `n >= 0` -> `m >= 0` -> `(Zpower x (n+m))=(Zpower x n)*(Zpower x m)`.
-NewDestruct n; NewDestruct m; Auto with zarith.
-Simpl; Intros; Apply Zred_factor0.
-Simpl; Auto with zarith.
-Intros; Compute in H0; Absurd INFERIEUR=INFERIEUR; Auto with zarith.
-Intros; Compute in H0; Absurd INFERIEUR=INFERIEUR; Auto with zarith.
+Lemma Zpower_exp :
+ forall x n m:Z, n >= 0 -> m >= 0 -> x ^ (n + m) = x ^ n * x ^ m.
+destruct n; destruct m; auto with zarith.
+simpl in |- *; intros; apply Zred_factor0.
+simpl in |- *; auto with zarith.
+intros; compute in H0; absurd (Datatypes.Lt = Datatypes.Lt); auto with zarith.
+intros; compute in H0; absurd (Datatypes.Lt = Datatypes.Lt); auto with zarith.
Qed.
End section1.
(* Exporting notation "^" *)
-Infix "^" Zpower (at level 2, left associativity) : Z_scope V8only.
+Infix "^" := Zpower : Z_scope.
-Hints Immediate Zpower_nat_is_exp : zarith.
-Hints Immediate Zpower_pos_is_exp : zarith.
-Hints Unfold Zpower_pos : zarith.
-Hints Unfold Zpower_nat : zarith.
+Hint Immediate Zpower_nat_is_exp: zarith.
+Hint Immediate Zpower_pos_is_exp: zarith.
+Hint Unfold Zpower_pos: zarith.
+Hint Unfold Zpower_nat: zarith.
Section Powers_of_2.
@@ -109,100 +107,96 @@ Section Powers_of_2.
(** [shift n m] computes [2^n * m], or [m] shifted by [n] positions *)
-Definition shift_nat :=
- [n:nat][z:positive](iter_nat n positive xO z).
-Definition shift_pos :=
- [n:positive][z:positive](iter_pos n positive xO z).
-Definition shift :=
- [n:Z][z:positive]
- Cases n of
- ZERO => z
- | (POS p) => (iter_pos p positive xO z)
- | (NEG p) => z
+Definition shift_nat (n:nat) (z:positive) := iter_nat n positive xO z.
+Definition shift_pos (n z:positive) := iter_pos n positive xO z.
+Definition shift (n:Z) (z:positive) :=
+ match n with
+ | Z0 => z
+ | Zpos p => iter_pos p positive xO z
+ | Zneg p => z
end.
-Definition two_power_nat := [n:nat] (POS (shift_nat n xH)).
-Definition two_power_pos := [x:positive] (POS (shift_pos x xH)).
+Definition two_power_nat (n:nat) := Zpos (shift_nat n 1).
+Definition two_power_pos (x:positive) := Zpos (shift_pos x 1).
-Lemma two_power_nat_S :
- (n:nat)` (two_power_nat (S n)) = 2*(two_power_nat n)`.
-Intro; Simpl; Apply refl_equal.
+Lemma two_power_nat_S :
+ forall n:nat, two_power_nat (S n) = 2 * two_power_nat n.
+intro; simpl in |- *; apply refl_equal.
Qed.
Lemma shift_nat_plus :
- (n,m:nat)(x:positive)
- (shift_nat (plus n m) x)=(shift_nat n (shift_nat m x)).
+ forall (n m:nat) (x:positive),
+ shift_nat (n + m) x = shift_nat n (shift_nat m x).
-Intros; Unfold shift_nat; Apply iter_nat_plus.
+intros; unfold shift_nat in |- *; apply iter_nat_plus.
Qed.
Theorem shift_nat_correct :
- (n:nat)(x:positive)(POS (shift_nat n x))=`(Zpower_nat 2 n)*(POS x)`.
-
-Unfold shift_nat; Induction n;
-[ Simpl; Trivial with zarith
-| Intros; Replace (Zpower_nat `2` (S n0)) with `2 * (Zpower_nat 2 n0)`;
-[ Rewrite <- Zmult_assoc; Rewrite <- (H x); Simpl; Reflexivity
-| Auto with zarith ]
-].
+ forall (n:nat) (x:positive), Zpos (shift_nat n x) = Zpower_nat 2 n * Zpos x.
+
+unfold shift_nat in |- *; simple induction n;
+ [ simpl in |- *; trivial with zarith
+ | intros; replace (Zpower_nat 2 (S n0)) with (2 * Zpower_nat 2 n0);
+ [ rewrite <- Zmult_assoc; rewrite <- (H x); simpl in |- *; reflexivity
+ | auto with zarith ] ].
Qed.
Theorem two_power_nat_correct :
- (n:nat)(two_power_nat n)=(Zpower_nat `2` n).
+ forall n:nat, two_power_nat n = Zpower_nat 2 n.
-Intro n.
-Unfold two_power_nat.
-Rewrite -> (shift_nat_correct n).
-Omega.
+intro n.
+unfold two_power_nat in |- *.
+rewrite (shift_nat_correct n).
+omega.
Qed.
(** Second we show that [two_power_pos] and [two_power_nat] are the same *)
-Lemma shift_pos_nat : (p:positive)(x:positive)
- (shift_pos p x)=(shift_nat (convert p) x).
+Lemma shift_pos_nat :
+ forall p x:positive, shift_pos p x = shift_nat (nat_of_P p) x.
-Unfold shift_pos.
-Unfold shift_nat.
-Intros; Apply iter_convert.
+unfold shift_pos in |- *.
+unfold shift_nat in |- *.
+intros; apply iter_nat_of_P.
Qed.
-Lemma two_power_pos_nat :
- (p:positive) (two_power_pos p)=(two_power_nat (convert p)).
+Lemma two_power_pos_nat :
+ forall p:positive, two_power_pos p = two_power_nat (nat_of_P p).
-Intro; Unfold two_power_pos; Unfold two_power_nat.
-Apply f_equal with f:=POS.
-Apply shift_pos_nat.
+intro; unfold two_power_pos in |- *; unfold two_power_nat in |- *.
+apply f_equal with (f := Zpos).
+apply shift_pos_nat.
Qed.
(** Then we deduce that [two_power_pos] is also correct *)
Theorem shift_pos_correct :
- (p,x:positive) ` (POS (shift_pos p x)) = (Zpower_pos 2 p) * (POS x)`.
+ forall p x:positive, Zpos (shift_pos p x) = Zpower_pos 2 p * Zpos x.
-Intros.
-Rewrite -> (shift_pos_nat p x).
-Rewrite -> (Zpower_pos_nat `2` p).
-Apply shift_nat_correct.
+intros.
+rewrite (shift_pos_nat p x).
+rewrite (Zpower_pos_nat 2 p).
+apply shift_nat_correct.
Qed.
-Theorem two_power_pos_correct :
- (x:positive) (two_power_pos x)=(Zpower_pos `2` x).
+Theorem two_power_pos_correct :
+ forall x:positive, two_power_pos x = Zpower_pos 2 x.
-Intro.
-Rewrite -> two_power_pos_nat.
-Rewrite -> Zpower_pos_nat.
-Apply two_power_nat_correct.
+intro.
+rewrite two_power_pos_nat.
+rewrite Zpower_pos_nat.
+apply two_power_nat_correct.
Qed.
(** Some consequences *)
Theorem two_power_pos_is_exp :
- (x,y:positive) (two_power_pos (add x y))
- =(Zmult (two_power_pos x) (two_power_pos y)).
-Intros.
-Rewrite -> (two_power_pos_correct (add x y)).
-Rewrite -> (two_power_pos_correct x).
-Rewrite -> (two_power_pos_correct y).
-Apply Zpower_pos_is_exp.
+ forall x y:positive,
+ two_power_pos (x + y) = two_power_pos x * two_power_pos y.
+intros.
+rewrite (two_power_pos_correct (x + y)).
+rewrite (two_power_pos_correct x).
+rewrite (two_power_pos_correct y).
+apply Zpower_pos_is_exp.
Qed.
(** The exponentiation [z -> 2^z] for [z] a signed integer.
@@ -211,80 +205,71 @@ Qed.
3 contructors [ Zero | Pos positive -> | minus_infty]
but it's more complexe and not so useful. *)
-Definition two_p :=
- [x:Z]Cases x of
- ZERO => `1`
- | (POS y) => (two_power_pos y)
- | (NEG y) => `0`
- end.
+Definition two_p (x:Z) :=
+ match x with
+ | Z0 => 1
+ | Zpos y => two_power_pos y
+ | Zneg y => 0
+ end.
Theorem two_p_is_exp :
- (x,y:Z) ` 0 <= x` -> ` 0 <= y` ->
- ` (two_p (x+y)) = (two_p x)*(two_p y)`.
-Induction x;
-[ Induction y; Simpl; Auto with zarith
-| Induction y;
- [ Unfold two_p; Rewrite -> (Zmult_sym (two_power_pos p) `1`);
- Rewrite -> (Zmult_one (two_power_pos p)); Auto with zarith
- | Unfold Zplus; Unfold two_p;
- Intros; Apply two_power_pos_is_exp
- | Intros; Unfold Zle in H0; Unfold Zcompare in H0;
- Absurd SUPERIEUR=SUPERIEUR; Trivial with zarith
- ]
-| Induction y;
- [ Simpl; Auto with zarith
- | Intros; Unfold Zle in H; Unfold Zcompare in H;
- Absurd (SUPERIEUR=SUPERIEUR); Trivial with zarith
- | Intros; Unfold Zle in H; Unfold Zcompare in H;
- Absurd (SUPERIEUR=SUPERIEUR); Trivial with zarith
- ]
-].
+ forall x y:Z, 0 <= x -> 0 <= y -> two_p (x + y) = two_p x * two_p y.
+simple induction x;
+ [ simple induction y; simpl in |- *; auto with zarith
+ | simple induction y;
+ [ unfold two_p in |- *; rewrite (Zmult_comm (two_power_pos p) 1);
+ rewrite (Zmult_1_l (two_power_pos p)); auto with zarith
+ | unfold Zplus in |- *; unfold two_p in |- *; intros;
+ apply two_power_pos_is_exp
+ | intros; unfold Zle in H0; unfold Zcompare in H0;
+ absurd (Datatypes.Gt = Datatypes.Gt); trivial with zarith ]
+ | simple induction y;
+ [ simpl in |- *; auto with zarith
+ | intros; unfold Zle in H; unfold Zcompare in H;
+ absurd (Datatypes.Gt = Datatypes.Gt); trivial with zarith
+ | intros; unfold Zle in H; unfold Zcompare in H;
+ absurd (Datatypes.Gt = Datatypes.Gt); trivial with zarith ] ].
Qed.
-Lemma two_p_gt_ZERO : (x:Z) ` 0 <= x` -> ` (two_p x) > 0`.
-Induction x; Intros;
-[ Simpl; Omega
-| Simpl; Unfold two_power_pos; Apply POS_gt_ZERO
-| Absurd ` 0 <= (NEG p)`;
- [ Simpl; Unfold Zle; Unfold Zcompare;
- Do 2 Unfold not; Auto with zarith
- | Assumption ]
-].
+Lemma two_p_gt_ZERO : forall x:Z, 0 <= x -> two_p x > 0.
+simple induction x; intros;
+ [ simpl in |- *; omega
+ | simpl in |- *; unfold two_power_pos in |- *; apply Zorder.Zgt_pos_0
+ | absurd (0 <= Zneg p);
+ [ simpl in |- *; unfold Zle in |- *; unfold Zcompare in |- *;
+ do 2 unfold not in |- *; auto with zarith
+ | assumption ] ].
Qed.
-Lemma two_p_S : (x:Z) ` 0 <= x` ->
- `(two_p (Zs x)) = 2 * (two_p x)`.
-Intros; Unfold Zs.
-Rewrite (two_p_is_exp x `1` H (ZERO_le_POS xH)).
-Apply Zmult_sym.
+Lemma two_p_S : forall x:Z, 0 <= x -> two_p (Zsucc x) = 2 * two_p x.
+intros; unfold Zsucc in |- *.
+rewrite (two_p_is_exp x 1 H (Zorder.Zle_0_pos 1)).
+apply Zmult_comm.
Qed.
-Lemma two_p_pred :
- (x:Z)` 0 <= x` -> ` (two_p (Zpred x)) < (two_p x)`.
-Intros; Apply natlike_ind
-with P:=[x:Z]` (two_p (Zpred x)) < (two_p x)`;
-[ Simpl; Unfold Zlt; Auto with zarith
-| Intros; Elim (Zle_lt_or_eq `0` x0 H0);
- [ Intros;
- Replace (two_p (Zpred (Zs x0)))
- with (two_p (Zs (Zpred x0)));
- [ Rewrite -> (two_p_S (Zpred x0));
- [ Rewrite -> (two_p_S x0);
- [ Omega
- | Assumption]
- | Apply Zlt_ZERO_pred_le_ZERO; Assumption]
- | Rewrite <- (Zs_pred x0); Rewrite <- (Zpred_Sn x0); Trivial with zarith]
- | Intro Hx0; Rewrite <- Hx0; Simpl; Unfold Zlt; Auto with zarith]
-| Assumption].
+Lemma two_p_pred : forall x:Z, 0 <= x -> two_p (Zpred x) < two_p x.
+intros; apply natlike_ind with (P := fun x:Z => two_p (Zpred x) < two_p x);
+ [ simpl in |- *; unfold Zlt in |- *; auto with zarith
+ | intros; elim (Zle_lt_or_eq 0 x0 H0);
+ [ intros;
+ replace (two_p (Zpred (Zsucc x0))) with (two_p (Zsucc (Zpred x0)));
+ [ rewrite (two_p_S (Zpred x0));
+ [ rewrite (two_p_S x0); [ omega | assumption ]
+ | apply Zorder.Zlt_0_le_0_pred; assumption ]
+ | rewrite <- (Zsucc_pred x0); rewrite <- (Zpred_succ x0);
+ trivial with zarith ]
+ | intro Hx0; rewrite <- Hx0; simpl in |- *; unfold Zlt in |- *;
+ auto with zarith ]
+ | assumption ].
Qed.
-Lemma Zlt_lt_double : (x,y:Z) ` 0 <= x < y` -> ` x < 2*y`.
-Intros; Omega. Qed.
+Lemma Zlt_lt_double : forall x y:Z, 0 <= x < y -> x < 2 * y.
+intros; omega. Qed.
End Powers_of_2.
-Hints Resolve two_p_gt_ZERO : zarith.
-Hints Immediate two_p_pred two_p_S : zarith.
+Hint Resolve two_p_gt_ZERO: zarith.
+Hint Immediate two_p_pred two_p_S: zarith.
Section power_div_with_rest.
@@ -293,102 +278,95 @@ Section power_div_with_rest.
[n = 2^p.q + r] and [0 <= r < 2^p] *)
(** Invariant: [d*q + r = d'*q + r /\ d' = 2*d /\ 0<= r < d /\ 0 <= r' < d'] *)
-Definition Zdiv_rest_aux :=
- [qrd:(Z*Z)*Z]
- let (qr,d)=qrd in let (q,r)=qr in
- (Cases q of
- ZERO => ` (0, r)`
- | (POS xH) => ` (0, d + r)`
- | (POS (xI n)) => ` ((POS n), d + r)`
- | (POS (xO n)) => ` ((POS n), r)`
- | (NEG xH) => ` (-1, d + r)`
- | (NEG (xI n)) => ` ((NEG n) - 1, d + r)`
- | (NEG (xO n)) => ` ((NEG n), r)`
- end, ` 2*d`).
-
-Definition Zdiv_rest :=
- [x:Z][p:positive]let (qr,d)=(iter_pos p ? Zdiv_rest_aux ((x,`0`),`1`)) in qr.
+Definition Zdiv_rest_aux (qrd:Z * Z * Z) :=
+ let (qr, d) := qrd in
+ let (q, r) := qr in
+ (match q with
+ | Z0 => (0, r)
+ | Zpos xH => (0, d + r)
+ | Zpos (xI n) => (Zpos n, d + r)
+ | Zpos (xO n) => (Zpos n, r)
+ | Zneg xH => (-1, d + r)
+ | Zneg (xI n) => (Zneg n - 1, d + r)
+ | Zneg (xO n) => (Zneg n, r)
+ end, 2 * d).
+
+Definition Zdiv_rest (x:Z) (p:positive) :=
+ let (qr, d) := iter_pos p _ Zdiv_rest_aux (x, 0, 1) in qr.
Lemma Zdiv_rest_correct1 :
- (x:Z)(p:positive)
- let (qr,d)=(iter_pos p ? Zdiv_rest_aux ((x,`0`),`1`)) in d=(two_power_pos p).
-
-Intros x p;
-Rewrite (iter_convert p ? Zdiv_rest_aux ((x,`0`),`1`));
-Rewrite (two_power_pos_nat p);
-Elim (convert p); Simpl;
-[ Trivial with zarith
-| Intro n; Rewrite (two_power_nat_S n);
- Unfold 2 Zdiv_rest_aux;
- Elim (iter_nat n (Z*Z)*Z Zdiv_rest_aux ((x,`0`),`1`));
- NewDestruct a; Intros; Apply f_equal with f:=[z:Z]`2*z`; Assumption ].
+ forall (x:Z) (p:positive),
+ let (qr, d) := iter_pos p _ Zdiv_rest_aux (x, 0, 1) in d = two_power_pos p.
+
+intros x p; rewrite (iter_nat_of_P p _ Zdiv_rest_aux (x, 0, 1));
+ rewrite (two_power_pos_nat p); elim (nat_of_P p);
+ simpl in |- *;
+ [ trivial with zarith
+ | intro n; rewrite (two_power_nat_S n); unfold Zdiv_rest_aux at 2 in |- *;
+ elim (iter_nat n (Z * Z * Z) Zdiv_rest_aux (x, 0, 1));
+ destruct a; intros; apply f_equal with (f := fun z:Z => 2 * z);
+ assumption ].
Qed.
Lemma Zdiv_rest_correct2 :
- (x:Z)(p:positive)
- let (qr,d)=(iter_pos p ? Zdiv_rest_aux ((x,`0`),`1`)) in
- let (q,r)=qr in
- ` x=q*d + r` /\ ` 0 <= r < d`.
-
-Intros; Apply iter_pos_invariant with
- f:=Zdiv_rest_aux
- Inv:=[qrd:(Z*Z)*Z]let (qr,d)=qrd in let (q,r)=qr in
- ` x=q*d + r` /\ ` 0 <= r < d`;
-[ Intro x0; Elim x0; Intro y0; Elim y0;
- Intros q r d; Unfold Zdiv_rest_aux;
- Elim q;
- [ Omega
- | NewDestruct p0;
- [ Rewrite POS_xI; Intro; Elim H; Intros; Split;
- [ Rewrite H0; Rewrite Zplus_assoc;
- Rewrite Zmult_plus_distr_l;
- Rewrite Zmult_1_n; Rewrite Zmult_assoc;
- Rewrite (Zmult_sym (POS p0) `2`); Apply refl_equal
- | Omega ]
- | Rewrite POS_xO; Intro; Elim H; Intros; Split;
- [ Rewrite H0;
- Rewrite Zmult_assoc; Rewrite (Zmult_sym (POS p0) `2`);
- Apply refl_equal
- | Omega ]
- | Omega ]
- | NewDestruct p0;
- [ Rewrite NEG_xI; Unfold Zminus; Intro; Elim H; Intros; Split;
- [ Rewrite H0; Rewrite Zplus_assoc;
- Apply f_equal with f:=[z:Z]`z+r`;
- Do 2 (Rewrite Zmult_plus_distr_l);
- Rewrite Zmult_assoc;
- Rewrite (Zmult_sym (NEG p0) `2`);
- Rewrite <- Zplus_assoc;
- Apply f_equal with f:=[z:Z]`2 * (NEG p0) * d + z`;
- Omega
- | Omega ]
- | Rewrite NEG_xO; Unfold Zminus; Intro; Elim H; Intros; Split;
- [ Rewrite H0;
- Rewrite Zmult_assoc; Rewrite (Zmult_sym (NEG p0) `2`);
- Apply refl_equal
- | Omega ]
- | Omega ] ]
-| Omega].
+ forall (x:Z) (p:positive),
+ let (qr, d) := iter_pos p _ Zdiv_rest_aux (x, 0, 1) in
+ let (q, r) := qr in x = q * d + r /\ 0 <= r < d.
+
+intros;
+ apply iter_pos_invariant with
+ (f := Zdiv_rest_aux)
+ (Inv := fun qrd:Z * Z * Z =>
+ let (qr, d) := qrd in
+ let (q, r) := qr in x = q * d + r /\ 0 <= r < d);
+ [ intro x0; elim x0; intro y0; elim y0; intros q r d;
+ unfold Zdiv_rest_aux in |- *; elim q;
+ [ omega
+ | destruct p0;
+ [ rewrite BinInt.Zpos_xI; intro; elim H; intros; split;
+ [ rewrite H0; rewrite Zplus_assoc; rewrite Zmult_plus_distr_l;
+ rewrite Zmult_1_l; rewrite Zmult_assoc;
+ rewrite (Zmult_comm (Zpos p0) 2); apply refl_equal
+ | omega ]
+ | rewrite BinInt.Zpos_xO; intro; elim H; intros; split;
+ [ rewrite H0; rewrite Zmult_assoc; rewrite (Zmult_comm (Zpos p0) 2);
+ apply refl_equal
+ | omega ]
+ | omega ]
+ | destruct p0;
+ [ rewrite BinInt.Zneg_xI; unfold Zminus in |- *; intro; elim H; intros;
+ split;
+ [ rewrite H0; rewrite Zplus_assoc;
+ apply f_equal with (f := fun z:Z => z + r);
+ do 2 rewrite Zmult_plus_distr_l; rewrite Zmult_assoc;
+ rewrite (Zmult_comm (Zneg p0) 2); rewrite <- Zplus_assoc;
+ apply f_equal with (f := fun z:Z => 2 * Zneg p0 * d + z);
+ omega
+ | omega ]
+ | rewrite BinInt.Zneg_xO; unfold Zminus in |- *; intro; elim H; intros;
+ split;
+ [ rewrite H0; rewrite Zmult_assoc; rewrite (Zmult_comm (Zneg p0) 2);
+ apply refl_equal
+ | omega ]
+ | omega ] ]
+ | omega ].
Qed.
-Inductive Set Zdiv_rest_proofs[x:Z; p:positive] :=
- Zdiv_rest_proof : (q:Z)(r:Z)
- `x = q * (two_power_pos p) + r`
- -> `0 <= r`
- -> `r < (two_power_pos p)`
- -> (Zdiv_rest_proofs x p).
-
-Lemma Zdiv_rest_correct :
- (x:Z)(p:positive)(Zdiv_rest_proofs x p).
-Intros x p.
-Generalize (Zdiv_rest_correct1 x p); Generalize (Zdiv_rest_correct2 x p).
-Elim (iter_pos p (Z*Z)*Z Zdiv_rest_aux ((x,`0`),`1`)).
-Induction a.
-Intros.
-Elim H; Intros H1 H2; Clear H.
-Rewrite -> H0 in H1; Rewrite -> H0 in H2;
-Elim H2; Intros;
-Apply Zdiv_rest_proof with q:=a0 r:=b; Assumption.
+Inductive Zdiv_rest_proofs (x:Z) (p:positive) : Set :=
+ Zdiv_rest_proof :
+ forall q r:Z,
+ x = q * two_power_pos p + r ->
+ 0 <= r -> r < two_power_pos p -> Zdiv_rest_proofs x p.
+
+Lemma Zdiv_rest_correct : forall (x:Z) (p:positive), Zdiv_rest_proofs x p.
+intros x p.
+generalize (Zdiv_rest_correct1 x p); generalize (Zdiv_rest_correct2 x p).
+elim (iter_pos p (Z * Z * Z) Zdiv_rest_aux (x, 0, 1)).
+simple induction a.
+intros.
+elim H; intros H1 H2; clear H.
+rewrite H0 in H1; rewrite H0 in H2; elim H2; intros;
+ apply Zdiv_rest_proof with (q := a0) (r := b); assumption.
Qed.
-End power_div_with_rest.
+End power_div_with_rest. \ No newline at end of file
diff --git a/theories/ZArith/Zsqrt.v b/theories/ZArith/Zsqrt.v
index b8040335e..f56005080 100644
--- a/theories/ZArith/Zsqrt.v
+++ b/theories/ZArith/Zsqrt.v
@@ -8,10 +8,9 @@
(* $Id$ *)
-Require Omega.
+Require Import Omega.
Require Export ZArith_base.
Require Export ZArithRing.
-V7only [Import Z_scope.].
Open Local Scope Z_scope.
(**********************************************************************)
@@ -19,118 +18,146 @@ Open Local Scope Z_scope.
(** The following tactic replaces all instances of (POS (xI ...)) by
`2*(POS ...)+1` , but only when ... is not made only with xO, XI, or xH. *)
-Tactic Definition compute_POS :=
- Match Context With
- | [|- [(POS (xI ?1))]] ->
- (Match ?1 With
- | [[xH]] -> Fail
- | _ -> Rewrite (POS_xI ?1))
- | [|- [(POS (xO ?1))]] ->
- (Match ?1 With
- | [[xH]] -> Fail
- | _ -> Rewrite (POS_xO ?1)).
+Ltac compute_POS :=
+ match goal with
+ | |- context [(Zpos (xI ?X1))] =>
+ match constr:X1 with
+ | context [1%positive] => fail
+ | _ => rewrite (BinInt.Zpos_xI X1)
+ end
+ | |- context [(Zpos (xO ?X1))] =>
+ match constr:X1 with
+ | context [1%positive] => fail
+ | _ => rewrite (BinInt.Zpos_xO X1)
+ end
+ end.
-Inductive sqrt_data [n : Z] : Set :=
- c_sqrt: (s, r :Z)`n=s*s+r`->`0<=r<=2*s`->(sqrt_data n) .
+Inductive sqrt_data (n:Z) : Set :=
+ c_sqrt : forall s r:Z, n = s * s + r -> 0 <= r <= 2 * s -> sqrt_data n.
-Definition sqrtrempos: (p : positive) (sqrt_data (POS p)).
-Refine (Fix sqrtrempos {
- sqrtrempos [p : positive] : (sqrt_data (POS p)) :=
- <[p : ?] (sqrt_data (POS p))> Cases p of
- xH => (c_sqrt `1` `1` `0` ? ?)
- | (xO xH) => (c_sqrt `2` `1` `1` ? ?)
- | (xI xH) => (c_sqrt `3` `1` `2` ? ?)
- | (xO (xO p')) =>
- Cases (sqrtrempos p') of
- (c_sqrt s' r' Heq Hint) =>
- Cases (Z_le_gt_dec `4*s'+1` `4*r'`) of
- (left Hle) =>
- (c_sqrt (POS (xO (xO p'))) `2*s'+1` `4*r'-(4*s'+1)` ? ?)
- | (right Hgt) =>
- (c_sqrt (POS (xO (xO p'))) `2*s'` `4*r'` ? ?)
- end
- end
- | (xO (xI p')) =>
- Cases (sqrtrempos p') of
- (c_sqrt s' r' Heq Hint) =>
- Cases
- (Z_le_gt_dec `4*s'+1` `4*r'+2`) of
- (left Hle) =>
- (c_sqrt
- (POS (xO (xI p'))) `2*s'+1` `4*r'+2-(4*s'+1)` ? ?)
- | (right Hgt) =>
- (c_sqrt (POS (xO (xI p'))) `2*s'` `4*r'+2` ? ?)
- end
- end
- | (xI (xO p')) =>
- Cases (sqrtrempos p') of
- (c_sqrt s' r' Heq Hint) =>
- Cases
- (Z_le_gt_dec `4*s'+1` `4*r'+1`) of
- (left Hle) =>
- (c_sqrt
- (POS (xI (xO p'))) `2*s'+1` `4*r'+1-(4*s'+1)` ? ?)
- | (right Hgt) =>
- (c_sqrt (POS (xI (xO p'))) `2*s'` `4*r'+1` ? ?)
- end
- end
- | (xI (xI p')) =>
- Cases (sqrtrempos p') of
- (c_sqrt s' r' Heq Hint) =>
- Cases
- (Z_le_gt_dec `4*s'+1` `4*r'+3`) of
- (left Hle) =>
- (c_sqrt
- (POS (xI (xI p'))) `2*s'+1` `4*r'+3-(4*s'+1)` ? ?)
- | (right Hgt) =>
- (c_sqrt (POS (xI (xI p'))) `2*s'` `4*r'+3` ? ?)
- end
- end
+Definition sqrtrempos : forall p:positive, sqrt_data (Zpos p).
+refine
+ (fix sqrtrempos (p:positive) : sqrt_data (Zpos p) :=
+ match p return sqrt_data (Zpos p) with
+ | xH => c_sqrt 1 1 0 _ _
+ | xO xH => c_sqrt 2 1 1 _ _
+ | xI xH => c_sqrt 3 1 2 _ _
+ | xO (xO p') =>
+ match sqrtrempos p' with
+ | c_sqrt s' r' Heq Hint =>
+ match Z_le_gt_dec (4 * s' + 1) (4 * r') with
+ | left Hle =>
+ c_sqrt (Zpos (xO (xO p'))) (2 * s' + 1)
+ (4 * r' - (4 * s' + 1)) _ _
+ | right Hgt => c_sqrt (Zpos (xO (xO p'))) (2 * s') (4 * r') _ _
end
- }); Clear sqrtrempos; Repeat compute_POS;
- Try (Try Rewrite Heq; Ring; Fail); Try Omega.
+ end
+ | xO (xI p') =>
+ match sqrtrempos p' with
+ | c_sqrt s' r' Heq Hint =>
+ match Z_le_gt_dec (4 * s' + 1) (4 * r' + 2) with
+ | left Hle =>
+ c_sqrt (Zpos (xO (xI p'))) (2 * s' + 1)
+ (4 * r' + 2 - (4 * s' + 1)) _ _
+ | right Hgt =>
+ c_sqrt (Zpos (xO (xI p'))) (2 * s') (4 * r' + 2) _ _
+ end
+ end
+ | xI (xO p') =>
+ match sqrtrempos p' with
+ | c_sqrt s' r' Heq Hint =>
+ match Z_le_gt_dec (4 * s' + 1) (4 * r' + 1) with
+ | left Hle =>
+ c_sqrt (Zpos (xI (xO p'))) (2 * s' + 1)
+ (4 * r' + 1 - (4 * s' + 1)) _ _
+ | right Hgt =>
+ c_sqrt (Zpos (xI (xO p'))) (2 * s') (4 * r' + 1) _ _
+ end
+ end
+ | xI (xI p') =>
+ match sqrtrempos p' with
+ | c_sqrt s' r' Heq Hint =>
+ match Z_le_gt_dec (4 * s' + 1) (4 * r' + 3) with
+ | left Hle =>
+ c_sqrt (Zpos (xI (xI p'))) (2 * s' + 1)
+ (4 * r' + 3 - (4 * s' + 1)) _ _
+ | right Hgt =>
+ c_sqrt (Zpos (xI (xI p'))) (2 * s') (4 * r' + 3) _ _
+ end
+ end
+ end); clear sqrtrempos; repeat compute_POS;
+ try (try rewrite Heq; ring; fail); try omega.
Defined.
(** Define with integer input, but with a strong (readable) specification. *)
-Definition Zsqrt : (x:Z)`0<=x`->{s:Z & {r:Z | x=`s*s+r` /\ `s*s<=x<(s+1)*(s+1)`}}.
-Refine [x]
- <[x:Z]`0<=x`->{s:Z & {r:Z | x=`s*s+r` /\ `s*s<=x<(s+1)*(s+1)`}}>Cases x of
- (POS p) => [h]Cases (sqrtrempos p) of
- (c_sqrt s r Heq Hint) =>
- (existS ? [s:Z]{r:Z | `(POS p)=s*s+r` /\
- `s*s<=(POS p)<(s+1)*(s+1)`}
- s
- (exist Z [r:Z]((POS p)=`s*s+r` /\ `s*s<=(POS p)<(s+1)*(s+1)`)
- r ?))
- end
- | (NEG p) => [h](False_rec
- {s:Z & {r:Z |
- (NEG p)=`s*s+r` /\ `s*s<=(NEG p)<(s+1)*(s+1)`}}
- (h (refl_equal ? SUPERIEUR)))
- | ZERO => [h](existS ? [s:Z]{r:Z | `0=s*s+r` /\ `s*s<=0<(s+1)*(s+1)`}
- `0` (exist Z [r:Z](`0=0*0+r`/\`0*0<=0<(0+1)*(0+1)`)
- `0` ?))
- end;Try Omega.
-Split;[Omega|Rewrite Heq;Ring `(s+1)*(s+1)`;Omega].
+Definition Zsqrt :
+ forall x:Z,
+ 0 <= x ->
+ {s : Z & {r : Z | x = s * s + r /\ s * s <= x < (s + 1) * (s + 1)}}.
+refine
+ (fun x =>
+ match
+ x
+ return
+ 0 <= x ->
+ {s : Z & {r : Z | x = s * s + r /\ s * s <= x < (s + 1) * (s + 1)}}
+ with
+ | Zpos p =>
+ fun h =>
+ match sqrtrempos p with
+ | c_sqrt s r Heq Hint =>
+ existS
+ (fun s:Z =>
+ {r : Z |
+ Zpos p = s * s + r /\ s * s <= Zpos p < (s + 1) * (s + 1)})
+ s
+ (exist
+ (fun r:Z =>
+ Zpos p = s * s + r /\
+ s * s <= Zpos p < (s + 1) * (s + 1)) r _)
+ end
+ | Zneg p =>
+ fun h =>
+ False_rec
+ {s : Z &
+ {r : Z |
+ Zneg p = s * s + r /\ s * s <= Zneg p < (s + 1) * (s + 1)}}
+ (h (refl_equal Datatypes.Gt))
+ | Z0 =>
+ fun h =>
+ existS
+ (fun s:Z =>
+ {r : Z | 0 = s * s + r /\ s * s <= 0 < (s + 1) * (s + 1)}) 0
+ (exist
+ (fun r:Z => 0 = 0 * 0 + r /\ 0 * 0 <= 0 < (0 + 1) * (0 + 1)) 0
+ _)
+ end); try omega.
+split; [ omega | rewrite Heq; ring ((s + 1) * (s + 1)); omega ].
Defined.
(** Define a function of type Z->Z that computes the integer square root,
but only for positive numbers, and 0 for others. *)
-Definition Zsqrt_plain : Z->Z :=
- [x]Cases x of
- (POS p)=>Cases (Zsqrt (POS p) (ZERO_le_POS p)) of (existS s _) => s end
- |(NEG p)=>`0`
- |ZERO=>`0`
- end.
+Definition Zsqrt_plain (x:Z) : Z :=
+ match x with
+ | Zpos p =>
+ match Zsqrt (Zpos p) (Zorder.Zle_0_pos p) with
+ | existS s _ => s
+ end
+ | Zneg p => 0
+ | Z0 => 0
+ end.
(** A basic theorem about Zsqrt_plain *)
-Theorem Zsqrt_interval :(x:Z)`0<=x`->
- `(Zsqrt_plain x)*(Zsqrt_plain x)<= x < ((Zsqrt_plain x)+1)*((Zsqrt_plain x)+1)`.
-Intros x;Case x.
-Unfold Zsqrt_plain;Omega.
-Intros p;Unfold Zsqrt_plain;Case (Zsqrt (POS p) (ZERO_le_POS p)).
-Intros s (r,(Heq,Hint)) Hle;Assumption.
-Intros p Hle;Elim Hle;Auto.
+Theorem Zsqrt_interval :
+ forall n:Z,
+ 0 <= n ->
+ Zsqrt_plain n * Zsqrt_plain n <= n <
+ (Zsqrt_plain n + 1) * (Zsqrt_plain n + 1).
+intros x; case x.
+unfold Zsqrt_plain in |- *; omega.
+intros p; unfold Zsqrt_plain in |- *;
+ case (Zsqrt (Zpos p) (Zorder.Zle_0_pos p)).
+intros s [r [Heq Hint]] Hle; assumption.
+intros p Hle; elim Hle; auto.
Qed.
-
diff --git a/theories/ZArith/Zsyntax.v b/theories/ZArith/Zsyntax.v
deleted file mode 100644
index 5c226b3fc..000000000
--- a/theories/ZArith/Zsyntax.v
+++ /dev/null
@@ -1,278 +0,0 @@
-(***********************************************************************)
-(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA-Rocquencourt & LRI-CNRS-Orsay *)
-(* \VV/ *************************************************************)
-(* // * This file is distributed under the terms of the *)
-(* * GNU Lesser General Public License Version 2.1 *)
-(***********************************************************************)
-
-(*i $Id$ i*)
-
-Require Export BinInt.
-
-V7only[
-
-Grammar znatural ident :=
- nat_id [ prim:var($id) ] -> [$id]
-
-with number :=
-
-with negnumber :=
-
-with formula : constr :=
- form_expr [ expr($p) ] -> [$p]
-(*| form_eq [ expr($p) "=" expr($c) ] -> [ (eq Z $p $c) ]*)
-| form_eq [ expr($p) "=" expr($c) ] -> [ (Coq.Init.Logic.eq ? $p $c) ]
-| form_le [ expr($p) "<=" expr($c) ] -> [ (Zle $p $c) ]
-| form_lt [ expr($p) "<" expr($c) ] -> [ (Zlt $p $c) ]
-| form_ge [ expr($p) ">=" expr($c) ] -> [ (Zge $p $c) ]
-| form_gt [ expr($p) ">" expr($c) ] -> [ (Zgt $p $c) ]
-(*| form_eq_eq [ expr($p) "=" expr($c) "=" expr($c1) ]
- -> [ (eq Z $p $c)/\(eq Z $c $c1) ]*)
-| form_eq_eq [ expr($p) "=" expr($c) "=" expr($c1) ]
- -> [ (Coq.Init.Logic.eq ? $p $c)/\(Coq.Init.Logic.eq ? $c $c1) ]
-| form_le_le [ expr($p) "<=" expr($c) "<=" expr($c1) ]
- -> [ (Zle $p $c)/\(Zle $c $c1) ]
-| form_le_lt [ expr($p) "<=" expr($c) "<" expr($c1) ]
- -> [ (Zle $p $c)/\(Zlt $c $c1) ]
-| form_lt_le [ expr($p) "<" expr($c) "<=" expr($c1) ]
- -> [ (Zlt $p $c)/\(Zle $c $c1) ]
-| form_lt_lt [ expr($p) "<" expr($c) "<" expr($c1) ]
- -> [ (Zlt $p $c)/\(Zlt $c $c1) ]
-(*| form_neq [ expr($p) "<>" expr($c) ] -> [ ~(Coq.Init.Logic.eq Z $p $c) ]*)
-| form_neq [ expr($p) "<>" expr($c) ] -> [ ~(Coq.Init.Logic.eq ? $p $c) ]
-| form_comp [ expr($p) "?=" expr($c) ] -> [ (Zcompare $p $c) ]
-
-with expr : constr :=
- expr_plus [ expr($p) "+" expr($c) ] -> [ (Zplus $p $c) ]
-| expr_minus [ expr($p) "-" expr($c) ] -> [ (Zminus $p $c) ]
-| expr2 [ expr2($e) ] -> [$e]
-
-with expr2 : constr :=
- expr_mult [ expr2($p) "*" expr2($c) ] -> [ (Zmult $p $c) ]
-| expr1 [ expr1($e) ] -> [$e]
-
-with expr1 : constr :=
- expr_abs [ "|" expr($c) "|" ] -> [ (Zabs $c) ]
-| expr0 [ expr0($e) ] -> [$e]
-
-with expr0 : constr :=
- expr_id [ constr:global($c) ] -> [ $c ]
-| expr_com [ "[" constr:constr($c) "]" ] -> [$c]
-| expr_appl [ "(" application($a) ")" ] -> [$a]
-| expr_num [ number($s) ] -> [$s ]
-| expr_negnum [ "-" negnumber($n) ] -> [ $n ]
-| expr_inv [ "-" expr0($c) ] -> [ (Zopp $c) ]
-| expr_meta [ zmeta($m) ] -> [ $m ]
-
-with zmeta :=
-| rimpl [ "?" ] -> [ ? ]
-| rmeta0 [ "?" "0" ] -> [ ?0 ]
-| rmeta1 [ "?" "1" ] -> [ ?1 ]
-| rmeta2 [ "?" "2" ] -> [ ?2 ]
-| rmeta3 [ "?" "3" ] -> [ ?3 ]
-| rmeta4 [ "?" "4" ] -> [ ?4 ]
-| rmeta5 [ "?" "5" ] -> [ ?5 ]
-
-with application : constr :=
- apply [ application($p) expr($c1) ] -> [ ($p $c1) ]
-| apply_inject_nat [ "inject_nat" constr:constr($c1) ] -> [ (inject_nat $c1) ]
-| pair [ expr($p) "," expr($c) ] -> [ ($p, $c) ]
-| appl0 [ expr($a) ] -> [$a]
-.
-
-Grammar constr constr0 :=
- z_in_com [ "`" znatural:formula($c) "`" ] -> [$c].
-
-Grammar constr pattern :=
- z_in_pattern [ "`" prim:bigint($c) "`" ] -> [ 'Z: $c ' ].
-
-(* The symbols "`" "`" must be printed just once at the top of the expressions,
- to avoid printings like |``x` + `y`` < `45`|
- for |x + y < 45|.
- So when a Z-expression is to be printed, its sub-expresssions are
- enclosed into an ast (ZEXPR \$subexpr), which is printed like \$subexpr
- but without symbols "`" "`" around.
-
- There is just one problem: NEG and Zopp have the same printing rules.
- If Zopp is opaque, we may not be able to solve a goal like
- ` -5 = -5 ` by reflexivity. (In fact, this precise Goal is solved
- by the Reflexivity tactic, but more complex problems may arise
-
- SOLUTION : Print (Zopp 5) for constants and -x for variables *)
-
-Syntax constr
- level 0:
- Zle [ (Zle $n1 $n2) ] ->
- [[<hov 0> "`" (ZEXPR $n1) [1 0] "<= " (ZEXPR $n2) "`"]]
- | Zlt [ (Zlt $n1 $n2) ] ->
- [[<hov 0> "`" (ZEXPR $n1) [1 0] "< " (ZEXPR $n2) "`" ]]
- | Zge [ (Zge $n1 $n2) ] ->
- [[<hov 0> "`" (ZEXPR $n1) [1 0] ">= " (ZEXPR $n2) "`" ]]
- | Zgt [ (Zgt $n1 $n2) ] ->
- [[<hov 0> "`" (ZEXPR $n1) [1 0] "> " (ZEXPR $n2) "`" ]]
- | Zcompare [<<(Zcompare $n1 $n2)>>] ->
- [[<hov 0> "`" (ZEXPR $n1) [1 0] "?= " (ZEXPR $n2) "`" ]]
- | Zeq [ (eq Z $n1 $n2) ] ->
- [[<hov 0> "`" (ZEXPR $n1) [1 0] "= " (ZEXPR $n2)"`"]]
- | Zneq [ ~(eq Z $n1 $n2) ] ->
- [[<hov 0> "`" (ZEXPR $n1) [1 0] "<> " (ZEXPR $n2) "`"]]
- | Zle_Zle [ (Zle $n1 $n2)/\(Zle $n2 $n3) ] ->
- [[<hov 0> "`" (ZEXPR $n1) [1 0] "<= " (ZEXPR $n2)
- [1 0] "<= " (ZEXPR $n3) "`"]]
- | Zle_Zlt [ (Zle $n1 $n2)/\(Zlt $n2 $n3) ] ->
- [[<hov 0> "`" (ZEXPR $n1) [1 0] "<= " (ZEXPR $n2)
- [1 0] "< " (ZEXPR $n3) "`"]]
- | Zlt_Zle [ (Zlt $n1 $n2)/\(Zle $n2 $n3) ] ->
- [[<hov 0> "`" (ZEXPR $n1) [1 0] "< " (ZEXPR $n2)
- [1 0] "<= " (ZEXPR $n3) "`"]]
- | Zlt_Zlt [ (Zlt $n1 $n2)/\(Zlt $n2 $n3) ] ->
- [[<hov 0> "`" (ZEXPR $n1) [1 0] "< " (ZEXPR $n2)
- [1 0] "< " (ZEXPR $n3) "`"]]
- | ZZero_v7 [ ZERO ] -> [ "`0`" ]
- | ZPos_v7 [ (POS $r) ] -> [$r:"positive_printer":9]
- | ZNeg_v7 [ (NEG $r) ] -> [$r:"negative_printer":9]
- ;
-
- level 7:
- Zplus [ (Zplus $n1 $n2) ]
- -> [ [<hov 0> "`" (ZEXPR $n1):E "+" [0 0] (ZEXPR $n2):L "`"] ]
- | Zminus [ (Zminus $n1 $n2) ]
- -> [ [<hov 0> "`" (ZEXPR $n1):E "-" [0 0] (ZEXPR $n2):L "`"] ]
- ;
-
- level 6:
- Zmult [ (Zmult $n1 $n2) ]
- -> [ [<hov 0> "`" (ZEXPR $n1):E "*" [0 0] (ZEXPR $n2):L "`"] ]
- ;
-
- level 8:
- Zopp [ (Zopp $n1) ] -> [ [<hov 0> "`" "-" (ZEXPR $n1):E "`"] ]
- | Zopp_POS [ (Zopp (POS $r)) ] ->
- [ [<hov 0> "`(" "Zopp" [1 0] $r:"positive_printer_inside" ")`"] ]
- | Zopp_ZERO [ (Zopp ZERO) ] -> [ [<hov 0> "`(" "Zopp" [1 0] "0" ")`"] ]
- | Zopp_NEG [ (Zopp (NEG $r)) ] ->
- [ [<hov 0> "`(" "Zopp" [1 0] "(" $r:"negative_printer_inside" "))`"] ]
- ;
-
- level 4:
- Zabs [ (Zabs $n1) ] -> [ [<hov 0> "`|" (ZEXPR $n1):E "|`"] ]
- ;
-
- level 0:
- escape_inside [ << (ZEXPR $r) >> ] -> [ "[" $r:E "]" ]
- ;
-
- level 4:
- Zappl_inside [ << (ZEXPR (APPLIST $h ($LIST $t))) >> ]
- -> [ [<hov 0> "("(ZEXPR $h):E [1 0] (ZAPPLINSIDETAIL ($LIST $t)):E ")"] ]
- | Zappl_inject_nat [ << (ZEXPR (APPLIST <<inject_nat>> $n)) >> ]
- -> [ [<hov 0> "(inject_nat" [1 1] $n:L ")"] ]
- | Zappl_inside_tail [ << (ZAPPLINSIDETAIL $h ($LIST $t)) >> ]
- -> [(ZEXPR $h):E [1 0] (ZAPPLINSIDETAIL ($LIST $t)):E]
- | Zappl_inside_one [ << (ZAPPLINSIDETAIL $e) >> ] ->[(ZEXPR $e):E]
- | pair_inside [ << (ZEXPR <<(pair $s1 $s2 $z1 $z2)>>) >> ]
- -> [ [<hov 0> "("(ZEXPR $z1):E "," [1 0] (ZEXPR $z2):E ")"] ]
- ;
-
- level 3:
- var_inside [ << (ZEXPR ($VAR $i)) >> ] -> [$i]
- | secvar_inside [ << (ZEXPR (SECVAR $i)) >> ] -> [(SECVAR $i)]
- | const_inside [ << (ZEXPR (CONST $c)) >> ] -> [(CONST $c)]
- | mutind_inside [ << (ZEXPR (MUTIND $i $n)) >> ]
- -> [(MUTIND $i $n)]
- | mutconstruct_inside [ << (ZEXPR (MUTCONSTRUCT $c1 $c2 $c3)) >> ]
- -> [ (MUTCONSTRUCT $c1 $c2 $c3) ]
-
- | O_inside [ << (ZEXPR << O >>) >> ] -> [ "O" ] (* To shunt Arith printer *)
-
- (* Added by JCF, 9/3/98; updated HH, 11/9/01 *)
- | implicit_head_inside [ << (ZEXPR (APPLISTEXPL ($LIST $c))) >> ]
- -> [ (APPLIST ($LIST $c)) ]
- | implicit_arg_inside [ << (ZEXPR (EXPL "!" $n $c)) >> ] -> [ ]
-
- ;
-
- level 7:
- Zplus_inside
- [ << (ZEXPR <<(Zplus $n1 $n2)>>) >> ]
- -> [ (ZEXPR $n1):E "+" [0 0] (ZEXPR $n2):L ]
- | Zminus_inside
- [ << (ZEXPR <<(Zminus $n1 $n2)>>) >> ]
- -> [ (ZEXPR $n1):E "-" [0 0] (ZEXPR $n2):L ]
- ;
-
- level 6:
- Zmult_inside
- [ << (ZEXPR <<(Zmult $n1 $n2)>>) >> ]
- -> [ (ZEXPR $n1):E "*" [0 0] (ZEXPR $n2):L ]
- ;
-
- level 5:
- Zopp_inside [ << (ZEXPR <<(Zopp $n1)>>) >> ] -> [ "(-" (ZEXPR $n1):E ")" ]
- ;
-
- level 10:
- Zopp_POS_inside [ << (ZEXPR <<(Zopp (POS $r))>>) >> ] ->
- [ [<hov 0> "Zopp" [1 0] $r:"positive_printer_inside" ] ]
- | Zopp_ZERO_inside [ << (ZEXPR <<(Zopp ZERO)>>) >> ] ->
- [ [<hov 0> "Zopp" [1 0] "0"] ]
- | Zopp_NEG_inside [ << (ZEXPR <<(Zopp (NEG $r))>>) >> ] ->
- [ [<hov 0> "Zopp" [1 0] $r:"negative_printer_inside" ] ]
- ;
-
- level 4:
- Zabs_inside [ << (ZEXPR <<(Zabs $n1)>>) >> ] -> [ "|" (ZEXPR $n1) "|"]
- ;
-
- level 0:
- ZZero_inside [ << (ZEXPR <<ZERO>>) >> ] -> ["0"]
- | ZPos_inside [ << (ZEXPR <<(POS $p)>>) >>] ->
- [$p:"positive_printer_inside":9]
- | ZNeg_inside [ << (ZEXPR <<(NEG $p)>>) >>] ->
- [$p:"negative_printer_inside":9]
-.
-].
-
-V7only[
-(* For parsing/printing based on scopes *)
-Module Z_scope.
-
-Infix LEFTA 4 "+" Zplus : Z_scope.
-Infix LEFTA 4 "-" Zminus : Z_scope.
-Infix LEFTA 3 "*" Zmult : Z_scope.
-Notation "- x" := (Zopp x) (at level 0): Z_scope V8only.
-Infix NONA 5 "<=" Zle : Z_scope.
-Infix NONA 5 "<" Zlt : Z_scope.
-Infix NONA 5 ">=" Zge : Z_scope.
-Infix NONA 5 ">" Zgt : Z_scope.
-Infix NONA 5 "?=" Zcompare : Z_scope.
-Notation "x <= y <= z" := (Zle x y)/\(Zle y z)
- (at level 5, y at level 4):Z_scope
- V8only (at level 70, y at next level).
-Notation "x <= y < z" := (Zle x y)/\(Zlt y z)
- (at level 5, y at level 4):Z_scope
- V8only (at level 70, y at next level).
-Notation "x < y < z" := (Zlt x y)/\(Zlt y z)
- (at level 5, y at level 4):Z_scope
- V8only (at level 70, y at next level).
-Notation "x < y <= z" := (Zlt x y)/\(Zle y z)
- (at level 5, y at level 4):Z_scope
- V8only (at level 70, y at next level).
-Notation "x = y = z" := x=y/\y=z : Z_scope
- V8only (at level 70, y at next level).
-
-(* Now a polymorphic notation
-Notation "x <> y" := ~(eq Z x y) (at level 5, no associativity) : Z_scope.
-*)
-
-(* Notation "| x |" (Zabs x) : Z_scope.(* "|" conflicts with THENS *)*)
-
-(* Overwrite the printing of "`x = y`" *)
-Syntax constr level 0:
- Zeq [ (eq Z $n1 $n2) ] -> [[<hov 0> $n1 [1 0] "= " $n2 ]].
-
-Open Scope Z_scope.
-
-End Z_scope.
-].
diff --git a/theories/ZArith/Zwf.v b/theories/ZArith/Zwf.v
index 5468f82cc..7f91b0f6f 100644
--- a/theories/ZArith/Zwf.v
+++ b/theories/ZArith/Zwf.v
@@ -8,10 +8,9 @@
(* $Id$ *)
-Require ZArith_base.
+Require Import ZArith_base.
Require Export Wf_nat.
-Require Omega.
-V7only [Import Z_scope.].
+Require Import Omega.
Open Local Scope Z_scope.
(** Well-founded relations on Z. *)
@@ -21,7 +20,7 @@ Open Local Scope Z_scope.
[x (Zwf c) y] iff [x < y & c <= y]
*)
-Definition Zwf := [c:Z][x,y:Z] `c <= y` /\ `x < y`.
+Definition Zwf (c x y:Z) := c <= y /\ x < y.
(** and we prove that [(Zwf c)] is well founded *)
@@ -32,34 +31,34 @@ Variable c : Z.
(** The proof of well-foundness is classic: we do the proof by induction
on a measure in nat, which is here [|x-c|] *)
-Local f := [z:Z](absolu (Zminus z c)).
+Let f (z:Z) := Zabs_nat (z - c).
-Lemma Zwf_well_founded : (well_founded Z (Zwf c)).
-Red; Intros.
-Assert (n:nat)(a:Z)(lt (f a) n)\/(`a<c`) -> (Acc Z (Zwf c) a).
-Clear a; Induction n; Intros.
+Lemma Zwf_well_founded : well_founded (Zwf c).
+red in |- *; intros.
+assert (forall (n:nat) (a:Z), (f a < n)%nat \/ a < c -> Acc (Zwf c) a).
+clear a; simple induction n; intros.
(** n= 0 *)
-Case H; Intros.
-Case (lt_n_O (f a)); Auto.
-Apply Acc_intro; Unfold Zwf; Intros.
-Assert False;Omega Orelse Contradiction.
+case H; intros.
+case (lt_n_O (f a)); auto.
+apply Acc_intro; unfold Zwf in |- *; intros.
+assert False; omega || contradiction.
(** inductive case *)
-Case H0; Clear H0; Intro; Auto.
-Apply Acc_intro; Intros.
-Apply H.
-Unfold Zwf in H1.
-Case (Zle_or_lt c y); Intro; Auto with zarith.
-Left.
-Red in H0.
-Apply lt_le_trans with (f a); Auto with arith.
-Unfold f.
-Apply absolu_lt; Omega.
-Apply (H (S (f a))); Auto.
-Save.
+case H0; clear H0; intro; auto.
+apply Acc_intro; intros.
+apply H.
+unfold Zwf in H1.
+case (Zle_or_lt c y); intro; auto with zarith.
+left.
+red in H0.
+apply lt_le_trans with (f a); auto with arith.
+unfold f in |- *.
+apply Zabs.Zabs_nat_lt; omega.
+apply (H (S (f a))); auto.
+Qed.
End wf_proof.
-Hints Resolve Zwf_well_founded : datatypes v62.
+Hint Resolve Zwf_well_founded: datatypes v62.
(** We also define the other family of relations:
@@ -67,7 +66,7 @@ Hints Resolve Zwf_well_founded : datatypes v62.
[x (Zwf_up c) y] iff [y < x <= c]
*)
-Definition Zwf_up := [c:Z][x,y:Z] `y < x <= c`.
+Definition Zwf_up (c x y:Z) := y < x <= c.
(** and we prove that [(Zwf_up c)] is well founded *)
@@ -78,19 +77,20 @@ Variable c : Z.
(** The proof of well-foundness is classic: we do the proof by induction
on a measure in nat, which is here [|c-x|] *)
-Local f := [z:Z](absolu (Zminus c z)).
+Let f (z:Z) := Zabs_nat (c - z).
-Lemma Zwf_up_well_founded : (well_founded Z (Zwf_up c)).
+Lemma Zwf_up_well_founded : well_founded (Zwf_up c).
Proof.
-Apply well_founded_lt_compat with f:=f.
-Unfold Zwf_up f.
-Intros.
-Apply absolu_lt.
-Unfold Zminus. Split.
-Apply Zle_left; Intuition.
-Apply Zlt_reg_l; Unfold Zlt; Rewrite <- Zcompare_Zopp; Intuition.
-Save.
+apply well_founded_lt_compat with (f := f).
+unfold Zwf_up, f in |- *.
+intros.
+apply Zabs.Zabs_nat_lt.
+unfold Zminus in |- *. split.
+apply Zle_left; intuition.
+apply Zplus_lt_compat_l; unfold Zlt in |- *; rewrite <- Zcompare_opp;
+ intuition.
+Qed.
End wf_proof_up.
-Hints Resolve Zwf_up_well_founded : datatypes v62.
+Hint Resolve Zwf_up_well_founded: datatypes v62. \ No newline at end of file
diff --git a/theories/ZArith/auxiliary.v b/theories/ZArith/auxiliary.v
index 3f713c5ed..50c22b1b4 100644
--- a/theories/ZArith/auxiliary.v
+++ b/theories/ZArith/auxiliary.v
@@ -11,10 +11,10 @@
(** Binary Integers (Pierre Crégut, CNET, Lannion, France) *)
Require Export Arith.
-Require BinInt.
-Require Zorder.
-Require Decidable.
-Require Peano_dec.
+Require Import BinInt.
+Require Import Zorder.
+Require Import Decidable.
+Require Import Peano_dec.
Require Export Compare_dec.
Open Local Scope Z_scope.
@@ -22,198 +22,129 @@ Open Local Scope Z_scope.
(**********************************************************************)
(** Moving terms from one side to the other of an inequality *)
-Theorem Zne_left : (x,y:Z) (Zne x y) -> (Zne (Zplus x (Zopp y)) ZERO).
+Theorem Zne_left : forall n m:Z, Zne n m -> Zne (n + - m) 0.
Proof.
-Intros x y; Unfold Zne; Unfold not; Intros H1 H2; Apply H1;
-Apply Zsimpl_plus_l with (Zopp y); Rewrite Zplus_inverse_l; Rewrite Zplus_sym;
-Trivial with arith.
+intros x y; unfold Zne in |- *; unfold not in |- *; intros H1 H2; apply H1;
+ apply Zplus_reg_l with (- y); rewrite Zplus_opp_l;
+ rewrite Zplus_comm; trivial with arith.
Qed.
-Theorem Zegal_left : (x,y:Z) (x=y) -> (Zplus x (Zopp y)) = ZERO.
+Theorem Zegal_left : forall n m:Z, n = m -> n + - m = 0.
Proof.
-Intros x y H;
-Apply (Zsimpl_plus_l y);Rewrite -> Zplus_permute;
-Rewrite -> Zplus_inverse_r;Do 2 Rewrite -> Zero_right;Assumption.
+intros x y H; apply (Zplus_reg_l y); rewrite Zplus_permute;
+ rewrite Zplus_opp_r; do 2 rewrite Zplus_0_r; assumption.
Qed.
-Theorem Zle_left : (x,y:Z) (Zle x y) -> (Zle ZERO (Zplus y (Zopp x))).
+Theorem Zle_left : forall n m:Z, n <= m -> 0 <= m + - n.
Proof.
-Intros x y H; Replace ZERO with (Zplus x (Zopp x)).
-Apply Zle_reg_r; Trivial.
-Apply Zplus_inverse_r.
+intros x y H; replace 0 with (x + - x).
+apply Zplus_le_compat_r; trivial.
+apply Zplus_opp_r.
Qed.
-Theorem Zle_left_rev : (x,y:Z) (Zle ZERO (Zplus y (Zopp x)))
- -> (Zle x y).
+Theorem Zle_left_rev : forall n m:Z, 0 <= m + - n -> n <= m.
Proof.
-Intros x y H; Apply Zsimpl_le_plus_r with (Zopp x).
-Rewrite Zplus_inverse_r; Trivial.
+intros x y H; apply Zplus_le_reg_r with (- x).
+rewrite Zplus_opp_r; trivial.
Qed.
-Theorem Zlt_left_rev : (x,y:Z) (Zlt ZERO (Zplus y (Zopp x)))
- -> (Zlt x y).
+Theorem Zlt_left_rev : forall n m:Z, 0 < m + - n -> n < m.
Proof.
-Intros x y H; Apply Zsimpl_lt_plus_r with (Zopp x).
-Rewrite Zplus_inverse_r; Trivial.
+intros x y H; apply Zplus_lt_reg_r with (- x).
+rewrite Zplus_opp_r; trivial.
Qed.
-Theorem Zlt_left :
- (x,y:Z) (Zlt x y) -> (Zle ZERO (Zplus (Zplus y (NEG xH)) (Zopp x))).
+Theorem Zlt_left : forall n m:Z, n < m -> 0 <= m + -1 + - n.
Proof.
-Intros x y H; Apply Zle_left; Apply Zle_S_n;
-Change (Zle (Zs x) (Zs (Zpred y))); Rewrite <- Zs_pred; Apply Zlt_le_S;
-Assumption.
+intros x y H; apply Zle_left; apply Zsucc_le_reg;
+ change (Zsucc x <= Zsucc (Zpred y)) in |- *; rewrite <- Zsucc_pred;
+ apply Zlt_le_succ; assumption.
Qed.
-Theorem Zlt_left_lt :
- (x,y:Z) (Zlt x y) -> (Zlt ZERO (Zplus y (Zopp x))).
+Theorem Zlt_left_lt : forall n m:Z, n < m -> 0 < m + - n.
Proof.
-Intros x y H; Replace ZERO with (Zplus x (Zopp x)).
-Apply Zlt_reg_r; Trivial.
-Apply Zplus_inverse_r.
+intros x y H; replace 0 with (x + - x).
+apply Zplus_lt_compat_r; trivial.
+apply Zplus_opp_r.
Qed.
-Theorem Zge_left : (x,y:Z) (Zge x y) -> (Zle ZERO (Zplus x (Zopp y))).
+Theorem Zge_left : forall n m:Z, n >= m -> 0 <= n + - m.
Proof.
-Intros x y H; Apply Zle_left; Apply Zge_le; Assumption.
+intros x y H; apply Zle_left; apply Zge_le; assumption.
Qed.
-Theorem Zgt_left :
- (x,y:Z) (Zgt x y) -> (Zle ZERO (Zplus (Zplus x (NEG xH)) (Zopp y))).
+Theorem Zgt_left : forall n m:Z, n > m -> 0 <= n + -1 + - m.
Proof.
-Intros x y H; Apply Zlt_left; Apply Zgt_lt; Assumption.
+intros x y H; apply Zlt_left; apply Zgt_lt; assumption.
Qed.
-Theorem Zgt_left_gt :
- (x,y:Z) (Zgt x y) -> (Zgt (Zplus x (Zopp y)) ZERO).
+Theorem Zgt_left_gt : forall n m:Z, n > m -> n + - m > 0.
Proof.
-Intros x y H; Replace ZERO with (Zplus y (Zopp y)).
-Apply Zgt_reg_r; Trivial.
-Apply Zplus_inverse_r.
+intros x y H; replace 0 with (y + - y).
+apply Zplus_gt_compat_r; trivial.
+apply Zplus_opp_r.
Qed.
-Theorem Zgt_left_rev : (x,y:Z) (Zgt (Zplus x (Zopp y)) ZERO)
- -> (Zgt x y).
+Theorem Zgt_left_rev : forall n m:Z, n + - m > 0 -> n > m.
Proof.
-Intros x y H; Apply Zsimpl_gt_plus_r with (Zopp y).
-Rewrite Zplus_inverse_r; Trivial.
+intros x y H; apply Zplus_gt_reg_r with (- y).
+rewrite Zplus_opp_r; trivial.
Qed.
(**********************************************************************)
(** Factorization lemmas *)
-Theorem Zred_factor0 : (x:Z) x = (Zmult x (POS xH)).
-Intro x; Rewrite (Zmult_n_1 x); Reflexivity.
+Theorem Zred_factor0 : forall n:Z, n = n * 1.
+intro x; rewrite (Zmult_1_r x); reflexivity.
Qed.
-Theorem Zred_factor1 : (x:Z) (Zplus x x) = (Zmult x (POS (xO xH))).
+Theorem Zred_factor1 : forall n:Z, n + n = n * 2.
Proof.
-Exact Zplus_Zmult_2.
-Qed.
-
-Theorem Zred_factor2 :
- (x,y:Z) (Zplus x (Zmult x y)) = (Zmult x (Zplus (POS xH) y)).
-
-Intros x y; Pattern 1 x ; Rewrite <- (Zmult_n_1 x);
-Rewrite <- Zmult_plus_distr_r; Trivial with arith.
-Qed.
-
-Theorem Zred_factor3 :
- (x,y:Z) (Zplus (Zmult x y) x) = (Zmult x (Zplus (POS xH) y)).
-
-Intros x y; Pattern 2 x ; Rewrite <- (Zmult_n_1 x);
-Rewrite <- Zmult_plus_distr_r; Rewrite Zplus_sym; Trivial with arith.
-Qed.
-Theorem Zred_factor4 :
- (x,y,z:Z) (Zplus (Zmult x y) (Zmult x z)) = (Zmult x (Zplus y z)).
-Intros x y z; Symmetry; Apply Zmult_plus_distr_r.
-Qed.
-
-Theorem Zred_factor5 : (x,y:Z) (Zplus (Zmult x ZERO) y) = y.
-
-Intros x y; Rewrite <- Zmult_n_O;Auto with arith.
-Qed.
-
-Theorem Zred_factor6 : (x:Z) x = (Zplus x ZERO).
-
-Intro; Rewrite Zero_right; Trivial with arith.
-Qed.
-
-Theorem Zle_mult_approx:
- (x,y,z:Z) (Zgt x ZERO) -> (Zgt z ZERO) -> (Zle ZERO y) ->
- (Zle ZERO (Zplus (Zmult y x) z)).
-
-Intros x y z H1 H2 H3; Apply Zle_trans with m:=(Zmult y x) ; [
- Apply Zle_mult; Assumption
-| Pattern 1 (Zmult y x) ; Rewrite <- Zero_right; Apply Zle_reg_l;
- Apply Zlt_le_weak; Apply Zgt_lt; Assumption].
-Qed.
-
-Theorem Zmult_le_approx:
- (x,y,z:Z) (Zgt x ZERO) -> (Zgt x z) ->
- (Zle ZERO (Zplus (Zmult y x) z)) -> (Zle ZERO y).
-
-Intros x y z H1 H2 H3; Apply Zlt_n_Sm_le; Apply Zmult_lt with x; [
- Assumption
- | Apply Zle_lt_trans with 1:=H3 ; Rewrite <- Zmult_Sm_n;
- Apply Zlt_reg_l; Apply Zgt_lt; Assumption].
-
-Qed.
-
-V7only [
-(* Compatibility *)
-Require Znat.
-Require Zcompare.
-Notation neq := neq.
-Notation Zne := Zne.
-Notation OMEGA2 := Zle_0_plus.
-Notation add_un_Zs := add_un_Zs.
-Notation inj_S := inj_S.
-Notation Zplus_S_n := Zplus_S_n.
-Notation inj_plus := inj_plus.
-Notation inj_mult := inj_mult.
-Notation inj_neq := inj_neq.
-Notation inj_le := inj_le.
-Notation inj_lt := inj_lt.
-Notation inj_gt := inj_gt.
-Notation inj_ge := inj_ge.
-Notation inj_eq := inj_eq.
-Notation intro_Z := intro_Z.
-Notation inj_minus1 := inj_minus1.
-Notation inj_minus2 := inj_minus2.
-Notation dec_eq := dec_eq.
-Notation dec_Zne := dec_Zne.
-Notation dec_Zle := dec_Zle.
-Notation dec_Zgt := dec_Zgt.
-Notation dec_Zge := dec_Zge.
-Notation dec_Zlt := dec_Zlt.
-Notation dec_eq_nat := dec_eq_nat.
-Notation not_Zge := not_Zge.
-Notation not_Zlt := not_Zlt.
-Notation not_Zle := not_Zle.
-Notation not_Zgt := not_Zgt.
-Notation not_Zeq := not_Zeq.
-Notation Zopp_one := Zopp_one.
-Notation Zopp_Zmult_r := Zopp_Zmult_r.
-Notation Zmult_Zopp_left := Zmult_Zopp_left.
-Notation Zopp_Zmult_l := Zopp_Zmult_l.
-Notation Zcompare_Zplus_compatible2 := Zcompare_Zplus_compatible2.
-Notation Zcompare_Zmult_compatible := Zcompare_Zmult_compatible.
-Notation Zmult_eq := Zmult_eq.
-Notation Z_eq_mult := Z_eq_mult.
-Notation Zmult_le := Zmult_le.
-Notation Zle_ZERO_mult := Zle_ZERO_mult.
-Notation Zgt_ZERO_mult := Zgt_ZERO_mult.
-Notation Zle_mult := Zle_mult.
-Notation Zmult_lt := Zmult_lt.
-Notation Zmult_gt := Zmult_gt.
-Notation Zle_Zmult_pos_right := Zle_Zmult_pos_right.
-Notation Zle_Zmult_pos_left := Zle_Zmult_pos_left.
-Notation Zge_Zmult_pos_right := Zge_Zmult_pos_right.
-Notation Zge_Zmult_pos_left := Zge_Zmult_pos_left.
-Notation Zge_Zmult_pos_compat := Zge_Zmult_pos_compat.
-Notation Zle_mult_simpl := Zle_mult_simpl.
-Notation Zge_mult_simpl := Zge_mult_simpl.
-Notation Zgt_mult_simpl := Zgt_mult_simpl.
-Notation Zgt_square_simpl := Zgt_square_simpl.
-].
+exact Zplus_diag_eq_mult_2.
+Qed.
+
+Theorem Zred_factor2 : forall n m:Z, n + n * m = n * (1 + m).
+
+intros x y; pattern x at 1 in |- *; rewrite <- (Zmult_1_r x);
+ rewrite <- Zmult_plus_distr_r; trivial with arith.
+Qed.
+
+Theorem Zred_factor3 : forall n m:Z, n * m + n = n * (1 + m).
+
+intros x y; pattern x at 2 in |- *; rewrite <- (Zmult_1_r x);
+ rewrite <- Zmult_plus_distr_r; rewrite Zplus_comm;
+ trivial with arith.
+Qed.
+Theorem Zred_factor4 : forall n m p:Z, n * m + n * p = n * (m + p).
+intros x y z; symmetry in |- *; apply Zmult_plus_distr_r.
+Qed.
+
+Theorem Zred_factor5 : forall n m:Z, n * 0 + m = m.
+
+intros x y; rewrite <- Zmult_0_r_reverse; auto with arith.
+Qed.
+
+Theorem Zred_factor6 : forall n:Z, n = n + 0.
+
+intro; rewrite Zplus_0_r; trivial with arith.
+Qed.
+
+Theorem Zle_mult_approx :
+ forall n m p:Z, n > 0 -> p > 0 -> 0 <= m -> 0 <= m * n + p.
+
+intros x y z H1 H2 H3; apply Zle_trans with (m := y * x);
+ [ apply Zmult_gt_0_le_0_compat; assumption
+ | pattern (y * x) at 1 in |- *; rewrite <- Zplus_0_r;
+ apply Zplus_le_compat_l; apply Zlt_le_weak; apply Zgt_lt;
+ assumption ].
+Qed.
+
+Theorem Zmult_le_approx :
+ forall n m p:Z, n > 0 -> n > p -> 0 <= m * n + p -> 0 <= m.
+
+intros x y z H1 H2 H3; apply Zlt_succ_le; apply Zmult_gt_0_lt_0_reg_r with x;
+ [ assumption
+ | apply Zle_lt_trans with (1 := H3); rewrite <- Zmult_succ_l_reverse;
+ apply Zplus_lt_compat_l; apply Zgt_lt; assumption ].
+
+Qed.
diff --git a/theories/ZArith/fast_integer.v b/theories/ZArith/fast_integer.v
deleted file mode 100644
index 81b69037f..000000000
--- a/theories/ZArith/fast_integer.v
+++ /dev/null
@@ -1,191 +0,0 @@
-(***********************************************************************)
-(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA-Rocquencourt & LRI-CNRS-Orsay *)
-(* \VV/ *************************************************************)
-(* // * This file is distributed under the terms of the *)
-(* * GNU Lesser General Public License Version 2.1 *)
-(***********************************************************************)
-
-(*i $Id$ i*)
-
-(***********************************************************)
-(** Binary Integers (Pierre Crégut, CNET, Lannion, France) *)
-(***********************************************************)
-
-Require BinPos.
-Require BinNat.
-Require BinInt.
-Require Zcompare.
-Require Mult.
-
-V7only [
-(* Defs and ppties on positive, entier and Z, previously in fast_integer *)
-(* For v7 compatibility *)
-Notation positive := positive.
-Notation xO := xO.
-Notation xI := xI.
-Notation xH := xH.
-Notation add_un := add_un.
-Notation add := add.
-Notation convert := convert.
-Notation convert_add_un := convert_add_un.
-Notation cvt_carry := cvt_carry.
-Notation convert_add := convert_add.
-Notation positive_to_nat := positive_to_nat.
-Notation anti_convert := anti_convert.
-Notation double_moins_un := double_moins_un.
-Notation sub_un := sub_un.
-Notation positive_mask := positive_mask.
-Notation Un_suivi_de_mask := Un_suivi_de_mask.
-Notation Zero_suivi_de_mask := Zero_suivi_de_mask.
-Notation double_moins_deux := double_moins_deux.
-Notation sub_pos := sub_pos.
-Notation true_sub := true_sub.
-Notation times := times.
-Notation relation := relation.
-Notation SUPERIEUR := SUPERIEUR.
-Notation INFERIEUR := INFERIEUR.
-Notation EGAL := EGAL.
-Notation Op := Op.
-Notation compare := compare.
-Notation compare_convert1 := compare_convert1.
-Notation compare_convert_EGAL := compare_convert_EGAL.
-Notation ZLSI := ZLSI.
-Notation ZLIS := ZLIS.
-Notation ZLII := ZLII.
-Notation ZLSS := ZLSS.
-Notation Dcompare := Dcompare.
-Notation convert_compare_EGAL := convert_compare_EGAL.
-Notation ZL0 := ZL0.
-Notation ZL11 := ZL11.
-Notation xI_add_un_xO := xI_add_un_xO.
-Notation is_double_moins_un := is_double_moins_un.
-Notation double_moins_un_add_un_xI := double_moins_un_add_un_xI.
-Notation ZL1 := ZL1.
-Notation add_un_not_un := add_un_not_un.
-Notation sub_add_one := sub_add_one.
-Notation add_sub_one := add_sub_one.
-Notation add_un_inj := add_un_inj.
-Notation ZL12 := ZL12.
-Notation ZL12bis := ZL12bis.
-Notation ZL13 := ZL13.
-Notation add_sym := add_sym.
-Notation ZL14 := ZL14.
-Notation ZL14bis := ZL14bis.
-Notation ZL15 := ZL15.
-Notation add_no_neutral := add_no_neutral.
-Notation add_carry_not_add_un := add_carry_not_add_un.
-Notation add_carry_add := add_carry_add.
-Notation simpl_add_r := simpl_add_r.
-Notation simpl_add_carry_r := simpl_add_carry_r.
-Notation simpl_add_l := simpl_add_l.
-Notation simpl_add_carry_l := simpl_add_carry_l.
-Notation add_assoc := add_assoc.
-Notation add_xI_double_moins_un := add_xI_double_moins_un.
-Notation add_x_x := add_x_x.
-Notation ZS := ZS.
-Notation US := US.
-Notation USH := USH.
-Notation ZSH := ZSH.
-Notation sub_pos_x_x := sub_pos_x_x.
-Notation ZL10 := ZL10.
-Notation sub_pos_SUPERIEUR := sub_pos_SUPERIEUR.
-Notation sub_add := sub_add.
-Notation convert_add_carry := convert_add_carry.
-Notation add_verif := add_verif.
-Notation ZL2 := ZL2.
-Notation ZL6 := ZL6.
-Notation positive_to_nat_mult := positive_to_nat_mult.
-Notation times_convert := times_convert.
-Notation compare_positive_to_nat_O := compare_positive_to_nat_O.
-Notation compare_convert_O := compare_convert_O.
-Notation convert_xH := convert_xH.
-Notation convert_xO := convert_xO.
-Notation convert_xI := convert_xI.
-Notation bij1 := bij1.
-Notation ZL3 := ZL3.
-Notation ZL4 := ZL4.
-Notation ZL5 := ZL5.
-Notation bij2 := bij2.
-Notation bij3 := bij3.
-Notation ZL7 := ZL7.
-Notation ZL8 := ZL8.
-Notation compare_convert_INFERIEUR := compare_convert_INFERIEUR.
-Notation compare_convert_SUPERIEUR := compare_convert_SUPERIEUR.
-Notation convert_compare_INFERIEUR := convert_compare_INFERIEUR.
-Notation convert_compare_SUPERIEUR := convert_compare_SUPERIEUR.
-Notation ZC1 := ZC1.
-Notation ZC2 := ZC2.
-Notation ZC3 := ZC3.
-Notation ZC4 := ZC4.
-Notation true_sub_convert := true_sub_convert.
-Notation convert_intro := convert_intro.
-Notation ZL16 := ZL16.
-Notation ZL17 := ZL17.
-Notation compare_true_sub_right := compare_true_sub_right.
-Notation compare_true_sub_left := compare_true_sub_left.
-Notation times_x_ := times_x_1.
-Notation times_x_double := times_x_double.
-Notation times_x_double_plus_one := times_x_double_plus_one.
-Notation times_sym := times_sym.
-Notation times_add_distr := times_add_distr.
-Notation times_add_distr_l := times_add_distr_l.
-Notation times_assoc := times_assoc.
-Notation times_true_sub_distr := times_true_sub_distr.
-Notation times_discr_xO_xI := times_discr_xO_xI.
-Notation times_discr_xO := times_discr_xO.
-Notation simpl_times_r := simpl_times_r.
-Notation simpl_times_l := simpl_times_l.
-Notation iterate_add := iterate_add.
-Notation entier := entier.
-Notation Nul := Nul.
-Notation Pos := Pos.
-Notation Un_suivi_de := Un_suivi_de.
-Notation Zero_suivi_de := Zero_suivi_de.
-Notation times1 :=
- [x:positive;_:positive->positive;y:positive](times x y).
-Notation times1_convert :=
- [x,y:positive;_:positive->positive](times_convert x y).
-
-Notation Z := Z.
-Notation POS := POS.
-Notation NEG := NEG.
-Notation ZERO := ZERO.
-Notation Zero_left := Zero_left.
-Notation Zopp_Zopp := Zopp_Zopp.
-Notation Zero_right := Zero_right.
-Notation Zplus_inverse_r := Zplus_inverse_r.
-Notation Zopp_Zplus := Zopp_Zplus.
-Notation Zplus_sym := Zplus_sym.
-Notation Zplus_inverse_l := Zplus_inverse_l.
-Notation Zopp_intro := Zopp_intro.
-Notation Zopp_NEG := Zopp_NEG.
-Notation weak_assoc := weak_assoc.
-Notation Zplus_assoc := Zplus_assoc.
-Notation Zplus_simpl := Zplus_simpl.
-Notation Zmult_sym := Zmult_sym.
-Notation Zmult_assoc := Zmult_assoc.
-Notation Zmult_one := Zmult_one.
-Notation lt_mult_left := lt_mult_left. (* Mult*)
-Notation Zero_mult_left := Zero_mult_left.
-Notation Zero_mult_right := Zero_mult_right.
-Notation Zopp_Zmult := Zopp_Zmult.
-Notation Zmult_Zopp_Zopp := Zmult_Zopp_Zopp.
-Notation weak_Zmult_plus_distr_r := weak_Zmult_plus_distr_r.
-Notation Zmult_plus_distr_r := Zmult_plus_distr_r.
-Notation Zcompare_EGAL := Zcompare_EGAL.
-Notation Zcompare_ANTISYM := Zcompare_ANTISYM.
-Notation le_minus := le_minus.
-Notation Zcompare_Zopp := Zcompare_Zopp.
-Notation weaken_Zcompare_Zplus_compatible := weaken_Zcompare_Zplus_compatible.
-Notation weak_Zcompare_Zplus_compatible := weak_Zcompare_Zplus_compatible.
-Notation Zcompare_Zplus_compatible := Zcompare_Zplus_compatible.
-Notation Zcompare_trans_SUPERIEUR := Zcompare_trans_SUPERIEUR.
-Notation SUPERIEUR_POS := SUPERIEUR_POS.
-Export Datatypes.
-Export BinPos.
-Export BinNat.
-Export BinInt.
-Export Zcompare.
-Export Mult.
-].
diff --git a/theories/ZArith/zarith_aux.v b/theories/ZArith/zarith_aux.v
deleted file mode 100644
index 61a712b92..000000000
--- a/theories/ZArith/zarith_aux.v
+++ /dev/null
@@ -1,151 +0,0 @@
-(***********************************************************************)
-(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA-Rocquencourt & LRI-CNRS-Orsay *)
-(* \VV/ *************************************************************)
-(* // * This file is distributed under the terms of the *)
-(* * GNU Lesser General Public License Version 2.1 *)
-(***********************************************************************)
-(*i $Id$ i*)
-
-Require Export BinInt.
-Require Export Zcompare.
-Require Export Zorder.
-Require Export Zmin.
-Require Export Zabs.
-
-V7only [
-Notation Zlt := Zlt.
-Notation Zgt := Zgt.
-Notation Zle := Zle.
-Notation Zge := Zge.
-Notation Zsgn := Zsgn.
-Notation absolu := absolu.
-Notation Zabs := Zabs.
-Notation Zabs_eq := Zabs_eq.
-Notation Zabs_non_eq := Zabs_non_eq.
-Notation Zabs_dec := Zabs_dec.
-Notation Zabs_pos := Zabs_pos.
-Notation Zsgn_Zabs := Zsgn_Zabs.
-Notation Zabs_Zsgn := Zabs_Zsgn.
-Notation inject_nat := inject_nat.
-Notation Zs := Zs.
-Notation Zpred := Zpred.
-Notation Zgt_Sn_n := Zgt_Sn_n.
-Notation Zle_gt_trans := Zle_gt_trans.
-Notation Zgt_le_trans := Zgt_le_trans.
-Notation Zle_S_gt := Zle_S_gt.
-Notation Zcompare_n_S := Zcompare_n_S.
-Notation Zgt_n_S := Zgt_n_S.
-Notation Zle_not_gt := Zle_not_gt.
-Notation Zgt_antirefl := Zgt_antirefl.
-Notation Zgt_not_sym := Zgt_not_sym.
-Notation Zgt_not_le := Zgt_not_le.
-Notation Zgt_trans := Zgt_trans.
-Notation Zle_gt_S := Zle_gt_S.
-Notation Zgt_pred := Zgt_pred.
-Notation Zsimpl_gt_plus_l := Zsimpl_gt_plus_l.
-Notation Zsimpl_gt_plus_r := Zsimpl_gt_plus_r.
-Notation Zgt_reg_l := Zgt_reg_l.
-Notation Zgt_reg_r := Zgt_reg_r.
-Notation Zcompare_et_un := Zcompare_et_un.
-Notation Zgt_S_n := Zgt_S_n.
-Notation Zle_S_n := Zle_S_n.
-Notation Zgt_le_S := Zgt_le_S.
-Notation Zgt_S_le := Zgt_S_le.
-Notation Zgt_S := Zgt_S.
-Notation Zgt_trans_S := Zgt_trans_S.
-Notation Zeq_S := Zeq_S.
-Notation Zpred_Sn := Zpred_Sn.
-Notation Zeq_add_S := Zeq_add_S.
-Notation Znot_eq_S := Znot_eq_S.
-Notation Zsimpl_plus_l := Zsimpl_plus_l.
-Notation Zn_Sn := Zn_Sn.
-Notation Zplus_n_O := Zplus_n_O.
-Notation Zplus_unit_left := Zplus_unit_left.
-Notation Zplus_unit_right := Zplus_unit_right.
-Notation Zplus_n_Sm := Zplus_n_Sm.
-Notation Zmult_n_O := Zmult_n_O.
-Notation Zmult_n_Sm := Zmult_n_Sm.
-Notation Zle_n := Zle_n.
-Notation Zle_refl := Zle_refl.
-Notation Zle_trans := Zle_trans.
-Notation Zle_n_Sn := Zle_n_Sn.
-Notation Zle_n_S := Zle_n_S.
-Notation Zs_pred := Zs_pred. (* BinInt *)
-Notation Zle_pred_n := Zle_pred_n.
-Notation Zle_trans_S := Zle_trans_S.
-Notation Zle_Sn_n := Zle_Sn_n.
-Notation Zle_antisym := Zle_antisym.
-Notation Zgt_lt := Zgt_lt.
-Notation Zlt_gt := Zlt_gt.
-Notation Zge_le := Zge_le.
-Notation Zle_ge := Zle_ge.
-Notation Zge_trans := Zge_trans.
-Notation Zlt_n_Sn := Zlt_n_Sn.
-Notation Zlt_S := Zlt_S.
-Notation Zlt_n_S := Zlt_n_S.
-Notation Zlt_S_n := Zlt_S_n.
-Notation Zlt_n_n := Zlt_n_n.
-Notation Zlt_pred := Zlt_pred.
-Notation Zlt_pred_n_n := Zlt_pred_n_n.
-Notation Zlt_le_S := Zlt_le_S.
-Notation Zlt_n_Sm_le := Zlt_n_Sm_le.
-Notation Zle_lt_n_Sm := Zle_lt_n_Sm.
-Notation Zlt_le_weak := Zlt_le_weak.
-Notation Zlt_trans := Zlt_trans.
-Notation Zlt_le_trans := Zlt_le_trans.
-Notation Zle_lt_trans := Zle_lt_trans.
-Notation Zle_lt_or_eq := Zle_lt_or_eq.
-Notation Zle_or_lt := Zle_or_lt.
-Notation Zle_not_lt := Zle_not_lt.
-Notation Zlt_not_le := Zlt_not_le.
-Notation Zlt_not_sym := Zlt_not_sym.
-Notation Zle_le_S := Zle_le_S.
-Notation Zmin := Zmin.
-Notation Zmin_SS := Zmin_SS.
-Notation Zle_min_l := Zle_min_l.
-Notation Zle_min_r := Zle_min_r.
-Notation Zmin_case := Zmin_case.
-Notation Zmin_or := Zmin_or.
-Notation Zmin_n_n := Zmin_n_n.
-Notation Zplus_assoc_l := Zplus_assoc_l.
-Notation Zplus_assoc_r := Zplus_assoc_r.
-Notation Zplus_permute := Zplus_permute.
-Notation Zsimpl_le_plus_l := Zsimpl_le_plus_l.
-Notation Zsimpl_le_plus_r := Zsimpl_le_plus_r.
-Notation Zle_reg_l := Zle_reg_l.
-Notation Zle_reg_r := Zle_reg_r.
-Notation Zle_plus_plus := Zle_plus_plus.
-Notation Zplus_Snm_nSm := Zplus_Snm_nSm.
-Notation Zsimpl_lt_plus_l := Zsimpl_lt_plus_l.
-Notation Zsimpl_lt_plus_r := Zsimpl_lt_plus_r.
-Notation Zlt_reg_l := Zlt_reg_l.
-Notation Zlt_reg_r := Zlt_reg_r.
-Notation Zlt_le_reg := Zlt_le_reg.
-Notation Zle_lt_reg := Zle_lt_reg.
-Notation Zminus := Zminus.
-Notation Zminus_plus_simpl := Zminus_plus_simpl.
-Notation Zminus_n_O := Zminus_n_O.
-Notation Zminus_n_n := Zminus_n_n.
-Notation Zplus_minus := Zplus_minus.
-Notation Zminus_plus := Zminus_plus.
-Notation Zle_plus_minus := Zle_plus_minus.
-Notation Zminus_Sn_m := Zminus_Sn_m.
-Notation Zlt_minus := Zlt_minus.
-Notation Zlt_O_minus_lt := Zlt_O_minus_lt.
-Notation Zmult_plus_distr_l := Zmult_plus_distr_l.
-Notation Zmult_plus_distr := BinInt.Zmult_plus_distr_l.
-Notation Zmult_minus_distr := Zmult_minus_distr.
-Notation Zmult_assoc_r := Zmult_assoc_r.
-Notation Zmult_assoc_l := Zmult_assoc_l.
-Notation Zmult_permute := Zmult_permute.
-Notation Zmult_1_n := Zmult_1_n.
-Notation Zmult_n_1 := Zmult_n_1.
-Notation Zmult_Sm_n := Zmult_Sm_n.
-Notation Zmult_Zplus_distr := Zmult_plus_distr_r.
-Export BinInt.
-Export Zorder.
-Export Zmin.
-Export Zabs.
-Export Zcompare.
-].